From d2db6e553c56c2aa82e5d3a3a4d3851f1ee793b5 Mon Sep 17 00:00:00 2001 From: Lucas Colley Date: Wed, 13 Nov 2024 11:26:23 +0000 Subject: [PATCH 1/4] STY: adjust clang-format config --- .clang-format | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/.clang-format b/.clang-format index 96eefe4..cee7e27 100644 --- a/.clang-format +++ b/.clang-format @@ -1,12 +1,13 @@ BasedOnStyle: LLVM -Standard: Cpp11 +Standard: c++17 UseTab: Never IndentWidth: 4 BreakBeforeBraces: Attach Cpp11BracedListStyle: true NamespaceIndentation: Inner AlwaysBreakTemplateDeclarations: true -SpaceAfterCStyleCast: true +SpaceAfterCStyleCast: false ColumnLimit: 120 InsertNewlineAtEOF: true AlignAfterOpenBracket: BlockIndent +IncludeBlocks: Preserve From 9002b6e7ee143a542b17fda5c33ab763ba4ba9e1 Mon Sep 17 00:00:00 2001 From: Lucas Colley Date: Sat, 5 Apr 2025 18:25:42 +0100 Subject: [PATCH 2/4] DEV: add lint env --- pixi.lock | 399 +++++++++++++++++++++++++++++++++++++++++++++++++++--- pixi.toml | 10 ++ 2 files changed, 392 insertions(+), 17 deletions(-) diff --git a/pixi.lock b/pixi.lock index 45d12b8..45d702d 100644 --- a/pixi.lock +++ b/pixi.lock @@ -37,12 +37,12 @@ environments: - conda: https://prefix.dev/conda-forge/linux-64/cxx-compiler-1.9.0-h1a2810e_0.conda - conda: https://prefix.dev/conda-forge/linux-64/gcc-13.3.0-h9576a4e_2.conda - conda: https://prefix.dev/conda-forge/linux-64/gcc_impl_linux-64-13.3.0-h1e990d8_2.conda - - conda: https://prefix.dev/conda-forge/linux-64/gcc_linux-64-13.3.0-hc28eda2_9.conda + - conda: https://prefix.dev/conda-forge/linux-64/gcc_linux-64-13.3.0-hc28eda2_10.conda - conda: https://prefix.dev/conda-forge/linux-64/gflags-2.2.2-h5888daf_1005.conda - conda: https://prefix.dev/conda-forge/linux-64/glog-0.7.1-hbabe93e_0.conda - conda: https://prefix.dev/conda-forge/linux-64/gxx-13.3.0-h9576a4e_2.conda - conda: https://prefix.dev/conda-forge/linux-64/gxx_impl_linux-64-13.3.0-hae580e1_2.conda - - conda: https://prefix.dev/conda-forge/linux-64/gxx_linux-64-13.3.0-h6834431_9.conda + - conda: https://prefix.dev/conda-forge/linux-64/gxx_linux-64-13.3.0-h6834431_10.conda - conda: https://prefix.dev/conda-forge/noarch/kernel-headers_linux-64-3.10.0-he073ed8_18.conda - conda: https://prefix.dev/conda-forge/linux-64/keyutils-1.6.1-h166bdaf_0.tar.bz2 - conda: https://prefix.dev/conda-forge/linux-64/krb5-1.21.3-h659f571_0.conda @@ -372,6 +372,105 @@ environments: - conda: https://prefix.dev/conda-forge/win-64/vs2019_win-64-19.29.30139-h7dcff83_26.conda - conda: https://prefix.dev/conda-forge/win-64/vswhere-3.1.7-h57928b3_0.conda - conda: https://prefix.dev/conda-forge/win-64/zstd-1.5.7-hbeecb71_2.conda + lint: + channels: + - url: https://prefix.dev/conda-forge/ + packages: + linux-64: + - conda: https://prefix.dev/conda-forge/linux-64/_libgcc_mutex-0.1-conda_forge.tar.bz2 + - conda: https://prefix.dev/conda-forge/linux-64/_openmp_mutex-4.5-2_gnu.tar.bz2 + - conda: https://prefix.dev/conda-forge/linux-64/bzip2-1.0.8-h4bc722e_7.conda + - conda: https://prefix.dev/conda-forge/linux-64/c-ares-1.34.5-hb9d3cd8_0.conda + - conda: https://prefix.dev/conda-forge/linux-64/ca-certificates-2025.1.31-hbcca054_0.conda + - conda: https://prefix.dev/conda-forge/linux-64/clang-format-20-20.1.3-default_h1df26ce_0.conda + - conda: https://prefix.dev/conda-forge/linux-64/clang-format-20.1.3-default_h1df26ce_0.conda + - conda: https://prefix.dev/conda-forge/linux-64/git-2.49.0-pl5321h59d505e_0.conda + - conda: https://prefix.dev/conda-forge/linux-64/keyutils-1.6.1-h166bdaf_0.tar.bz2 + - conda: https://prefix.dev/conda-forge/linux-64/krb5-1.21.3-h659f571_0.conda + - conda: https://prefix.dev/conda-forge/linux-64/libclang-cpp20.1-20.1.3-default_h1df26ce_0.conda + - conda: https://prefix.dev/conda-forge/linux-64/libcurl-8.13.0-h332b0f4_0.conda + - conda: https://prefix.dev/conda-forge/linux-64/libedit-3.1.20250104-pl5321h7949ede_0.conda + - conda: https://prefix.dev/conda-forge/linux-64/libev-4.33-hd590300_2.conda + - conda: https://prefix.dev/conda-forge/linux-64/libexpat-2.7.0-h5888daf_0.conda + - conda: https://prefix.dev/conda-forge/linux-64/libgcc-14.2.0-h767d61c_2.conda + - conda: https://prefix.dev/conda-forge/linux-64/libgcc-ng-14.2.0-h69a702a_2.conda + - conda: https://prefix.dev/conda-forge/linux-64/libgomp-14.2.0-h767d61c_2.conda + - conda: https://prefix.dev/conda-forge/linux-64/libiconv-1.18-h4ce23a2_1.conda + - conda: https://prefix.dev/conda-forge/linux-64/libllvm20-20.1.3-he9d0ab4_0.conda + - conda: https://prefix.dev/conda-forge/linux-64/liblzma-5.8.1-hb9d3cd8_0.conda + - conda: https://prefix.dev/conda-forge/linux-64/libnghttp2-1.64.0-h161d5f1_0.conda + - conda: https://prefix.dev/conda-forge/linux-64/libssh2-1.11.1-hf672d98_0.conda + - conda: https://prefix.dev/conda-forge/linux-64/libstdcxx-14.2.0-h8f9b012_2.conda + - conda: https://prefix.dev/conda-forge/linux-64/libstdcxx-ng-14.2.0-h4852527_2.conda + - conda: https://prefix.dev/conda-forge/linux-64/libxcrypt-4.4.36-hd590300_1.conda + - conda: https://prefix.dev/conda-forge/linux-64/libxml2-2.13.7-h81593ed_1.conda + - conda: https://prefix.dev/conda-forge/linux-64/libzlib-1.3.1-hb9d3cd8_2.conda + - conda: https://prefix.dev/conda-forge/linux-64/ncurses-6.5-h2d0b736_3.conda + - conda: https://prefix.dev/conda-forge/linux-64/openssl-3.5.0-h7b32b05_0.conda + - conda: https://prefix.dev/conda-forge/linux-64/pcre2-10.44-hba22ea6_2.conda + - conda: https://prefix.dev/conda-forge/linux-64/perl-5.32.1-7_hd590300_perl5.conda + - conda: https://prefix.dev/conda-forge/linux-64/zstd-1.5.7-hb8e6e7a_2.conda + osx-64: + - conda: https://prefix.dev/conda-forge/osx-64/bzip2-1.0.8-hfdf4475_7.conda + - conda: https://prefix.dev/conda-forge/osx-64/c-ares-1.34.5-hf13058a_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/ca-certificates-2025.1.31-h8857fd0_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/clang-format-20-20.1.3-default_hf9570e0_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/clang-format-20.1.3-default_hf9570e0_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/git-2.49.0-pl5321h0e333bc_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/krb5-1.21.3-h37d8d59_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/libclang-cpp20.1-20.1.3-default_hf9570e0_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/libcurl-8.13.0-h5dec5d8_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/libcxx-20.1.3-hf95d169_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/libedit-3.1.20250104-pl5321ha958ccf_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/libev-4.33-h10d778d_2.conda + - conda: https://prefix.dev/conda-forge/osx-64/libexpat-2.7.0-h240833e_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/libiconv-1.18-h4b5e92a_1.conda + - conda: https://prefix.dev/conda-forge/osx-64/libintl-0.23.1-h27064b9_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/libllvm20-20.1.3-h29c3a6c_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/liblzma-5.8.1-hd471939_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/libnghttp2-1.64.0-hc7306c3_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/libssh2-1.11.1-h3dc7d44_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/libxml2-2.13.7-h3fbc333_1.conda + - conda: https://prefix.dev/conda-forge/osx-64/libzlib-1.3.1-hd23fc13_2.conda + - conda: https://prefix.dev/conda-forge/osx-64/ncurses-6.5-h0622a9a_3.conda + - conda: https://prefix.dev/conda-forge/osx-64/openssl-3.5.0-hc426f3f_0.conda + - conda: https://prefix.dev/conda-forge/osx-64/pcre2-10.44-h7634a1b_2.conda + - conda: https://prefix.dev/conda-forge/osx-64/perl-5.32.1-7_h10d778d_perl5.conda + - conda: https://prefix.dev/conda-forge/osx-64/zstd-1.5.7-h8210216_2.conda + osx-arm64: + - conda: https://prefix.dev/conda-forge/osx-arm64/bzip2-1.0.8-h99b78c6_7.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/c-ares-1.34.5-h5505292_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/ca-certificates-2025.1.31-hf0a4a13_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/clang-format-20-20.1.3-default_h03658f6_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/clang-format-20.1.3-default_h03658f6_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/git-2.49.0-pl5321hd71a902_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/icu-75.1-hfee45f7_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/krb5-1.21.3-h237132a_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/libclang-cpp20.1-20.1.3-default_h03658f6_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/libcurl-8.13.0-h73640d1_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/libcxx-20.1.3-ha82da77_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/libedit-3.1.20250104-pl5321hafb1f1b_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/libev-4.33-h93a5062_2.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/libexpat-2.7.0-h286801f_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/libiconv-1.18-hfe07756_1.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/libintl-0.23.1-h493aca8_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/libllvm20-20.1.3-h598bca7_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/liblzma-5.8.1-h39f12f2_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/libnghttp2-1.64.0-h6d7220d_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/libssh2-1.11.1-h9cc3647_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/libxml2-2.13.7-h52572c6_1.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/libzlib-1.3.1-h8359307_2.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/ncurses-6.5-h5e97a16_3.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/openssl-3.5.0-h81ee809_0.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/pcre2-10.44-h297a79d_2.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/perl-5.32.1-7_h4614cfb_perl5.conda + - conda: https://prefix.dev/conda-forge/osx-arm64/zstd-1.5.7-h6491c7d_2.conda + win-64: + - conda: https://prefix.dev/conda-forge/win-64/clang-format-20.1.3-default_hb5d4d12_0.conda + - conda: https://prefix.dev/conda-forge/win-64/git-2.49.0-h57928b3_0.conda + - conda: https://prefix.dev/conda-forge/win-64/ucrt-10.0.22621.0-h57928b3_1.conda + - conda: https://prefix.dev/conda-forge/win-64/vc-14.3-h2b53caa_26.conda + - conda: https://prefix.dev/conda-forge/win-64/vc14_runtime-14.42.34438-hfd919c2_26.conda tests-ci: channels: - url: https://prefix.dev/conda-forge/ @@ -410,12 +509,12 @@ environments: - conda: https://prefix.dev/conda-forge/linux-64/cxx-compiler-1.9.0-h1a2810e_0.conda - conda: https://prefix.dev/conda-forge/linux-64/gcc-13.3.0-h9576a4e_2.conda - conda: https://prefix.dev/conda-forge/linux-64/gcc_impl_linux-64-13.3.0-h1e990d8_2.conda - - conda: https://prefix.dev/conda-forge/linux-64/gcc_linux-64-13.3.0-hc28eda2_9.conda + - conda: https://prefix.dev/conda-forge/linux-64/gcc_linux-64-13.3.0-hc28eda2_10.conda - conda: https://prefix.dev/conda-forge/linux-64/gflags-2.2.2-h5888daf_1005.conda - conda: https://prefix.dev/conda-forge/linux-64/glog-0.7.1-hbabe93e_0.conda - conda: https://prefix.dev/conda-forge/linux-64/gxx-13.3.0-h9576a4e_2.conda - conda: https://prefix.dev/conda-forge/linux-64/gxx_impl_linux-64-13.3.0-hae580e1_2.conda - - conda: https://prefix.dev/conda-forge/linux-64/gxx_linux-64-13.3.0-h6834431_9.conda + - conda: https://prefix.dev/conda-forge/linux-64/gxx_linux-64-13.3.0-h6834431_10.conda - conda: https://prefix.dev/conda-forge/noarch/kernel-headers_linux-64-3.10.0-he073ed8_18.conda - conda: https://prefix.dev/conda-forge/linux-64/keyutils-1.6.1-h166bdaf_0.tar.bz2 - conda: https://prefix.dev/conda-forge/linux-64/krb5-1.21.3-h659f571_0.conda @@ -2062,6 +2161,94 @@ packages: license_family: Apache size: 808948 timestamp: 1744062517394 +- conda: https://prefix.dev/conda-forge/linux-64/clang-format-20.1.3-default_h1df26ce_0.conda + sha256: bb143fe0ad4afe25a40032c6043dad771eb4791751d1774fd5e4a24482f5ddc0 + md5: 3198ae536c84ec36f10c5f86c7afb391 + depends: + - __glibc >=2.17,<3.0.a0 + - clang-format-20 20.1.3 default_h1df26ce_0 + - libclang-cpp20.1 >=20.1.3,<20.2.0a0 + - libgcc >=13 + - libllvm20 >=20.1.3,<20.2.0a0 + - libstdcxx >=13 + license: Apache-2.0 WITH LLVM-exception + license_family: Apache + size: 24533 + timestamp: 1744876887270 +- conda: https://prefix.dev/conda-forge/osx-64/clang-format-20.1.3-default_hf9570e0_0.conda + sha256: af856c045f2a1b9e69e1abdbaaeacd541fa38172a85bab029c8e6b16d6b55786 + md5: 216225c27995ced61f8f05649d58baa8 + depends: + - __osx >=10.13 + - clang-format-20 20.1.3 default_hf9570e0_0 + - libclang-cpp20.1 >=20.1.3,<20.2.0a0 + - libcxx >=20.1.3 + - libllvm20 >=20.1.3,<20.2.0a0 + license: Apache-2.0 WITH LLVM-exception + license_family: Apache + size: 24654 + timestamp: 1744875618197 +- conda: https://prefix.dev/conda-forge/osx-arm64/clang-format-20.1.3-default_h03658f6_0.conda + sha256: 8835d3e027b4fc718bfda220f0e8bdb1af019651d496e68e17095d9a8d6c99a4 + md5: 0083e721e07c445f012a263a2e08ec5e + depends: + - __osx >=11.0 + - clang-format-20 20.1.3 default_h03658f6_0 + - libclang-cpp20.1 >=20.1.3,<20.2.0a0 + - libcxx >=20.1.3 + - libllvm20 >=20.1.3,<20.2.0a0 + license: Apache-2.0 WITH LLVM-exception + license_family: Apache + size: 24673 + timestamp: 1744875626919 +- conda: https://prefix.dev/conda-forge/win-64/clang-format-20.1.3-default_hb5d4d12_0.conda + sha256: 29d928e5902c3a0ccc6c834e5ace64a1e2196f0932228f1c8647eb914aeda6c2 + md5: d72cb0cf91993dbdc699714e8f48ac59 + depends: + - ucrt >=10.0.20348.0 + - vc >=14.2,<15 + - vc14_runtime >=14.29.30139 + license: Apache-2.0 WITH LLVM-exception + license_family: Apache + size: 1240405 + timestamp: 1744881275950 +- conda: https://prefix.dev/conda-forge/linux-64/clang-format-20-20.1.3-default_h1df26ce_0.conda + sha256: b49fdaae63ded91775499b4e3b2e0640173b486b64a1afb92259fefa706322bf + md5: ff188ae461f664e2795a5fa46cb42a9a + depends: + - __glibc >=2.17,<3.0.a0 + - libclang-cpp20.1 >=20.1.3,<20.2.0a0 + - libgcc >=13 + - libllvm20 >=20.1.3,<20.2.0a0 + - libstdcxx >=13 + license: Apache-2.0 WITH LLVM-exception + license_family: Apache + size: 68284 + timestamp: 1744876839466 +- conda: https://prefix.dev/conda-forge/osx-64/clang-format-20-20.1.3-default_hf9570e0_0.conda + sha256: 6f909ea9c9f57bd2e6309e72275d411b757bccc67250644d94824c4506885f7c + md5: da38891850ac96ed6fb23019be828898 + depends: + - __osx >=10.13 + - libclang-cpp20.1 >=20.1.3,<20.2.0a0 + - libcxx >=20.1.3 + - libllvm20 >=20.1.3,<20.2.0a0 + license: Apache-2.0 WITH LLVM-exception + license_family: Apache + size: 64113 + timestamp: 1744875522126 +- conda: https://prefix.dev/conda-forge/osx-arm64/clang-format-20-20.1.3-default_h03658f6_0.conda + sha256: 9cb4d9a576a5e020b0c817c9941ec8ae0346616f2a45e05e925bdc94c190b3b6 + md5: 3db6aebe202791b434541ca1b24af3ec + depends: + - __osx >=11.0 + - libclang-cpp20.1 >=20.1.3,<20.2.0a0 + - libcxx >=20.1.3 + - libllvm20 >=20.1.3,<20.2.0a0 + license: Apache-2.0 WITH LLVM-exception + license_family: Apache + size: 62567 + timestamp: 1744875549589 - conda: https://prefix.dev/conda-forge/osx-64/clang_impl_osx-64-18.1.8-h6a44ed1_24.conda sha256: 27b5f4400cee37eea37160d0f65061804d34e403ed3d43a5e8fcad585b6efc6e md5: 5224d53acc2604a86d790f664d7fcbc4 @@ -2357,17 +2544,16 @@ packages: license_family: GPL size: 66770653 timestamp: 1740240400031 -- conda: https://prefix.dev/conda-forge/linux-64/gcc_linux-64-13.3.0-hc28eda2_9.conda - sha256: 002ce61822561678c26618c6f1a0dc7934daa39a086b05f03034807c188c5deb - md5: d879fefaad64cf97028f82328504c356 +- conda: https://prefix.dev/conda-forge/linux-64/gcc_linux-64-13.3.0-hc28eda2_10.conda + sha256: 2526f358e0abab84d6f93b2bae932e32712025a3547400393a1cfa6240257323 + md5: d151142bbafe5e68ec7fc065c5e6f80c depends: - binutils_linux-64 - gcc_impl_linux-64 13.3.0.* - sysroot_linux-64 license: BSD-3-Clause - license_family: BSD - size: 32705 - timestamp: 1744834607386 + size: 32570 + timestamp: 1745040775220 - conda: https://prefix.dev/conda-forge/linux-64/gflags-2.2.2-h5888daf_1005.conda sha256: 6c33bf0c4d8f418546ba9c250db4e4221040936aef8956353bc764d4877bc39a md5: d411fc29e338efb48c5fd4576d71d881 @@ -2399,6 +2585,60 @@ packages: license_family: BSD size: 82090 timestamp: 1726600145480 +- conda: https://prefix.dev/conda-forge/linux-64/git-2.49.0-pl5321h59d505e_0.conda + sha256: 9279eaa7c973f474a73607d65f9afc9c7d18e8374c45eaf5461c0969947a35be + md5: 757e04df008ac271bf9fcc3ee21d5ea8 + depends: + - __glibc >=2.17,<3.0.a0 + - libcurl >=8.12.1,<9.0a0 + - libexpat >=2.6.4,<3.0a0 + - libgcc >=13 + - libiconv >=1.18,<2.0a0 + - libzlib >=1.3.1,<2.0a0 + - openssl >=3.4.1,<4.0a0 + - pcre2 >=10.44,<10.45.0a0 + - perl 5.* + license: GPL-2.0-or-later and LGPL-2.1-or-later + size: 10702380 + timestamp: 1742298221381 +- conda: https://prefix.dev/conda-forge/osx-64/git-2.49.0-pl5321h0e333bc_0.conda + sha256: d8acf43d9d7fffdd54271682849515e5d0c9ac05209d21834293a49ffe0132df + md5: 1ae715c093cf6feee33cbe1061685a52 + depends: + - __osx >=10.10 + - libcurl >=8.12.1,<9.0a0 + - libexpat >=2.6.4,<3.0a0 + - libiconv >=1.18,<2.0a0 + - libintl >=0.23.1,<1.0a0 + - libzlib >=1.3.1,<2.0a0 + - openssl >=3.4.1,<4.0a0 + - pcre2 >=10.44,<10.45.0a0 + - perl 5.* + license: GPL-2.0-or-later and LGPL-2.1-or-later + size: 11850375 + timestamp: 1742298828294 +- conda: https://prefix.dev/conda-forge/osx-arm64/git-2.49.0-pl5321hd71a902_0.conda + sha256: 820ae89cee4e47f41915430e41e1298d653383b7120d92ee06619939594d39c9 + md5: 465d2f91648a3626ca62b02e551dec26 + depends: + - __osx >=11.0 + - libcurl >=8.12.1,<9.0a0 + - libexpat >=2.6.4,<3.0a0 + - libiconv >=1.18,<2.0a0 + - libintl >=0.23.1,<1.0a0 + - libzlib >=1.3.1,<2.0a0 + - openssl >=3.4.1,<4.0a0 + - pcre2 >=10.44,<10.45.0a0 + - perl 5.* + license: GPL-2.0-or-later and LGPL-2.1-or-later + size: 10352745 + timestamp: 1742298624993 +- conda: https://prefix.dev/conda-forge/win-64/git-2.49.0-h57928b3_0.conda + sha256: 23c313d9a6e7784bdacc71d7fe9d5cd36d6984908e716422ed8ad9b38162d85f + md5: 30c89cbda81237c8501ba98adac10ad7 + license: GPL-2.0-or-later and LGPL-2.1-or-later + size: 127194688 + timestamp: 1742298397813 - conda: https://prefix.dev/conda-forge/linux-64/glog-0.7.1-hbabe93e_0.conda sha256: dc824dc1d0aa358e28da2ecbbb9f03d932d976c8dca11214aa1dcdfcbd054ba2 md5: ff862eebdfeb2fd048ae9dc92510baca @@ -2454,18 +2694,17 @@ packages: license_family: GPL size: 13362974 timestamp: 1740240672045 -- conda: https://prefix.dev/conda-forge/linux-64/gxx_linux-64-13.3.0-h6834431_9.conda - sha256: 786b2706107f30edbedc23f3dd07c5682ac46738bb9ffd6269be0acf41e99c8d - md5: f5d55f45c444cfe5b767a1447c957f85 +- conda: https://prefix.dev/conda-forge/linux-64/gxx_linux-64-13.3.0-h6834431_10.conda + sha256: 03de108ca10b693a1b03e7d5cf9173837281d15bc5da7743ffba114fa9389476 + md5: 9a8ebde471cec5cc9c48f8682f434f92 depends: - binutils_linux-64 - - gcc_linux-64 13.3.0 hc28eda2_9 + - gcc_linux-64 13.3.0 hc28eda2_10 - gxx_impl_linux-64 13.3.0.* - sysroot_linux-64 license: BSD-3-Clause - license_family: BSD - size: 31066 - timestamp: 1744834626799 + size: 30904 + timestamp: 1745040794452 - conda: https://prefix.dev/conda-forge/osx-arm64/icu-75.1-hfee45f7_0.conda sha256: 9ba12c93406f3df5ab0a43db8a4b4ef67a5871dfd401010fbe29b218b2cbe620 md5: 5eb22c1d7b3fc4abb50d92d621583137 @@ -3465,6 +3704,40 @@ packages: license_family: Apache size: 13330734 timestamp: 1744062341062 +- conda: https://prefix.dev/conda-forge/linux-64/libclang-cpp20.1-20.1.3-default_h1df26ce_0.conda + sha256: e49690c45269e504a4a020c689941aea58bc44e3cce2a5da93340cf838999c1c + md5: bbce8ba7f25af8b0928f13fca1eb7405 + depends: + - __glibc >=2.17,<3.0.a0 + - libgcc >=13 + - libllvm20 >=20.1.3,<20.2.0a0 + - libstdcxx >=13 + license: Apache-2.0 WITH LLVM-exception + license_family: Apache + size: 20864165 + timestamp: 1744876524529 +- conda: https://prefix.dev/conda-forge/osx-64/libclang-cpp20.1-20.1.3-default_hf9570e0_0.conda + sha256: 1fa86f3ccc8c10ec489bfa3cd37d34d4a2460bc1464a424bcab9d08d2e005c1e + md5: 432357b914b6b73decff4232cfa71d70 + depends: + - __osx >=10.13 + - libcxx >=20.1.3 + - libllvm20 >=20.1.3,<20.2.0a0 + license: Apache-2.0 WITH LLVM-exception + license_family: Apache + size: 14511545 + timestamp: 1744874958063 +- conda: https://prefix.dev/conda-forge/osx-arm64/libclang-cpp20.1-20.1.3-default_h03658f6_0.conda + sha256: 3ffb8ef3d55caf8fc3eb32663302fb4018a9d7c3afa873c1f70a646454be2344 + md5: c6cfb89205823e117b4a227ac919cce8 + depends: + - __osx >=11.0 + - libcxx >=20.1.3 + - libllvm20 >=20.1.3,<20.2.0a0 + license: Apache-2.0 WITH LLVM-exception + license_family: Apache + size: 13937615 + timestamp: 1744875042 - conda: https://prefix.dev/conda-forge/linux-64/libcrc32c-1.1.2-h9c3ff4c_0.tar.bz2 sha256: fd1d153962764433fe6233f34a72cdeed5dcf8a883a85769e8295ce940b5b0c5 md5: c965a5aa0d5c1c37ffc62dff36e28400 @@ -4169,6 +4442,24 @@ packages: license: LGPL-2.1-only size: 681804 timestamp: 1740128227484 +- conda: https://prefix.dev/conda-forge/osx-64/libintl-0.23.1-h27064b9_0.conda + sha256: 1bce54e6c76064032129ba138898a5b188d9415c533eb585f89d48b04e00e576 + md5: 4182fe11073548596723d9cd2c23b1ac + depends: + - __osx >=10.13 + - libiconv >=1.17,<2.0a0 + license: LGPL-2.1-or-later + size: 87157 + timestamp: 1739039171974 +- conda: https://prefix.dev/conda-forge/osx-arm64/libintl-0.23.1-h493aca8_0.conda + sha256: 30d2a8a37070615a61777ce9317968b54c2197d04e9c6c2eea6cdb46e47f94dc + md5: 7b8faf3b5fc52744bda99c4cd1d6438d + depends: + - __osx >=11.0 + - libiconv >=1.17,<2.0a0 + license: LGPL-2.1-or-later + size: 78921 + timestamp: 1739039271409 - conda: https://prefix.dev/conda-forge/linux-64/libllvm18-18.1.8-ha7bfdaf_3.conda sha256: de23835ab90e90b4dec9960f69c56a629189bb266d0d9aabac3bac26f1a4a836 md5: de2f6ca3a6e411376ccc56398550f7e0 @@ -4209,6 +4500,46 @@ packages: license_family: Apache size: 25986548 timestamp: 1737837114740 +- conda: https://prefix.dev/conda-forge/linux-64/libllvm20-20.1.3-he9d0ab4_0.conda + sha256: 1d61b4ad305a1b620185b0c7061de1b8128a58f8925e49ccc87e84e0276f1946 + md5: 74c14fe2ab88e352ab6e4fedf5ecb527 + depends: + - __glibc >=2.17,<3.0.a0 + - libgcc >=13 + - libstdcxx >=13 + - libxml2 >=2.13.7,<2.14.0a0 + - libzlib >=1.3.1,<2.0a0 + - zstd >=1.5.7,<1.6.0a0 + license: Apache-2.0 WITH LLVM-exception + license_family: Apache + size: 43025284 + timestamp: 1744814708496 +- conda: https://prefix.dev/conda-forge/osx-64/libllvm20-20.1.3-h29c3a6c_0.conda + sha256: 9d5aa21cf01656a1902015e8ee2edaa18394209c308ad7016d917eb3a9bc32a5 + md5: cbd05b3b8531f99720d59de5fc4f630b + depends: + - __osx >=10.13 + - libcxx >=18 + - libxml2 >=2.13.7,<2.14.0a0 + - libzlib >=1.3.1,<2.0a0 + - zstd >=1.5.7,<1.6.0a0 + license: Apache-2.0 WITH LLVM-exception + license_family: Apache + size: 30787001 + timestamp: 1744809685001 +- conda: https://prefix.dev/conda-forge/osx-arm64/libllvm20-20.1.3-h598bca7_0.conda + sha256: 13abe5448179d6d88bbcfee1bd7cac626afce165b348d9bc2f772889816f6f06 + md5: e718bb91f3e9cc94694da9962cb91671 + depends: + - __osx >=11.0 + - libcxx >=18 + - libxml2 >=2.13.7,<2.14.0a0 + - libzlib >=1.3.1,<2.0a0 + - zstd >=1.5.7,<1.6.0a0 + license: Apache-2.0 WITH LLVM-exception + license_family: Apache + size: 28901429 + timestamp: 1744810480305 - conda: https://prefix.dev/conda-forge/linux-64/liblzma-5.8.1-hb9d3cd8_0.conda sha256: f4f21dfc54b08d462f707b771ecce3fa9bc702a2a05b55654f64154f48b141ef md5: 0e87378639676987af32fee53ba32258 @@ -5185,6 +5516,40 @@ packages: license_family: Apache size: 1103840 timestamp: 1741889978401 +- conda: https://prefix.dev/conda-forge/linux-64/pcre2-10.44-hba22ea6_2.conda + sha256: 1087716b399dab91cc9511d6499036ccdc53eb29a288bebcb19cf465c51d7c0d + md5: df359c09c41cd186fffb93a2d87aa6f5 + depends: + - __glibc >=2.17,<3.0.a0 + - bzip2 >=1.0.8,<2.0a0 + - libgcc-ng >=12 + - libzlib >=1.3.1,<2.0a0 + license: BSD-3-Clause + license_family: BSD + size: 952308 + timestamp: 1723488734144 +- conda: https://prefix.dev/conda-forge/osx-64/pcre2-10.44-h7634a1b_2.conda + sha256: 336057fce69d45e1059f138beb38d60eb87ba858c3ad729ed49d9ecafd23669f + md5: 58cde0663f487778bcd7a0c8daf50293 + depends: + - __osx >=10.13 + - bzip2 >=1.0.8,<2.0a0 + - libzlib >=1.3.1,<2.0a0 + license: BSD-3-Clause + license_family: BSD + size: 854306 + timestamp: 1723488807216 +- conda: https://prefix.dev/conda-forge/osx-arm64/pcre2-10.44-h297a79d_2.conda + sha256: 83153c7d8fd99cab33c92ce820aa7bfed0f1c94fc57010cf227b6e3c50cb7796 + md5: 147c83e5e44780c7492998acbacddf52 + depends: + - __osx >=11.0 + - bzip2 >=1.0.8,<2.0a0 + - libzlib >=1.3.1,<2.0a0 + license: BSD-3-Clause + license_family: BSD + size: 618973 + timestamp: 1723488853807 - conda: https://prefix.dev/conda-forge/linux-64/perl-5.32.1-7_hd590300_perl5.conda build_number: 7 sha256: 9ec32b6936b0e37bcb0ed34f22ec3116e75b3c0964f9f50ecea5f58734ed6ce9 diff --git a/pixi.toml b/pixi.toml index 2be7f18..c1ebac1 100644 --- a/pixi.toml +++ b/pixi.toml @@ -66,6 +66,15 @@ tests.cmd = ["ctest", "--output-on-failure", "--test-dir", "build/tests"] tests.depends-on = ["clone-xsref", "build-tests"] tests.cwd = "." +## clang-format + +[feature.clang-format.dependencies] +git = "*" +clang-format = "*" + +[feature.clang-format.tasks] +format = "git ls-files '*.cpp' '*.h' | xargs clang-format -i --style=file" + ## Coverage [feature.coverage.dependencies] @@ -125,3 +134,4 @@ coverage.cwd = "." [environments] default = { features = ["build", "tests"], solve-group = "default" } tests-ci = { features = ["build", "tests", "tests-ci", "coverage"], solve-group = "default" } +lint = { features = ["clang-format"], solve-group = "default" } From e6323cae55daee686221c54160994ee1c7825ba5 Mon Sep 17 00:00:00 2001 From: Lucas Colley Date: Sat, 19 Apr 2025 12:57:50 +0100 Subject: [PATCH 3/4] STY: run clang-format --- include/xsf/airy.h | 2 +- include/xsf/amos/amos.h | 11961 ++++++++-------- include/xsf/binom.h | 4 +- include/xsf/cdflib.h | 18 +- include/xsf/cephes/beta.h | 6 +- include/xsf/cephes/cbrt.h | 133 +- include/xsf/cephes/chdtr.h | 2 +- include/xsf/cephes/dd_real.h | 44 +- include/xsf/cephes/ellik.h | 2 +- include/xsf/cephes/expn.h | 12 +- include/xsf/cephes/gamma.h | 73 +- include/xsf/cephes/hyp2f1.h | 9 +- include/xsf/cephes/i0.h | 6 +- include/xsf/cephes/i1.h | 6 +- include/xsf/cephes/igam.h | 12 +- include/xsf/cephes/igam_asymp_coeff.h | 3 +- include/xsf/cephes/incbet.h | 12 +- include/xsf/cephes/jv.h | 75 +- include/xsf/cephes/k0.h | 3 +- include/xsf/cephes/k1.h | 14 +- include/xsf/cephes/kolmogorov.h | 25 +- include/xsf/cephes/lanczos.h | 17 +- include/xsf/cephes/ndtr.h | 15 +- include/xsf/cephes/owens_t.h | 45 +- include/xsf/cephes/psi.h | 16 +- include/xsf/cephes/rgamma.h | 37 +- include/xsf/cephes/scipy_iv.h | 3 +- include/xsf/cephes/shichi.h | 12 +- include/xsf/cephes/struve.h | 2 +- include/xsf/cephes/zetac.h | 4 +- include/xsf/erf.h | 2 +- include/xsf/expint.h | 65 +- include/xsf/faddeeva.h | 4212 ++++-- include/xsf/fp_error_metrics.h | 91 +- include/xsf/fresnel.h | 2 +- include/xsf/hyp2f1.h | 135 +- include/xsf/iv_ratio.h | 32 +- include/xsf/kelvin.h | 2 +- include/xsf/lambertw.h | 4 +- include/xsf/legendre.h | 6 +- include/xsf/log_exp.h | 18 +- include/xsf/loggamma.h | 15 +- include/xsf/mathieu.h | 34 +- include/xsf/numpy.h | 50 +- include/xsf/par_cyl.h | 20 +- include/xsf/sici.h | 109 +- include/xsf/specfun.h | 12 +- include/xsf/specfun/specfun.h | 10685 +++++++------- include/xsf/sph_bessel.h | 5 +- include/xsf/sphd_wave.h | 114 +- include/xsf/tools.h | 11 +- include/xsf/wright_bessel.h | 69 +- include/xsf/zeta.h | 485 +- tests/scipy_special_tests/test_airy.cpp | 9 +- tests/scipy_special_tests/test_airye.cpp | 9 +- tests/scipy_special_tests/test_bdtr.cpp | 7 +- tests/scipy_special_tests/test_bdtrc.cpp | 7 +- tests/scipy_special_tests/test_bdtri.cpp | 7 +- tests/scipy_special_tests/test_bei.cpp | 10 +- tests/scipy_special_tests/test_beip.cpp | 10 +- tests/scipy_special_tests/test_ber.cpp | 10 +- tests/scipy_special_tests/test_berp.cpp | 10 +- tests/scipy_special_tests/test_besselpoly.cpp | 7 +- tests/scipy_special_tests/test_beta.cpp | 10 +- tests/scipy_special_tests/test_betaln.cpp | 10 +- tests/scipy_special_tests/test_binom.cpp | 10 +- tests/scipy_special_tests/test_cbrt.cpp | 10 +- tests/scipy_special_tests/test_cem.cpp | 9 +- tests/scipy_special_tests/test_cem_cva.cpp | 10 +- tests/scipy_special_tests/test_chdtr.cpp | 20 +- tests/scipy_special_tests/test_chdtrc.cpp | 20 +- tests/scipy_special_tests/test_chdtri.cpp | 10 +- tests/scipy_special_tests/test_cosdg.cpp | 10 +- tests/scipy_special_tests/test_cosm1.cpp | 10 +- tests/scipy_special_tests/test_cospi.cpp | 17 +- tests/scipy_special_tests/test_cotdg.cpp | 10 +- .../scipy_special_tests/test_cyl_bessel_i.cpp | 10 +- .../test_cyl_bessel_i0.cpp | 20 +- .../test_cyl_bessel_i0e.cpp | 20 +- .../test_cyl_bessel_i1.cpp | 20 +- .../test_cyl_bessel_i1e.cpp | 20 +- .../test_cyl_bessel_ie.cpp | 10 +- .../scipy_special_tests/test_cyl_bessel_j.cpp | 10 +- .../test_cyl_bessel_j0.cpp | 10 +- .../test_cyl_bessel_j1.cpp | 10 +- .../test_cyl_bessel_je.cpp | 10 +- .../scipy_special_tests/test_cyl_bessel_k.cpp | 10 +- .../test_cyl_bessel_k0.cpp | 10 +- .../test_cyl_bessel_k0e.cpp | 10 +- .../test_cyl_bessel_k1.cpp | 10 +- .../test_cyl_bessel_k1e.cpp | 10 +- .../test_cyl_bessel_ke.cpp | 10 +- .../scipy_special_tests/test_cyl_bessel_y.cpp | 10 +- .../test_cyl_bessel_y0.cpp | 10 +- .../test_cyl_bessel_y1.cpp | 10 +- .../test_cyl_bessel_ye.cpp | 10 +- tests/scipy_special_tests/test_dawsn.cpp | 17 +- tests/scipy_special_tests/test_digamma.cpp | 17 +- tests/scipy_special_tests/test_ellipe.cpp | 10 +- tests/scipy_special_tests/test_ellipeinc.cpp | 10 +- tests/scipy_special_tests/test_ellipj.cpp | 14 +- tests/scipy_special_tests/test_ellipk.cpp | 10 +- tests/scipy_special_tests/test_ellipkinc.cpp | 10 +- tests/scipy_special_tests/test_ellipkm1.cpp | 10 +- tests/scipy_special_tests/test_erf.cpp | 27 +- tests/scipy_special_tests/test_erfc.cpp | 27 +- tests/scipy_special_tests/test_erfcinv.cpp | 10 +- tests/scipy_special_tests/test_erfcx.cpp | 17 +- tests/scipy_special_tests/test_erfi.cpp | 17 +- tests/scipy_special_tests/test_exp1.cpp | 17 +- tests/scipy_special_tests/test_exp10.cpp | 10 +- tests/scipy_special_tests/test_exp2.cpp | 10 +- tests/scipy_special_tests/test_expi.cpp | 17 +- tests/scipy_special_tests/test_expit.cpp | 20 +- tests/scipy_special_tests/test_expm1.cpp | 17 +- tests/scipy_special_tests/test_expn.cpp | 17 +- tests/scipy_special_tests/test_exprel.cpp | 10 +- tests/scipy_special_tests/test_fdtr.cpp | 7 +- tests/scipy_special_tests/test_fdtrc.cpp | 7 +- tests/scipy_special_tests/test_fdtri.cpp | 7 +- tests/scipy_special_tests/test_fresnel.cpp | 18 +- tests/scipy_special_tests/test_gamma.cpp | 17 +- tests/scipy_special_tests/test_gammainc.cpp | 20 +- tests/scipy_special_tests/test_gammaincc.cpp | 20 +- .../scipy_special_tests/test_gammainccinv.cpp | 10 +- .../scipy_special_tests/test_gammaincinv.cpp | 10 +- tests/scipy_special_tests/test_gammaln.cpp | 20 +- tests/scipy_special_tests/test_gammasgn.cpp | 10 +- tests/scipy_special_tests/test_gdtr.cpp | 7 +- tests/scipy_special_tests/test_gdtrc.cpp | 7 +- tests/scipy_special_tests/test_gdtrib.cpp | 7 +- tests/scipy_special_tests/test_hyp1f1.cpp | 9 +- tests/scipy_special_tests/test_hyp2f1.cpp | 7 +- tests/scipy_special_tests/test_it1i0k0.cpp | 7 +- tests/scipy_special_tests/test_it1j0y0.cpp | 7 +- tests/scipy_special_tests/test_it2i0k0.cpp | 7 +- tests/scipy_special_tests/test_it2j0y0.cpp | 7 +- tests/scipy_special_tests/test_it2struve0.cpp | 10 +- tests/scipy_special_tests/test_itairy.cpp | 9 +- .../scipy_special_tests/test_itmodstruve0.cpp | 10 +- tests/scipy_special_tests/test_itstruve0.cpp | 10 +- tests/scipy_special_tests/test_iv_ratio.cpp | 10 +- tests/scipy_special_tests/test_iv_ratio_c.cpp | 10 +- tests/scipy_special_tests/test_kei.cpp | 10 +- tests/scipy_special_tests/test_keip.cpp | 10 +- tests/scipy_special_tests/test_ker.cpp | 10 +- tests/scipy_special_tests/test_kerp.cpp | 10 +- tests/scipy_special_tests/test_kolmogc.cpp | 10 +- tests/scipy_special_tests/test_kolmogci.cpp | 10 +- tests/scipy_special_tests/test_kolmogi.cpp | 10 +- tests/scipy_special_tests/test_kolmogorov.cpp | 10 +- tests/scipy_special_tests/test_kolmogp.cpp | 10 +- .../test_lanczos_sum_expg_scaled.cpp | 10 +- tests/scipy_special_tests/test_lgam1p.cpp | 10 +- tests/scipy_special_tests/test_log1p.cpp | 17 +- tests/scipy_special_tests/test_log1pmx.cpp | 10 +- tests/scipy_special_tests/test_log_expit.cpp | 20 +- .../test_log_wright_bessel.cpp | 7 +- tests/scipy_special_tests/test_loggamma.cpp | 17 +- tests/scipy_special_tests/test_logit.cpp | 20 +- tests/scipy_special_tests/test_mcm1.cpp | 9 +- tests/scipy_special_tests/test_mcm2.cpp | 9 +- .../test_modified_fresnel_minus.cpp | 9 +- .../test_modified_fresnel_plus.cpp | 9 +- tests/scipy_special_tests/test_msm1.cpp | 9 +- tests/scipy_special_tests/test_msm2.cpp | 9 +- tests/scipy_special_tests/test_nbdtr.cpp | 8 +- tests/scipy_special_tests/test_nbdtrc.cpp | 8 +- tests/scipy_special_tests/test_ndtr.cpp | 27 +- tests/scipy_special_tests/test_ndtri.cpp | 20 +- .../scipy_special_tests/test_oblate_aswfa.cpp | 14 +- .../test_oblate_radial1.cpp | 14 +- .../test_oblate_radial2.cpp | 14 +- tests/scipy_special_tests/test_owens_t.cpp | 10 +- tests/scipy_special_tests/test_pdtr.cpp | 10 +- tests/scipy_special_tests/test_pdtrc.cpp | 10 +- tests/scipy_special_tests/test_pdtri.cpp | 8 +- tests/scipy_special_tests/test_pmv.cpp | 7 +- tests/scipy_special_tests/test_poch.cpp | 10 +- .../test_prolate_aswfa.cpp | 14 +- .../test_prolate_radial1.cpp | 14 +- .../test_prolate_radial2.cpp | 14 +- .../scipy_special_tests/test_prolate_segv.cpp | 7 +- tests/scipy_special_tests/test_radian.cpp | 7 +- tests/scipy_special_tests/test_rgamma.cpp | 17 +- .../scipy_special_tests/test_riemann_zeta.cpp | 17 +- tests/scipy_special_tests/test_round.cpp | 10 +- .../scipy_special_tests/test_scaled_exp1.cpp | 10 +- tests/scipy_special_tests/test_sem.cpp | 9 +- tests/scipy_special_tests/test_sem_cva.cpp | 10 +- tests/scipy_special_tests/test_shichi.cpp | 18 +- tests/scipy_special_tests/test_sici.cpp | 18 +- tests/scipy_special_tests/test_sindg.cpp | 10 +- tests/scipy_special_tests/test_sinpi.cpp | 17 +- tests/scipy_special_tests/test_smirnov.cpp | 8 +- tests/scipy_special_tests/test_smirnovc.cpp | 7 +- tests/scipy_special_tests/test_smirnovci.cpp | 7 +- tests/scipy_special_tests/test_smirnovi.cpp | 8 +- tests/scipy_special_tests/test_smirnovp.cpp | 7 +- tests/scipy_special_tests/test_spence.cpp | 10 +- tests/scipy_special_tests/test_struve_h.cpp | 10 +- tests/scipy_special_tests/test_struve_l.cpp | 10 +- tests/scipy_special_tests/test_tandg.cpp | 10 +- .../test_voigt_profile.cpp | 7 +- tests/scipy_special_tests/test_wofz.cpp | 7 +- .../test_wright_bessel.cpp | 7 +- tests/scipy_special_tests/test_xlog1py.cpp | 10 +- tests/scipy_special_tests/test_xlogy.cpp | 20 +- tests/scipy_special_tests/test_zeta.cpp | 10 +- tests/scipy_special_tests/test_zetac.cpp | 10 +- tests/test_hyp2f1.cpp | 42 +- 211 files changed, 16556 insertions(+), 14058 deletions(-) diff --git a/include/xsf/airy.h b/include/xsf/airy.h index 7bdec53..8d0dbf3 100644 --- a/include/xsf/airy.h +++ b/include/xsf/airy.h @@ -212,7 +212,7 @@ inline void airyb(double x, double *ai, double *bi, double *ad, double *bd) { *ad = c1 * df - c2 * dg; *bd = sr3 * (c1 * df + c2 * dg); } else { - km = (int) (24.5 - xa); + km = (int)(24.5 - xa); if (xa < 6.0) km = 14; if (xa > 15.0) diff --git a/include/xsf/amos/amos.h b/include/xsf/amos/amos.h index fad49b2..08d4ef5 100644 --- a/include/xsf/amos/amos.h +++ b/include/xsf/amos/amos.h @@ -94,2132 +94,1329 @@ #include -#include #include -#include // unique_ptr +#include +#include // unique_ptr namespace xsf { namespace amos { -int acai(std::complex, double, int, int, int, std::complex *, double, double, double, double); -int acon(std::complex, double, int, int, int, std::complex *, double, double, double, double, double); -int asyi(std::complex, double, int, int, std::complex *, double, double, double, double); -int binu(std::complex, double fnu, int, int, std::complex *, double, double, double, double, double); -int bknu(std::complex, double, int, int, std::complex *, double, double, double); -int buni(std::complex, double, int, int, std::complex *, int, int *, double, double, double, double); -int bunk(std::complex, double, int, int, int, std::complex *, double, double, double); -double gamln(double); -int kscl(std::complex, double, int, std::complex *, std::complex, double *, double, double); -int mlri(std::complex, double, int, int, std::complex *, double); -void rati(std::complex, double, int, std::complex *, double); -int seri(std::complex, double, int, int, std::complex *, double, double, double); -int s1s2(std::complex, std::complex *, std::complex *, double, double, int *); -int uchk(std::complex, double, double); -void unhj(std::complex, double, int, double, std::complex *, std::complex *, std::complex *, std::complex *, std::complex *, std::complex *); -void uni1(std::complex, double, int, int, std::complex *, int *, int *, double, double, double, double); -void uni2(std::complex, double, int, int, std::complex *, int *, int *, double, double, double, double); -void unik(std::complex, double, int, int, double, int *, std::complex *, std::complex *, std::complex *, std::complex *, std::complex *); -int unk1(std::complex, double, int, int, int, std::complex *, double, double, double); -int unk2(std::complex, double, int, int, int, std::complex *, double, double, double); -int uoik(std::complex, double, int, int, int, std::complex *, double, double, double); -int wrsk(std::complex, double, int, int, std::complex *, std::complex *, double, double, double); - - -constexpr double d1mach[5] = { - 2.2250738585072014e-308, /* np.finfo(np.float64).tiny */ - 1.7976931348623157e+308, /* np.finfo(np.float64).max */ - 1.1102230246251565e-16, /* 0.5 * np.finfo(np.float64).eps */ - 2.220446049250313e-16, /* np.finfo(np.float64).eps */ - 0.3010299956639812 /* np.log10(2) */ -}; - -constexpr double i1mach[16] = { - 5, /* standard input */ - 6, /* standard output */ - 7, /* standard punch */ - 0, /* standard error */ - 32, /* bits per integer */ - 4, /* sizeof(int); */ - 2, /* base for integers */ - 31, /* digits of integer base */ - 2147483647, /* LONG MAX 2**31 - 1 */ - 2, /* FLT_RADIX; */ - 24, /* FLT_MANT_DIG; */ - -126, /* FLT_MIN_EXP; */ - 128, /* FLT_MAX_EXP; */ - 53, /* DBL_MANT_DIG; */ - -1021, /* DBL_MIN_EXP; */ - 1024 /* DBL_MAX_EXP; */ -}; - -constexpr double zunhj_ar[14] = { - 1.00000000000000000e+00, 1.04166666666666667e-01, 8.35503472222222222e-02, 1.28226574556327160e-01, // 0 - 2.91849026464140464e-01, 8.81627267443757652e-01, 3.32140828186276754e+00, 1.49957629868625547e+01, // 4 - 7.89230130115865181e+01, 4.74451538868264323e+02, 3.20749009089066193e+03, 2.40865496408740049e+04, // 8 - 1.98923119169509794e+05, 1.79190200777534383e+06 // 12 -}; - -constexpr double zunhj_br[14] = { - 1.00000000000000000e+00, -1.45833333333333333e-01, -9.87413194444444444e-02, -1.43312053915895062e-01, // 0 - -3.17227202678413548e-01, -9.42429147957120249e-01, -3.51120304082635426e+00, -1.57272636203680451e+01, // 4 - -8.22814390971859444e+01, -4.92355370523670524e+02, -3.31621856854797251e+03, -2.48276742452085896e+04, // 8 - -2.04526587315129788e+05, -1.83844491706820990e+06 // 12 -}; - -constexpr double zunhj_c[105] = { - 1.00000000000000000e+00, -2.08333333333333333e-01, 1.25000000000000000e-01, 3.34201388888888889e-01, // 0 - -4.01041666666666667e-01, 7.03125000000000000e-02, -1.02581259645061728e+00, 1.84646267361111111e+00, // 4 - -8.91210937500000000e-01, 7.32421875000000000e-02, 4.66958442342624743e+00, -1.12070026162229938e+01, // 8 - 8.78912353515625000e+00, -2.36408691406250000e+00, 1.12152099609375000e-01, -2.82120725582002449e+01, // 12 - 8.46362176746007346e+01, -9.18182415432400174e+01, 4.25349987453884549e+01, -7.36879435947963170e+00, // 16 - 2.27108001708984375e-01, 2.12570130039217123e+02, -7.65252468141181642e+02, 1.05999045252799988e+03, // 20 - -6.99579627376132541e+02, 2.18190511744211590e+02, -2.64914304869515555e+01, 5.72501420974731445e-01, // 24 - -1.91945766231840700e+03, 8.06172218173730938e+03, -1.35865500064341374e+04, 1.16553933368645332e+04, // 28 - -5.30564697861340311e+03, 1.20090291321635246e+03, -1.08090919788394656e+02, 1.72772750258445740e+00, // 32 - 2.02042913309661486e+04, -9.69805983886375135e+04, 1.92547001232531532e+05, -2.03400177280415534e+05, // 36 - 1.22200464983017460e+05, -4.11926549688975513e+04, 7.10951430248936372e+03, -4.93915304773088012e+02, // 40 - 6.07404200127348304e+00, -2.42919187900551333e+05, 1.31176361466297720e+06, -2.99801591853810675e+06, // 44 - 3.76327129765640400e+06, -2.81356322658653411e+06, 1.26836527332162478e+06, -3.31645172484563578e+05, // 48 - 4.52187689813627263e+04, -2.49983048181120962e+03, 2.43805296995560639e+01, 3.28446985307203782e+06, // 52 - -1.97068191184322269e+07, 5.09526024926646422e+07, -7.41051482115326577e+07, 6.63445122747290267e+07, // 56 - -3.75671766607633513e+07, 1.32887671664218183e+07, -2.78561812808645469e+06, 3.08186404612662398e+05, // 60 - -1.38860897537170405e+04, 1.10017140269246738e+02, -4.93292536645099620e+07, 3.25573074185765749e+08, // 64 - -9.39462359681578403e+08, 1.55359689957058006e+09, -1.62108055210833708e+09, 1.10684281682301447e+09, // 68 - -4.95889784275030309e+08, 1.42062907797533095e+08, -2.44740627257387285e+07, 2.24376817792244943e+06, // 72 - -8.40054336030240853e+04, 5.51335896122020586e+02, 8.14789096118312115e+08, -5.86648149205184723e+09, // 76 - 1.86882075092958249e+10, -3.46320433881587779e+10, 4.12801855797539740e+10, -3.30265997498007231e+10, // 80 - 1.79542137311556001e+10, -6.56329379261928433e+09, 1.55927986487925751e+09, -2.25105661889415278e+08, // 84 - 1.73951075539781645e+07, -5.49842327572288687e+05, 3.03809051092238427e+03, -1.46792612476956167e+10, // 88 - 1.14498237732025810e+11, -3.99096175224466498e+11, 8.19218669548577329e+11, -1.09837515608122331e+12, // 92 - 1.00815810686538209e+12, -6.45364869245376503e+11, 2.87900649906150589e+11, -8.78670721780232657e+10, // 96 - 1.76347306068349694e+10, -2.16716498322379509e+09, 1.43157876718888981e+08, -3.87183344257261262e+06, // 100 - 1.82577554742931747e+04 // 104 -}; - -constexpr double zunhj_alfa[180] = { - -4.44444444444444444e-03, -9.22077922077922078e-04, -8.84892884892884893e-05, 1.65927687832449737e-04, // 0 - 2.46691372741792910e-04, 2.65995589346254780e-04, 2.61824297061500945e-04, 2.48730437344655609e-04, // 4 - 2.32721040083232098e-04, 2.16362485712365082e-04, 2.00738858762752355e-04, 1.86267636637545172e-04, // 8 - 1.73060775917876493e-04, 1.61091705929015752e-04, 1.50274774160908134e-04, 1.40503497391269794e-04, // 12 - 1.31668816545922806e-04, 1.23667445598253261e-04, 1.16405271474737902e-04, 1.09798298372713369e-04, // 16 - 1.03772410422992823e-04, 9.82626078369363448e-05, 9.32120517249503256e-05, 8.85710852478711718e-05, // 20 - 8.42963105715700223e-05, 8.03497548407791151e-05, 7.66981345359207388e-05, 7.33122157481777809e-05, // 24 - 7.01662625163141333e-05, 6.72375633790160292e-05, 6.93735541354588974e-04, 2.32241745182921654e-04, // 28 - -1.41986273556691197e-05, -1.16444931672048640e-04, -1.50803558053048762e-04, -1.55121924918096223e-04, // 32 - -1.46809756646465549e-04, -1.33815503867491367e-04, -1.19744975684254051e-04, -1.06184319207974020e-04, // 36 - -9.37699549891194492e-05, -8.26923045588193274e-05, -7.29374348155221211e-05, -6.44042357721016283e-05, // 40 - -5.69611566009369048e-05, -5.04731044303561628e-05, -4.48134868008882786e-05, -3.98688727717598864e-05, // 44 - -3.55400532972042498e-05, -3.17414256609022480e-05, -2.83996793904174811e-05, -2.54522720634870566e-05, // 48 - -2.28459297164724555e-05, -2.05352753106480604e-05, -1.84816217627666085e-05, -1.66519330021393806e-05, // 52 - -1.50179412980119482e-05, -1.35554031379040526e-05, -1.22434746473858131e-05, -1.10641884811308169e-05, // 56 - -3.54211971457743841e-04, -1.56161263945159416e-04, 3.04465503594936410e-05, 1.30198655773242693e-04, // 60 - 1.67471106699712269e-04, 1.70222587683592569e-04, 1.56501427608594704e-04, 1.36339170977445120e-04, // 64 - 1.14886692029825128e-04, 9.45869093034688111e-05, 7.64498419250898258e-05, 6.07570334965197354e-05, // 68 - 4.74394299290508799e-05, 3.62757512005344297e-05, 2.69939714979224901e-05, 1.93210938247939253e-05, // 72 - 1.30056674793963203e-05, 7.82620866744496661e-06, 3.59257485819351583e-06, 1.44040049814251817e-07, // 76 - -2.65396769697939116e-06, -4.91346867098485910e-06, -6.72739296091248287e-06, -8.17269379678657923e-06, // 80 - -9.31304715093561232e-06, -1.02011418798016441e-05, -1.08805962510592880e-05, -1.13875481509603555e-05, // 84 - -1.17519675674556414e-05, -1.19987364870944141e-05, 3.78194199201772914e-04, 2.02471952761816167e-04, // 88 - -6.37938506318862408e-05, -2.38598230603005903e-04, -3.10916256027361568e-04, -3.13680115247576316e-04, // 92 - -2.78950273791323387e-04, -2.28564082619141374e-04, -1.75245280340846749e-04, -1.25544063060690348e-04, // 96 - -8.22982872820208365e-05, -4.62860730588116458e-05, -1.72334302366962267e-05, 5.60690482304602267e-06, // 100 - 2.31395443148286800e-05, 3.62642745856793957e-05, 4.58006124490188752e-05, 5.24595294959114050e-05, // 104 - 5.68396208545815266e-05, 5.94349820393104052e-05, 6.06478527578421742e-05, 6.08023907788436497e-05, // 108 - 6.01577894539460388e-05, 5.89199657344698500e-05, 5.72515823777593053e-05, 5.52804375585852577e-05, // 112 - 5.31063773802880170e-05, 5.08069302012325706e-05, 4.84418647620094842e-05, 4.60568581607475370e-05, // 116 - -6.91141397288294174e-04, -4.29976633058871912e-04, 1.83067735980039018e-04, 6.60088147542014144e-04, // 120 - 8.75964969951185931e-04, 8.77335235958235514e-04, 7.49369585378990637e-04, 5.63832329756980918e-04, // 124 - 3.68059319971443156e-04, 1.88464535514455599e-04, 3.70663057664904149e-05, -8.28520220232137023e-05, // 128 - -1.72751952869172998e-04, -2.36314873605872983e-04, -2.77966150694906658e-04, -3.02079514155456919e-04, // 132 - -3.12594712643820127e-04, -3.12872558758067163e-04, -3.05678038466324377e-04, -2.93226470614557331e-04, // 136 - -2.77255655582934777e-04, -2.59103928467031709e-04, -2.39784014396480342e-04, -2.20048260045422848e-04, // 140 - -2.00443911094971498e-04, -1.81358692210970687e-04, -1.63057674478657464e-04, -1.45712672175205844e-04, // 144 - -1.29425421983924587e-04, -1.14245691942445952e-04, 1.92821964248775885e-03, 1.35592576302022234e-03, // 148 - -7.17858090421302995e-04, -2.58084802575270346e-03, -3.49271130826168475e-03, -3.46986299340960628e-03, // 152 - -2.82285233351310182e-03, -1.88103076404891354e-03, -8.89531718383947600e-04, 3.87912102631035228e-06, // 156 - 7.28688540119691412e-04, 1.26566373053457758e-03, 1.62518158372674427e-03, 1.83203153216373172e-03, // 160 - 1.91588388990527909e-03, 1.90588846755546138e-03, 1.82798982421825727e-03, 1.70389506421121530e-03, // 164 - 1.55097127171097686e-03, 1.38261421852276159e-03, 1.20881424230064774e-03, 1.03676532638344962e-03, // 168 - 8.71437918068619115e-04, 7.16080155297701002e-04, 5.72637002558129372e-04, 4.42089819465802277e-04, // 172 - 3.24724948503090564e-04, 2.20342042730246599e-04, 1.28412898401353882e-04, 4.82005924552095464e-05 // 176 -}; - -constexpr double zunhj_beta[210] = { - 1.79988721413553309e-02, 5.59964911064388073e-03, 2.88501402231132779e-03, 1.80096606761053941e-03, // 0 - 1.24753110589199202e-03, 9.22878876572938311e-04, 7.14430421727287357e-04, 5.71787281789704872e-04, // 4 - 4.69431007606481533e-04, 3.93232835462916638e-04, 3.34818889318297664e-04, 2.88952148495751517e-04, // 8 - 2.52211615549573284e-04, 2.22280580798883327e-04, 1.97541838033062524e-04, 1.76836855019718004e-04, // 12 - 1.59316899661821081e-04, 1.44347930197333986e-04, 1.31448068119965379e-04, 1.20245444949302884e-04, // 16 - 1.10449144504599392e-04, 1.01828770740567258e-04, 9.41998224204237509e-05, 8.74130545753834437e-05, // 20 - 8.13466262162801467e-05, 7.59002269646219339e-05, 7.09906300634153481e-05, 6.65482874842468183e-05, // 24 - 6.25146958969275078e-05, 5.88403394426251749e-05, -1.49282953213429172e-03, -8.78204709546389328e-04, // 28 - -5.02916549572034614e-04, -2.94822138512746025e-04, -1.75463996970782828e-04, -1.04008550460816434e-04, // 32 - -5.96141953046457895e-05, -3.12038929076098340e-05, -1.26089735980230047e-05, -2.42892608575730389e-07, // 36 - 8.05996165414273571e-06, 1.36507009262147391e-05, 1.73964125472926261e-05, 1.98672978842133780e-05, // 40 - 2.14463263790822639e-05, 2.23954659232456514e-05, 2.28967783814712629e-05, 2.30785389811177817e-05, // 44 - 2.30321976080909144e-05, 2.28236073720348722e-05, 2.25005881105292418e-05, 2.20981015361991429e-05, // 48 - 2.16418427448103905e-05, 2.11507649256220843e-05, 2.06388749782170737e-05, 2.01165241997081666e-05, // 52 - 1.95913450141179244e-05, 1.90689367910436740e-05, 1.85533719641636667e-05, 1.80475722259674218e-05, // 56 - 5.52213076721292790e-04, 4.47932581552384646e-04, 2.79520653992020589e-04, 1.52468156198446602e-04, // 60 - 6.93271105657043598e-05, 1.76258683069991397e-05, -1.35744996343269136e-05, -3.17972413350427135e-05, // 64 - -4.18861861696693365e-05, -4.69004889379141029e-05, -4.87665447413787352e-05, -4.87010031186735069e-05, // 68 - -4.74755620890086638e-05, -4.55813058138628452e-05, -4.33309644511266036e-05, -4.09230193157750364e-05, // 72 - -3.84822638603221274e-05, -3.60857167535410501e-05, -3.37793306123367417e-05, -3.15888560772109621e-05, // 76 - -2.95269561750807315e-05, -2.75978914828335759e-05, -2.58006174666883713e-05, -2.41308356761280200e-05, // 80 - -2.25823509518346033e-05, -2.11479656768912971e-05, -1.98200638885294927e-05, -1.85909870801065077e-05, // 84 - -1.74532699844210224e-05, -1.63997823854497997e-05, -4.74617796559959808e-04, -4.77864567147321487e-04, // 88 - -3.20390228067037603e-04, -1.61105016119962282e-04, -4.25778101285435204e-05, 3.44571294294967503e-05, // 92 - 7.97092684075674924e-05, 1.03138236708272200e-04, 1.12466775262204158e-04, 1.13103642108481389e-04, // 96 - 1.08651634848774268e-04, 1.01437951597661973e-04, 9.29298396593363896e-05, 8.40293133016089978e-05, // 100 - 7.52727991349134062e-05, 6.69632521975730872e-05, 5.92564547323194704e-05, 5.22169308826975567e-05, // 104 - 4.58539485165360646e-05, 4.01445513891486808e-05, 3.50481730031328081e-05, 3.05157995034346659e-05, // 108 - 2.64956119950516039e-05, 2.29363633690998152e-05, 1.97893056664021636e-05, 1.70091984636412623e-05, // 112 - 1.45547428261524004e-05, 1.23886640995878413e-05, 1.04775876076583236e-05, 8.79179954978479373e-06, // 116 - 7.36465810572578444e-04, 8.72790805146193976e-04, 6.22614862573135066e-04, 2.85998154194304147e-04, // 120 - 3.84737672879366102e-06, -1.87906003636971558e-04, -2.97603646594554535e-04, -3.45998126832656348e-04, // 124 - -3.53382470916037712e-04, -3.35715635775048757e-04, -3.04321124789039809e-04, -2.66722723047612821e-04, // 128 - -2.27654214122819527e-04, -1.89922611854562356e-04, -1.55058918599093870e-04, -1.23778240761873630e-04, // 132 - -9.62926147717644187e-05, -7.25178327714425337e-05, -5.22070028895633801e-05, -3.50347750511900522e-05, // 136 - -2.06489761035551757e-05, -8.70106096849767054e-06, 1.13698686675100290e-06, 9.16426474122778849e-06, // 140 - 1.56477785428872620e-05, 2.08223629482466847e-05, 2.48923381004595156e-05, 2.80340509574146325e-05, // 144 - 3.03987774629861915e-05, 3.21156731406700616e-05, -1.80182191963885708e-03, -2.43402962938042533e-03, // 148 - -1.83422663549856802e-03, -7.62204596354009765e-04, 2.39079475256927218e-04, 9.49266117176881141e-04, // 152 - 1.34467449701540359e-03, 1.48457495259449178e-03, 1.44732339830617591e-03, 1.30268261285657186e-03, // 156 - 1.10351597375642682e-03, 8.86047440419791759e-04, 6.73073208165665473e-04, 4.77603872856582378e-04, // 160 - 3.05991926358789362e-04, 1.60315694594721630e-04, 4.00749555270613286e-05, -5.66607461635251611e-05, // 164 - -1.32506186772982638e-04, -1.90296187989614057e-04, -2.32811450376937408e-04, -2.62628811464668841e-04, // 168 - -2.82050469867598672e-04, -2.93081563192861167e-04, -2.97435962176316616e-04, -2.96557334239348078e-04, // 172 - -2.91647363312090861e-04, -2.83696203837734166e-04, -2.73512317095673346e-04, -2.61750155806768580e-04, // 176 - 6.38585891212050914e-03, 9.62374215806377941e-03, 7.61878061207001043e-03, 2.83219055545628054e-03, // 180 - -2.09841352012720090e-03, -5.73826764216626498e-03, -7.70804244495414620e-03, -8.21011692264844401e-03, // 184 - -7.65824520346905413e-03, -6.47209729391045177e-03, -4.99132412004966473e-03, -3.45612289713133280e-03, // 188 - -2.01785580014170775e-03, -7.59430686781961401e-04, 2.84173631523859138e-04, 1.10891667586337403e-03, // 192 - 1.72901493872728771e-03, 2.16812590802684701e-03, 2.45357710494539735e-03, 2.61281821058334862e-03, // 196 - 2.67141039656276912e-03, 2.65203073395980430e-03, 2.57411652877287315e-03, 2.45389126236094427e-03, // 200 - 2.30460058071795494e-03, 2.13684837686712662e-03, 1.95896528478870911e-03, 1.77737008679454412e-03, // 204 - 1.59690280765839059e-03, 1.42111975664438546e-03 // 208 -}; - -constexpr double zunhj_gama[30] = { - 6.29960524947436582e-01, 2.51984209978974633e-01, 1.54790300415655846e-01, 1.10713062416159013e-01, // 0 - 8.57309395527394825e-02, 6.97161316958684292e-02, 5.86085671893713576e-02, 5.04698873536310685e-02, // 4 - 4.42600580689154809e-02, 3.93720661543509966e-02, 3.54283195924455368e-02, 3.21818857502098231e-02, // 8 - 2.94646240791157679e-02, 2.71581677112934479e-02, 2.51768272973861779e-02, 2.34570755306078891e-02, // 12 - 2.19508390134907203e-02, 2.06210828235646240e-02, 1.94388240897880846e-02, 1.83810633800683158e-02, // 16 - 1.74293213231963172e-02, 1.65685837786612353e-02, 1.57865285987918445e-02, 1.50729501494095594e-02, // 20 - 1.44193250839954639e-02, 1.38184805735341786e-02, 1.32643378994276568e-02, 1.27517121970498651e-02, // 24 - 1.22761545318762767e-02, 1.18338262398482403e-02 // 28 -}; - -constexpr double zunik_c[120] = { - 1.00000000000000000e+00, -2.08333333333333333e-01, 1.25000000000000000e-01, 3.34201388888888889e-01, // 0 - -4.01041666666666667e-01, 7.03125000000000000e-02, -1.02581259645061728e+00, 1.84646267361111111e+00, // 4 - -8.91210937500000000e-01, 7.32421875000000000e-02, 4.66958442342624743e+00, -1.12070026162229938e+01, // 8 - 8.78912353515625000e+00, -2.36408691406250000e+00, 1.12152099609375000e-01, -2.82120725582002449e+01, // 12 - 8.46362176746007346e+01, -9.18182415432400174e+01, 4.25349987453884549e+01, -7.36879435947963170e+00, // 16 - 2.27108001708984375e-01, 2.12570130039217123e+02, -7.65252468141181642e+02, 1.05999045252799988e+03, // 20 - -6.99579627376132541e+02, 2.18190511744211590e+02, -2.64914304869515555e+01, 5.72501420974731445e-01, // 24 - -1.91945766231840700e+03, 8.06172218173730938e+03, -1.35865500064341374e+04, 1.16553933368645332e+04, // 28 - -5.30564697861340311e+03, 1.20090291321635246e+03, -1.08090919788394656e+02, 1.72772750258445740e+00, // 32 - 2.02042913309661486e+04, -9.69805983886375135e+04, 1.92547001232531532e+05, -2.03400177280415534e+05, // 36 - 1.22200464983017460e+05, -4.11926549688975513e+04, 7.10951430248936372e+03, -4.93915304773088012e+02, // 40 - 6.07404200127348304e+00, -2.42919187900551333e+05, 1.31176361466297720e+06, -2.99801591853810675e+06, // 44 - 3.76327129765640400e+06, -2.81356322658653411e+06, 1.26836527332162478e+06, -3.31645172484563578e+05, // 48 - 4.52187689813627263e+04, -2.49983048181120962e+03, 2.43805296995560639e+01, 3.28446985307203782e+06, // 52 - -1.97068191184322269e+07, 5.09526024926646422e+07, -7.41051482115326577e+07, 6.63445122747290267e+07, // 56 - -3.75671766607633513e+07, 1.32887671664218183e+07, -2.78561812808645469e+06, 3.08186404612662398e+05, // 60 - -1.38860897537170405e+04, 1.10017140269246738e+02, -4.93292536645099620e+07, 3.25573074185765749e+08, // 64 - -9.39462359681578403e+08, 1.55359689957058006e+09, -1.62108055210833708e+09, 1.10684281682301447e+09, // 68 - -4.95889784275030309e+08, 1.42062907797533095e+08, -2.44740627257387285e+07, 2.24376817792244943e+06, // 72 - -8.40054336030240853e+04, 5.51335896122020586e+02, 8.14789096118312115e+08, -5.86648149205184723e+09, // 76 - 1.86882075092958249e+10, -3.46320433881587779e+10, 4.12801855797539740e+10, -3.30265997498007231e+10, // 80 - 1.79542137311556001e+10, -6.56329379261928433e+09, 1.55927986487925751e+09, -2.25105661889415278e+08, // 84 - 1.73951075539781645e+07, -5.49842327572288687e+05, 3.03809051092238427e+03, -1.46792612476956167e+10, // 88 - 1.14498237732025810e+11, -3.99096175224466498e+11, 8.19218669548577329e+11, -1.09837515608122331e+12, // 92 - 1.00815810686538209e+12, -6.45364869245376503e+11, 2.87900649906150589e+11, -8.78670721780232657e+10, // 96 - 1.76347306068349694e+10, -2.16716498322379509e+09, 1.43157876718888981e+08, -3.87183344257261262e+06, // 100 - 1.82577554742931747e+04, 2.86464035717679043e+11, -2.40629790002850396e+12, 9.10934118523989896e+12, // 104 - -2.05168994109344374e+13, 3.05651255199353206e+13, -3.16670885847851584e+13, 2.33483640445818409e+13, // 108 - -1.23204913055982872e+13, 4.61272578084913197e+12, -1.19655288019618160e+12, 2.05914503232410016e+11, // 112 - -2.18229277575292237e+10, 1.24700929351271032e+09, -2.91883881222208134e+07, 1.18838426256783253e+05 // 116 -}; - -constexpr double dgamln_gln[100] = { - 0.00000000000000000e+00, 0.00000000000000000e+00, 6.93147180559945309e-01, 1.79175946922805500e+00, // 0 - 3.17805383034794562e+00, 4.78749174278204599e+00, 6.57925121201010100e+00, 8.52516136106541430e+00, // 4 - 1.06046029027452502e+01, 1.28018274800814696e+01, 1.51044125730755153e+01, 1.75023078458738858e+01, // 8 - 1.99872144956618861e+01, 2.25521638531234229e+01, 2.51912211827386815e+01, 2.78992713838408916e+01, // 12 - 3.06718601060806728e+01, 3.35050734501368889e+01, 3.63954452080330536e+01, 3.93398841871994940e+01, // 16 - 4.23356164607534850e+01, 4.53801388984769080e+01, 4.84711813518352239e+01, 5.16066755677643736e+01, // 20 - 5.47847293981123192e+01, 5.80036052229805199e+01, 6.12617017610020020e+01, 6.45575386270063311e+01, // 24 - 6.78897431371815350e+01, 7.12570389671680090e+01, 7.46582363488301644e+01, 7.80922235533153106e+01, // 28 - 8.15579594561150372e+01, 8.50544670175815174e+01, 8.85808275421976788e+01, 9.21361756036870925e+01, // 32 - 9.57196945421432025e+01, 9.93306124547874269e+01, 1.02968198614513813e+02, 1.06631760260643459e+02, // 36 - 1.10320639714757395e+02, 1.14034211781461703e+02, 1.17771881399745072e+02, 1.21533081515438634e+02, // 40 - 1.25317271149356895e+02, 1.29123933639127215e+02, 1.32952575035616310e+02, 1.36802722637326368e+02, // 44 - 1.40673923648234259e+02, 1.44565743946344886e+02, 1.48477766951773032e+02, 1.52409592584497358e+02, // 48 - 1.56360836303078785e+02, 1.60331128216630907e+02, 1.64320112263195181e+02, 1.68327445448427652e+02, // 52 - 1.72352797139162802e+02, 1.76395848406997352e+02, 1.80456291417543771e+02, 1.84533828861449491e+02, // 56 - 1.88628173423671591e+02, 1.92739047287844902e+02, 1.96866181672889994e+02, 2.01009316399281527e+02, // 60 - 2.05168199482641199e+02, 2.09342586752536836e+02, 2.13532241494563261e+02, 2.17736934113954227e+02, // 64 - 2.21956441819130334e+02, 2.26190548323727593e+02, 2.30439043565776952e+02, 2.34701723442818268e+02, // 68 - 2.38978389561834323e+02, 2.43268849002982714e+02, 2.47572914096186884e+02, 2.51890402209723194e+02, // 72 - 2.56221135550009525e+02, 2.60564940971863209e+02, 2.64921649798552801e+02, 2.69291097651019823e+02, // 76 - 2.73673124285693704e+02, 2.78067573440366143e+02, 2.82474292687630396e+02, 2.86893133295426994e+02, // 80 - 2.91323950094270308e+02, 2.95766601350760624e+02, 3.00220948647014132e+02, 3.04686856765668715e+02, // 84 - 3.09164193580146922e+02, 3.13652829949879062e+02, 3.18152639620209327e+02, 3.22663499126726177e+02, // 88 - 3.27185287703775217e+02, 3.31717887196928473e+02, 3.36261181979198477e+02, 3.40815058870799018e+02, // 92 - 3.45379407062266854e+02, 3.49954118040770237e+02, 3.54539085519440809e+02, 3.59134205369575399e+02 // 96 -}; - -constexpr double dgamln_cf[22] = { - 8.33333333333333333e-02, -2.77777777777777778e-03, 7.93650793650793651e-04, -5.95238095238095238e-04, // 0 - 8.41750841750841751e-04, -1.91752691752691753e-03, 6.41025641025641026e-03, -2.95506535947712418e-02, // 4 - 1.79644372368830573e-01, -1.39243221690590112e+00, 1.34028640441683920e+01, -1.56848284626002017e+02, // 8 - 2.19310333333333333e+03, -3.61087712537249894e+04, 6.91472268851313067e+05, -1.52382215394074162e+07, // 12 - 3.82900751391414141e+08, -1.08822660357843911e+10, 3.47320283765002252e+11, -1.23696021422692745e+13, // 16 - 4.88788064793079335e+14, -2.13203339609193739e+16 // 20 -}; - - -inline int acai( - std::complex z, - double fnu, - int kode, - int mr, - int n, - std::complex *y, - double rl, - double tol, - double elim, - double alim -) { - - //***BEGIN PROLOGUE ZACAI - //***REFER TO ZAIRY - // - // ZACAI APPLIES THE ANALYTIC CONTINUATION FORMULA - // - // K(FNU,ZN*EXP(MP))=K(FNU,ZN)*EXP(-MP*FNU) - MP*I(FNU,ZN) - // MP=PI*MR*std::complex(0.0,1.0) - // - // TO CONTINUE THE K FUNCTION FROM THE RIGHT HALF TO THE LEFT - // HALF Z PLANE FOR USE WITH ZAIRY WHERE FNU=1/3 OR 2/3 AND N=1. - // ZACAI IS THE SAME AS ZACON WITH THE PARTS FOR LARGER ORDERS AND - // RECURRENCE REMOVED. A RECURSIVE CALL TO ZACON CAN RESULT IF ZACON - // IS CALLED FROM ZAIRY. - // - //***ROUTINES CALLED ZASYI,ZBKNU,ZMLRI,ZSERI,ZS1S2,D1MACH,AZABS - //***END PROLOGUE ZACAI - - std::complex csgn, cspn, c1, c2, zn, cy[2]; - double arg, ascle, az, cpn, dfnu, fmr, sgn, spn, yy; - int inu, iuf, nn, nw; - double pi = 3.14159265358979324; - int nz = 0; - zn = -z; - az = std::abs(z); - nn = n; - dfnu = fnu + (n-1); - if ((az > 2.0) && (az*az*0.25 > dfnu+1.0)) { - /* 20 */ - if (az >= rl) { - // - // ASYMPTOTIC EXPANSION FOR LARGE Z FOR THE I FUNCTION - // - nw = asyi(zn, fnu, kode, nn, y, rl, tol, elim, alim); + int acai(std::complex, double, int, int, int, std::complex *, double, double, double, double); + int + acon(std::complex, double, int, int, int, std::complex *, double, double, double, double, double); + int asyi(std::complex, double, int, int, std::complex *, double, double, double, double); + int + binu(std::complex, double fnu, int, int, std::complex *, double, double, double, double, double); + int bknu(std::complex, double, int, int, std::complex *, double, double, double); + int + buni(std::complex, double, int, int, std::complex *, int, int *, double, double, double, double); + int bunk(std::complex, double, int, int, int, std::complex *, double, double, double); + double gamln(double); + int kscl(std::complex, double, int, std::complex *, std::complex, double *, double, double); + int mlri(std::complex, double, int, int, std::complex *, double); + void rati(std::complex, double, int, std::complex *, double); + int seri(std::complex, double, int, int, std::complex *, double, double, double); + int s1s2(std::complex, std::complex *, std::complex *, double, double, int *); + int uchk(std::complex, double, double); + void unhj( + std::complex, double, int, double, std::complex *, std::complex *, + std::complex *, std::complex *, std::complex *, std::complex * + ); + void + uni1(std::complex, double, int, int, std::complex *, int *, int *, double, double, double, double); + void + uni2(std::complex, double, int, int, std::complex *, int *, int *, double, double, double, double); + void unik( + std::complex, double, int, int, double, int *, std::complex *, std::complex *, + std::complex *, std::complex *, std::complex * + ); + int unk1(std::complex, double, int, int, int, std::complex *, double, double, double); + int unk2(std::complex, double, int, int, int, std::complex *, double, double, double); + int uoik(std::complex, double, int, int, int, std::complex *, double, double, double); + int wrsk( + std::complex, double, int, int, std::complex *, std::complex *, double, double, double + ); + + constexpr double d1mach[5] = { + 2.2250738585072014e-308, /* np.finfo(np.float64).tiny */ + 1.7976931348623157e+308, /* np.finfo(np.float64).max */ + 1.1102230246251565e-16, /* 0.5 * np.finfo(np.float64).eps */ + 2.220446049250313e-16, /* np.finfo(np.float64).eps */ + 0.3010299956639812 /* np.log10(2) */ + }; + + constexpr double i1mach[16] = { + 5, /* standard input */ + 6, /* standard output */ + 7, /* standard punch */ + 0, /* standard error */ + 32, /* bits per integer */ + 4, /* sizeof(int); */ + 2, /* base for integers */ + 31, /* digits of integer base */ + 2147483647, /* LONG MAX 2**31 - 1 */ + 2, /* FLT_RADIX; */ + 24, /* FLT_MANT_DIG; */ + -126, /* FLT_MIN_EXP; */ + 128, /* FLT_MAX_EXP; */ + 53, /* DBL_MANT_DIG; */ + -1021, /* DBL_MIN_EXP; */ + 1024 /* DBL_MAX_EXP; */ + }; + + constexpr double zunhj_ar[14] = { + 1.00000000000000000e+00, 1.04166666666666667e-01, 8.35503472222222222e-02, 1.28226574556327160e-01, // 0 + 2.91849026464140464e-01, 8.81627267443757652e-01, 3.32140828186276754e+00, 1.49957629868625547e+01, // 4 + 7.89230130115865181e+01, 4.74451538868264323e+02, 3.20749009089066193e+03, 2.40865496408740049e+04, // 8 + 1.98923119169509794e+05, 1.79190200777534383e+06 // 12 + }; + + constexpr double zunhj_br[14] = { + 1.00000000000000000e+00, -1.45833333333333333e-01, -9.87413194444444444e-02, -1.43312053915895062e-01, // 0 + -3.17227202678413548e-01, -9.42429147957120249e-01, -3.51120304082635426e+00, -1.57272636203680451e+01, // 4 + -8.22814390971859444e+01, -4.92355370523670524e+02, -3.31621856854797251e+03, -2.48276742452085896e+04, // 8 + -2.04526587315129788e+05, -1.83844491706820990e+06 // 12 + }; + + constexpr double zunhj_c[105] = { + 1.00000000000000000e+00, -2.08333333333333333e-01, 1.25000000000000000e-01, 3.34201388888888889e-01, // 0 + -4.01041666666666667e-01, 7.03125000000000000e-02, -1.02581259645061728e+00, 1.84646267361111111e+00, // 4 + -8.91210937500000000e-01, 7.32421875000000000e-02, 4.66958442342624743e+00, -1.12070026162229938e+01, // 8 + 8.78912353515625000e+00, -2.36408691406250000e+00, 1.12152099609375000e-01, -2.82120725582002449e+01, // 12 + 8.46362176746007346e+01, -9.18182415432400174e+01, 4.25349987453884549e+01, -7.36879435947963170e+00, // 16 + 2.27108001708984375e-01, 2.12570130039217123e+02, -7.65252468141181642e+02, 1.05999045252799988e+03, // 20 + -6.99579627376132541e+02, 2.18190511744211590e+02, -2.64914304869515555e+01, 5.72501420974731445e-01, // 24 + -1.91945766231840700e+03, 8.06172218173730938e+03, -1.35865500064341374e+04, 1.16553933368645332e+04, // 28 + -5.30564697861340311e+03, 1.20090291321635246e+03, -1.08090919788394656e+02, 1.72772750258445740e+00, // 32 + 2.02042913309661486e+04, -9.69805983886375135e+04, 1.92547001232531532e+05, -2.03400177280415534e+05, // 36 + 1.22200464983017460e+05, -4.11926549688975513e+04, 7.10951430248936372e+03, -4.93915304773088012e+02, // 40 + 6.07404200127348304e+00, -2.42919187900551333e+05, 1.31176361466297720e+06, -2.99801591853810675e+06, // 44 + 3.76327129765640400e+06, -2.81356322658653411e+06, 1.26836527332162478e+06, -3.31645172484563578e+05, // 48 + 4.52187689813627263e+04, -2.49983048181120962e+03, 2.43805296995560639e+01, 3.28446985307203782e+06, // 52 + -1.97068191184322269e+07, 5.09526024926646422e+07, -7.41051482115326577e+07, 6.63445122747290267e+07, // 56 + -3.75671766607633513e+07, 1.32887671664218183e+07, -2.78561812808645469e+06, 3.08186404612662398e+05, // 60 + -1.38860897537170405e+04, 1.10017140269246738e+02, -4.93292536645099620e+07, 3.25573074185765749e+08, // 64 + -9.39462359681578403e+08, 1.55359689957058006e+09, -1.62108055210833708e+09, 1.10684281682301447e+09, // 68 + -4.95889784275030309e+08, 1.42062907797533095e+08, -2.44740627257387285e+07, 2.24376817792244943e+06, // 72 + -8.40054336030240853e+04, 5.51335896122020586e+02, 8.14789096118312115e+08, -5.86648149205184723e+09, // 76 + 1.86882075092958249e+10, -3.46320433881587779e+10, 4.12801855797539740e+10, -3.30265997498007231e+10, // 80 + 1.79542137311556001e+10, -6.56329379261928433e+09, 1.55927986487925751e+09, -2.25105661889415278e+08, // 84 + 1.73951075539781645e+07, -5.49842327572288687e+05, 3.03809051092238427e+03, -1.46792612476956167e+10, // 88 + 1.14498237732025810e+11, -3.99096175224466498e+11, 8.19218669548577329e+11, -1.09837515608122331e+12, // 92 + 1.00815810686538209e+12, -6.45364869245376503e+11, 2.87900649906150589e+11, -8.78670721780232657e+10, // 96 + 1.76347306068349694e+10, -2.16716498322379509e+09, 1.43157876718888981e+08, -3.87183344257261262e+06, // 100 + 1.82577554742931747e+04 // 104 + }; + + constexpr double zunhj_alfa[180] = { + -4.44444444444444444e-03, -9.22077922077922078e-04, -8.84892884892884893e-05, 1.65927687832449737e-04, // 0 + 2.46691372741792910e-04, 2.65995589346254780e-04, 2.61824297061500945e-04, 2.48730437344655609e-04, // 4 + 2.32721040083232098e-04, 2.16362485712365082e-04, 2.00738858762752355e-04, 1.86267636637545172e-04, // 8 + 1.73060775917876493e-04, 1.61091705929015752e-04, 1.50274774160908134e-04, 1.40503497391269794e-04, // 12 + 1.31668816545922806e-04, 1.23667445598253261e-04, 1.16405271474737902e-04, 1.09798298372713369e-04, // 16 + 1.03772410422992823e-04, 9.82626078369363448e-05, 9.32120517249503256e-05, 8.85710852478711718e-05, // 20 + 8.42963105715700223e-05, 8.03497548407791151e-05, 7.66981345359207388e-05, 7.33122157481777809e-05, // 24 + 7.01662625163141333e-05, 6.72375633790160292e-05, 6.93735541354588974e-04, 2.32241745182921654e-04, // 28 + -1.41986273556691197e-05, -1.16444931672048640e-04, -1.50803558053048762e-04, -1.55121924918096223e-04, // 32 + -1.46809756646465549e-04, -1.33815503867491367e-04, -1.19744975684254051e-04, -1.06184319207974020e-04, // 36 + -9.37699549891194492e-05, -8.26923045588193274e-05, -7.29374348155221211e-05, -6.44042357721016283e-05, // 40 + -5.69611566009369048e-05, -5.04731044303561628e-05, -4.48134868008882786e-05, -3.98688727717598864e-05, // 44 + -3.55400532972042498e-05, -3.17414256609022480e-05, -2.83996793904174811e-05, -2.54522720634870566e-05, // 48 + -2.28459297164724555e-05, -2.05352753106480604e-05, -1.84816217627666085e-05, -1.66519330021393806e-05, // 52 + -1.50179412980119482e-05, -1.35554031379040526e-05, -1.22434746473858131e-05, -1.10641884811308169e-05, // 56 + -3.54211971457743841e-04, -1.56161263945159416e-04, 3.04465503594936410e-05, 1.30198655773242693e-04, // 60 + 1.67471106699712269e-04, 1.70222587683592569e-04, 1.56501427608594704e-04, 1.36339170977445120e-04, // 64 + 1.14886692029825128e-04, 9.45869093034688111e-05, 7.64498419250898258e-05, 6.07570334965197354e-05, // 68 + 4.74394299290508799e-05, 3.62757512005344297e-05, 2.69939714979224901e-05, 1.93210938247939253e-05, // 72 + 1.30056674793963203e-05, 7.82620866744496661e-06, 3.59257485819351583e-06, 1.44040049814251817e-07, // 76 + -2.65396769697939116e-06, -4.91346867098485910e-06, -6.72739296091248287e-06, -8.17269379678657923e-06, // 80 + -9.31304715093561232e-06, -1.02011418798016441e-05, -1.08805962510592880e-05, -1.13875481509603555e-05, // 84 + -1.17519675674556414e-05, -1.19987364870944141e-05, 3.78194199201772914e-04, 2.02471952761816167e-04, // 88 + -6.37938506318862408e-05, -2.38598230603005903e-04, -3.10916256027361568e-04, -3.13680115247576316e-04, // 92 + -2.78950273791323387e-04, -2.28564082619141374e-04, -1.75245280340846749e-04, -1.25544063060690348e-04, // 96 + -8.22982872820208365e-05, -4.62860730588116458e-05, -1.72334302366962267e-05, 5.60690482304602267e-06, // 100 + 2.31395443148286800e-05, 3.62642745856793957e-05, 4.58006124490188752e-05, 5.24595294959114050e-05, // 104 + 5.68396208545815266e-05, 5.94349820393104052e-05, 6.06478527578421742e-05, 6.08023907788436497e-05, // 108 + 6.01577894539460388e-05, 5.89199657344698500e-05, 5.72515823777593053e-05, 5.52804375585852577e-05, // 112 + 5.31063773802880170e-05, 5.08069302012325706e-05, 4.84418647620094842e-05, 4.60568581607475370e-05, // 116 + -6.91141397288294174e-04, -4.29976633058871912e-04, 1.83067735980039018e-04, 6.60088147542014144e-04, // 120 + 8.75964969951185931e-04, 8.77335235958235514e-04, 7.49369585378990637e-04, 5.63832329756980918e-04, // 124 + 3.68059319971443156e-04, 1.88464535514455599e-04, 3.70663057664904149e-05, -8.28520220232137023e-05, // 128 + -1.72751952869172998e-04, -2.36314873605872983e-04, -2.77966150694906658e-04, -3.02079514155456919e-04, // 132 + -3.12594712643820127e-04, -3.12872558758067163e-04, -3.05678038466324377e-04, -2.93226470614557331e-04, // 136 + -2.77255655582934777e-04, -2.59103928467031709e-04, -2.39784014396480342e-04, -2.20048260045422848e-04, // 140 + -2.00443911094971498e-04, -1.81358692210970687e-04, -1.63057674478657464e-04, -1.45712672175205844e-04, // 144 + -1.29425421983924587e-04, -1.14245691942445952e-04, 1.92821964248775885e-03, 1.35592576302022234e-03, // 148 + -7.17858090421302995e-04, -2.58084802575270346e-03, -3.49271130826168475e-03, -3.46986299340960628e-03, // 152 + -2.82285233351310182e-03, -1.88103076404891354e-03, -8.89531718383947600e-04, 3.87912102631035228e-06, // 156 + 7.28688540119691412e-04, 1.26566373053457758e-03, 1.62518158372674427e-03, 1.83203153216373172e-03, // 160 + 1.91588388990527909e-03, 1.90588846755546138e-03, 1.82798982421825727e-03, 1.70389506421121530e-03, // 164 + 1.55097127171097686e-03, 1.38261421852276159e-03, 1.20881424230064774e-03, 1.03676532638344962e-03, // 168 + 8.71437918068619115e-04, 7.16080155297701002e-04, 5.72637002558129372e-04, 4.42089819465802277e-04, // 172 + 3.24724948503090564e-04, 2.20342042730246599e-04, 1.28412898401353882e-04, 4.82005924552095464e-05 // 176 + }; + + constexpr double zunhj_beta[210] = { + 1.79988721413553309e-02, 5.59964911064388073e-03, 2.88501402231132779e-03, 1.80096606761053941e-03, // 0 + 1.24753110589199202e-03, 9.22878876572938311e-04, 7.14430421727287357e-04, 5.71787281789704872e-04, // 4 + 4.69431007606481533e-04, 3.93232835462916638e-04, 3.34818889318297664e-04, 2.88952148495751517e-04, // 8 + 2.52211615549573284e-04, 2.22280580798883327e-04, 1.97541838033062524e-04, 1.76836855019718004e-04, // 12 + 1.59316899661821081e-04, 1.44347930197333986e-04, 1.31448068119965379e-04, 1.20245444949302884e-04, // 16 + 1.10449144504599392e-04, 1.01828770740567258e-04, 9.41998224204237509e-05, 8.74130545753834437e-05, // 20 + 8.13466262162801467e-05, 7.59002269646219339e-05, 7.09906300634153481e-05, 6.65482874842468183e-05, // 24 + 6.25146958969275078e-05, 5.88403394426251749e-05, -1.49282953213429172e-03, -8.78204709546389328e-04, // 28 + -5.02916549572034614e-04, -2.94822138512746025e-04, -1.75463996970782828e-04, -1.04008550460816434e-04, // 32 + -5.96141953046457895e-05, -3.12038929076098340e-05, -1.26089735980230047e-05, -2.42892608575730389e-07, // 36 + 8.05996165414273571e-06, 1.36507009262147391e-05, 1.73964125472926261e-05, 1.98672978842133780e-05, // 40 + 2.14463263790822639e-05, 2.23954659232456514e-05, 2.28967783814712629e-05, 2.30785389811177817e-05, // 44 + 2.30321976080909144e-05, 2.28236073720348722e-05, 2.25005881105292418e-05, 2.20981015361991429e-05, // 48 + 2.16418427448103905e-05, 2.11507649256220843e-05, 2.06388749782170737e-05, 2.01165241997081666e-05, // 52 + 1.95913450141179244e-05, 1.90689367910436740e-05, 1.85533719641636667e-05, 1.80475722259674218e-05, // 56 + 5.52213076721292790e-04, 4.47932581552384646e-04, 2.79520653992020589e-04, 1.52468156198446602e-04, // 60 + 6.93271105657043598e-05, 1.76258683069991397e-05, -1.35744996343269136e-05, -3.17972413350427135e-05, // 64 + -4.18861861696693365e-05, -4.69004889379141029e-05, -4.87665447413787352e-05, -4.87010031186735069e-05, // 68 + -4.74755620890086638e-05, -4.55813058138628452e-05, -4.33309644511266036e-05, -4.09230193157750364e-05, // 72 + -3.84822638603221274e-05, -3.60857167535410501e-05, -3.37793306123367417e-05, -3.15888560772109621e-05, // 76 + -2.95269561750807315e-05, -2.75978914828335759e-05, -2.58006174666883713e-05, -2.41308356761280200e-05, // 80 + -2.25823509518346033e-05, -2.11479656768912971e-05, -1.98200638885294927e-05, -1.85909870801065077e-05, // 84 + -1.74532699844210224e-05, -1.63997823854497997e-05, -4.74617796559959808e-04, -4.77864567147321487e-04, // 88 + -3.20390228067037603e-04, -1.61105016119962282e-04, -4.25778101285435204e-05, 3.44571294294967503e-05, // 92 + 7.97092684075674924e-05, 1.03138236708272200e-04, 1.12466775262204158e-04, 1.13103642108481389e-04, // 96 + 1.08651634848774268e-04, 1.01437951597661973e-04, 9.29298396593363896e-05, 8.40293133016089978e-05, // 100 + 7.52727991349134062e-05, 6.69632521975730872e-05, 5.92564547323194704e-05, 5.22169308826975567e-05, // 104 + 4.58539485165360646e-05, 4.01445513891486808e-05, 3.50481730031328081e-05, 3.05157995034346659e-05, // 108 + 2.64956119950516039e-05, 2.29363633690998152e-05, 1.97893056664021636e-05, 1.70091984636412623e-05, // 112 + 1.45547428261524004e-05, 1.23886640995878413e-05, 1.04775876076583236e-05, 8.79179954978479373e-06, // 116 + 7.36465810572578444e-04, 8.72790805146193976e-04, 6.22614862573135066e-04, 2.85998154194304147e-04, // 120 + 3.84737672879366102e-06, -1.87906003636971558e-04, -2.97603646594554535e-04, -3.45998126832656348e-04, // 124 + -3.53382470916037712e-04, -3.35715635775048757e-04, -3.04321124789039809e-04, -2.66722723047612821e-04, // 128 + -2.27654214122819527e-04, -1.89922611854562356e-04, -1.55058918599093870e-04, -1.23778240761873630e-04, // 132 + -9.62926147717644187e-05, -7.25178327714425337e-05, -5.22070028895633801e-05, -3.50347750511900522e-05, // 136 + -2.06489761035551757e-05, -8.70106096849767054e-06, 1.13698686675100290e-06, 9.16426474122778849e-06, // 140 + 1.56477785428872620e-05, 2.08223629482466847e-05, 2.48923381004595156e-05, 2.80340509574146325e-05, // 144 + 3.03987774629861915e-05, 3.21156731406700616e-05, -1.80182191963885708e-03, -2.43402962938042533e-03, // 148 + -1.83422663549856802e-03, -7.62204596354009765e-04, 2.39079475256927218e-04, 9.49266117176881141e-04, // 152 + 1.34467449701540359e-03, 1.48457495259449178e-03, 1.44732339830617591e-03, 1.30268261285657186e-03, // 156 + 1.10351597375642682e-03, 8.86047440419791759e-04, 6.73073208165665473e-04, 4.77603872856582378e-04, // 160 + 3.05991926358789362e-04, 1.60315694594721630e-04, 4.00749555270613286e-05, -5.66607461635251611e-05, // 164 + -1.32506186772982638e-04, -1.90296187989614057e-04, -2.32811450376937408e-04, -2.62628811464668841e-04, // 168 + -2.82050469867598672e-04, -2.93081563192861167e-04, -2.97435962176316616e-04, -2.96557334239348078e-04, // 172 + -2.91647363312090861e-04, -2.83696203837734166e-04, -2.73512317095673346e-04, -2.61750155806768580e-04, // 176 + 6.38585891212050914e-03, 9.62374215806377941e-03, 7.61878061207001043e-03, 2.83219055545628054e-03, // 180 + -2.09841352012720090e-03, -5.73826764216626498e-03, -7.70804244495414620e-03, -8.21011692264844401e-03, // 184 + -7.65824520346905413e-03, -6.47209729391045177e-03, -4.99132412004966473e-03, -3.45612289713133280e-03, // 188 + -2.01785580014170775e-03, -7.59430686781961401e-04, 2.84173631523859138e-04, 1.10891667586337403e-03, // 192 + 1.72901493872728771e-03, 2.16812590802684701e-03, 2.45357710494539735e-03, 2.61281821058334862e-03, // 196 + 2.67141039656276912e-03, 2.65203073395980430e-03, 2.57411652877287315e-03, 2.45389126236094427e-03, // 200 + 2.30460058071795494e-03, 2.13684837686712662e-03, 1.95896528478870911e-03, 1.77737008679454412e-03, // 204 + 1.59690280765839059e-03, 1.42111975664438546e-03 // 208 + }; + + constexpr double zunhj_gama[30] = { + 6.29960524947436582e-01, 2.51984209978974633e-01, 1.54790300415655846e-01, 1.10713062416159013e-01, // 0 + 8.57309395527394825e-02, 6.97161316958684292e-02, 5.86085671893713576e-02, 5.04698873536310685e-02, // 4 + 4.42600580689154809e-02, 3.93720661543509966e-02, 3.54283195924455368e-02, 3.21818857502098231e-02, // 8 + 2.94646240791157679e-02, 2.71581677112934479e-02, 2.51768272973861779e-02, 2.34570755306078891e-02, // 12 + 2.19508390134907203e-02, 2.06210828235646240e-02, 1.94388240897880846e-02, 1.83810633800683158e-02, // 16 + 1.74293213231963172e-02, 1.65685837786612353e-02, 1.57865285987918445e-02, 1.50729501494095594e-02, // 20 + 1.44193250839954639e-02, 1.38184805735341786e-02, 1.32643378994276568e-02, 1.27517121970498651e-02, // 24 + 1.22761545318762767e-02, 1.18338262398482403e-02 // 28 + }; + + constexpr double zunik_c[120] = { + 1.00000000000000000e+00, -2.08333333333333333e-01, 1.25000000000000000e-01, 3.34201388888888889e-01, // 0 + -4.01041666666666667e-01, 7.03125000000000000e-02, -1.02581259645061728e+00, 1.84646267361111111e+00, // 4 + -8.91210937500000000e-01, 7.32421875000000000e-02, 4.66958442342624743e+00, -1.12070026162229938e+01, // 8 + 8.78912353515625000e+00, -2.36408691406250000e+00, 1.12152099609375000e-01, -2.82120725582002449e+01, // 12 + 8.46362176746007346e+01, -9.18182415432400174e+01, 4.25349987453884549e+01, -7.36879435947963170e+00, // 16 + 2.27108001708984375e-01, 2.12570130039217123e+02, -7.65252468141181642e+02, 1.05999045252799988e+03, // 20 + -6.99579627376132541e+02, 2.18190511744211590e+02, -2.64914304869515555e+01, 5.72501420974731445e-01, // 24 + -1.91945766231840700e+03, 8.06172218173730938e+03, -1.35865500064341374e+04, 1.16553933368645332e+04, // 28 + -5.30564697861340311e+03, 1.20090291321635246e+03, -1.08090919788394656e+02, 1.72772750258445740e+00, // 32 + 2.02042913309661486e+04, -9.69805983886375135e+04, 1.92547001232531532e+05, -2.03400177280415534e+05, // 36 + 1.22200464983017460e+05, -4.11926549688975513e+04, 7.10951430248936372e+03, -4.93915304773088012e+02, // 40 + 6.07404200127348304e+00, -2.42919187900551333e+05, 1.31176361466297720e+06, -2.99801591853810675e+06, // 44 + 3.76327129765640400e+06, -2.81356322658653411e+06, 1.26836527332162478e+06, -3.31645172484563578e+05, // 48 + 4.52187689813627263e+04, -2.49983048181120962e+03, 2.43805296995560639e+01, 3.28446985307203782e+06, // 52 + -1.97068191184322269e+07, 5.09526024926646422e+07, -7.41051482115326577e+07, 6.63445122747290267e+07, // 56 + -3.75671766607633513e+07, 1.32887671664218183e+07, -2.78561812808645469e+06, 3.08186404612662398e+05, // 60 + -1.38860897537170405e+04, 1.10017140269246738e+02, -4.93292536645099620e+07, 3.25573074185765749e+08, // 64 + -9.39462359681578403e+08, 1.55359689957058006e+09, -1.62108055210833708e+09, 1.10684281682301447e+09, // 68 + -4.95889784275030309e+08, 1.42062907797533095e+08, -2.44740627257387285e+07, 2.24376817792244943e+06, // 72 + -8.40054336030240853e+04, 5.51335896122020586e+02, 8.14789096118312115e+08, -5.86648149205184723e+09, // 76 + 1.86882075092958249e+10, -3.46320433881587779e+10, 4.12801855797539740e+10, -3.30265997498007231e+10, // 80 + 1.79542137311556001e+10, -6.56329379261928433e+09, 1.55927986487925751e+09, -2.25105661889415278e+08, // 84 + 1.73951075539781645e+07, -5.49842327572288687e+05, 3.03809051092238427e+03, -1.46792612476956167e+10, // 88 + 1.14498237732025810e+11, -3.99096175224466498e+11, 8.19218669548577329e+11, -1.09837515608122331e+12, // 92 + 1.00815810686538209e+12, -6.45364869245376503e+11, 2.87900649906150589e+11, -8.78670721780232657e+10, // 96 + 1.76347306068349694e+10, -2.16716498322379509e+09, 1.43157876718888981e+08, -3.87183344257261262e+06, // 100 + 1.82577554742931747e+04, 2.86464035717679043e+11, -2.40629790002850396e+12, 9.10934118523989896e+12, // 104 + -2.05168994109344374e+13, 3.05651255199353206e+13, -3.16670885847851584e+13, 2.33483640445818409e+13, // 108 + -1.23204913055982872e+13, 4.61272578084913197e+12, -1.19655288019618160e+12, 2.05914503232410016e+11, // 112 + -2.18229277575292237e+10, 1.24700929351271032e+09, -2.91883881222208134e+07, 1.18838426256783253e+05 // 116 + }; + + constexpr double dgamln_gln[100] = { + 0.00000000000000000e+00, 0.00000000000000000e+00, 6.93147180559945309e-01, 1.79175946922805500e+00, // 0 + 3.17805383034794562e+00, 4.78749174278204599e+00, 6.57925121201010100e+00, 8.52516136106541430e+00, // 4 + 1.06046029027452502e+01, 1.28018274800814696e+01, 1.51044125730755153e+01, 1.75023078458738858e+01, // 8 + 1.99872144956618861e+01, 2.25521638531234229e+01, 2.51912211827386815e+01, 2.78992713838408916e+01, // 12 + 3.06718601060806728e+01, 3.35050734501368889e+01, 3.63954452080330536e+01, 3.93398841871994940e+01, // 16 + 4.23356164607534850e+01, 4.53801388984769080e+01, 4.84711813518352239e+01, 5.16066755677643736e+01, // 20 + 5.47847293981123192e+01, 5.80036052229805199e+01, 6.12617017610020020e+01, 6.45575386270063311e+01, // 24 + 6.78897431371815350e+01, 7.12570389671680090e+01, 7.46582363488301644e+01, 7.80922235533153106e+01, // 28 + 8.15579594561150372e+01, 8.50544670175815174e+01, 8.85808275421976788e+01, 9.21361756036870925e+01, // 32 + 9.57196945421432025e+01, 9.93306124547874269e+01, 1.02968198614513813e+02, 1.06631760260643459e+02, // 36 + 1.10320639714757395e+02, 1.14034211781461703e+02, 1.17771881399745072e+02, 1.21533081515438634e+02, // 40 + 1.25317271149356895e+02, 1.29123933639127215e+02, 1.32952575035616310e+02, 1.36802722637326368e+02, // 44 + 1.40673923648234259e+02, 1.44565743946344886e+02, 1.48477766951773032e+02, 1.52409592584497358e+02, // 48 + 1.56360836303078785e+02, 1.60331128216630907e+02, 1.64320112263195181e+02, 1.68327445448427652e+02, // 52 + 1.72352797139162802e+02, 1.76395848406997352e+02, 1.80456291417543771e+02, 1.84533828861449491e+02, // 56 + 1.88628173423671591e+02, 1.92739047287844902e+02, 1.96866181672889994e+02, 2.01009316399281527e+02, // 60 + 2.05168199482641199e+02, 2.09342586752536836e+02, 2.13532241494563261e+02, 2.17736934113954227e+02, // 64 + 2.21956441819130334e+02, 2.26190548323727593e+02, 2.30439043565776952e+02, 2.34701723442818268e+02, // 68 + 2.38978389561834323e+02, 2.43268849002982714e+02, 2.47572914096186884e+02, 2.51890402209723194e+02, // 72 + 2.56221135550009525e+02, 2.60564940971863209e+02, 2.64921649798552801e+02, 2.69291097651019823e+02, // 76 + 2.73673124285693704e+02, 2.78067573440366143e+02, 2.82474292687630396e+02, 2.86893133295426994e+02, // 80 + 2.91323950094270308e+02, 2.95766601350760624e+02, 3.00220948647014132e+02, 3.04686856765668715e+02, // 84 + 3.09164193580146922e+02, 3.13652829949879062e+02, 3.18152639620209327e+02, 3.22663499126726177e+02, // 88 + 3.27185287703775217e+02, 3.31717887196928473e+02, 3.36261181979198477e+02, 3.40815058870799018e+02, // 92 + 3.45379407062266854e+02, 3.49954118040770237e+02, 3.54539085519440809e+02, 3.59134205369575399e+02 // 96 + }; + + constexpr double dgamln_cf[22] = { + 8.33333333333333333e-02, -2.77777777777777778e-03, 7.93650793650793651e-04, -5.95238095238095238e-04, // 0 + 8.41750841750841751e-04, -1.91752691752691753e-03, 6.41025641025641026e-03, -2.95506535947712418e-02, // 4 + 1.79644372368830573e-01, -1.39243221690590112e+00, 1.34028640441683920e+01, -1.56848284626002017e+02, // 8 + 2.19310333333333333e+03, -3.61087712537249894e+04, 6.91472268851313067e+05, -1.52382215394074162e+07, // 12 + 3.82900751391414141e+08, -1.08822660357843911e+10, 3.47320283765002252e+11, -1.23696021422692745e+13, // 16 + 4.88788064793079335e+14, -2.13203339609193739e+16 // 20 + }; + + inline int acai( + std::complex z, double fnu, int kode, int mr, int n, std::complex *y, double rl, double tol, + double elim, double alim + ) { + + //***BEGIN PROLOGUE ZACAI + //***REFER TO ZAIRY + // + // ZACAI APPLIES THE ANALYTIC CONTINUATION FORMULA + // + // K(FNU,ZN*EXP(MP))=K(FNU,ZN)*EXP(-MP*FNU) - MP*I(FNU,ZN) + // MP=PI*MR*std::complex(0.0,1.0) + // + // TO CONTINUE THE K FUNCTION FROM THE RIGHT HALF TO THE LEFT + // HALF Z PLANE FOR USE WITH ZAIRY WHERE FNU=1/3 OR 2/3 AND N=1. + // ZACAI IS THE SAME AS ZACON WITH THE PARTS FOR LARGER ORDERS AND + // RECURRENCE REMOVED. A RECURSIVE CALL TO ZACON CAN RESULT IF ZACON + // IS CALLED FROM ZAIRY. + // + //***ROUTINES CALLED ZASYI,ZBKNU,ZMLRI,ZSERI,ZS1S2,D1MACH,AZABS + //***END PROLOGUE ZACAI + + std::complex csgn, cspn, c1, c2, zn, cy[2]; + double arg, ascle, az, cpn, dfnu, fmr, sgn, spn, yy; + int inu, iuf, nn, nw; + double pi = 3.14159265358979324; + int nz = 0; + zn = -z; + az = std::abs(z); + nn = n; + dfnu = fnu + (n - 1); + if ((az > 2.0) && (az * az * 0.25 > dfnu + 1.0)) { + /* 20 */ + if (az >= rl) { + // + // ASYMPTOTIC EXPANSION FOR LARGE Z FOR THE I FUNCTION + // + nw = asyi(zn, fnu, kode, nn, y, rl, tol, elim, alim); + } else { + // + // MILLER ALGORITHM NORMALIZED BY THE SERIES FOR THE I FUNCTION + // + nw = mlri(zn, fnu, kode, nn, y, tol); + } + if (nw < 0) { + nz = -1; + if (nw == -2) { + nz = -2; + } + return nz; + } } else { // - // MILLER ALGORITHM NORMALIZED BY THE SERIES FOR THE I FUNCTION + // POWER SERIES FOR THE I FUNCTION // - nw = mlri(zn, fnu, kode, nn, y, tol); + seri(zn, fnu, kode, nn, y, tol, elim, alim); } - if (nw < 0) { + /* 40 */ + // + // ANALYTIC CONTINUATION TO THE LEFT HALF PLANE FOR THE K FUNCTION + // + nw = bknu(zn, fnu, kode, 1, &cy[0], tol, elim, alim); + if (nw != 0) { nz = -1; - if (nw == -2) { nz = -2; } + if (nw == -2) { + nz = -2; + } return nz; } - } else{ + fmr = mr; + sgn = (fmr < 0.0 ? pi : -pi); + csgn = std::complex(0.0, sgn); + if (kode != 1) { + yy = -std::imag(zn); + cpn = cos(yy); + spn = sin(yy); + csgn *= std::complex(cpn, spn); + } // - // POWER SERIES FOR THE I FUNCTION + // CALCULATE CSPN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE + // WHEN FNU IS LARGE // - seri(zn, fnu, kode, nn, y, tol, elim, alim); - } - /* 40 */ - // - // ANALYTIC CONTINUATION TO THE LEFT HALF PLANE FOR THE K FUNCTION - // - nw = bknu(zn, fnu, kode, 1, &cy[0], tol, elim, alim); - if (nw != 0) { - nz = -1; - if (nw == -2) { nz = -2; } + inu = (int)fnu; + arg = (fnu - inu) * sgn; + cpn = cos(arg); + spn = sin(arg); + cspn = std::complex(cpn, spn); + if (inu % 2 == 1) { + cspn = -cspn; + } + c1 = cy[0]; + c2 = y[0]; + if (kode != 1) { + iuf = 0; + ascle = 1e3 * d1mach[0] / tol; + nw = s1s2(zn, &c1, &c2, ascle, alim, &iuf); + nz += nw; + } + y[0] = cspn * c1 + csgn * c2; return nz; } - fmr = mr; - sgn = (fmr < 0.0 ? pi : -pi); - csgn = std::complex(0.0, sgn); - if (kode != 1) { - yy = -std::imag(zn); - cpn = cos(yy); - spn = sin(yy); - csgn *= std::complex(cpn, spn); - } - // - // CALCULATE CSPN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE - // WHEN FNU IS LARGE - // - inu = (int)fnu; - arg = (fnu - inu)*sgn; - cpn = cos(arg); - spn = sin(arg); - cspn = std::complex(cpn, spn); - if (inu % 2 == 1) { cspn = -cspn; } - c1 = cy[0]; - c2 = y[0]; - if (kode != 1) { - iuf = 0; - ascle = 1e3 * d1mach[0] / tol; - nw = s1s2(zn, &c1, &c2, ascle, alim, &iuf); - nz += nw; - } - y[0] = cspn*c1 + csgn*c2; - return nz; -} - - -inline int acon( - std::complex z, - double fnu, - int kode, - int mr, - int n, - std::complex *y, - double rl, - double fnul, - double tol, - double elim, - double alim -) { - - //***BEGIN PROLOGUE ZACON - //***REFER TO ZBESK,ZBESH - // - // ZACON APPLIES THE ANALYTIC CONTINUATION FORMULA - // - // K(FNU,ZN*EXP(MP))=K(FNU,ZN)*EXP(-MP*FNU) - MP*I(FNU,ZN) - // MP=PI*MR*std::complex(0.0,1.0) - // - // TO CONTINUE THE K FUNCTION FROM THE RIGHT HALF TO THE LEFT - // HALF Z PLANE - // - //***ROUTINES CALLED ZBINU,ZBKNU,ZS1S2,D1MACH,AZABS,ZMLT - //***END PROLOGUE ZACON - - std::complex ck, cs, cscl, cscr, csgn, cspn, c1, c2, rz, sc1, sc2 = 0.0,\ - st, s1, s2, zn; - double arg, ascle, as2, bscle, c1i, c1m, c1r, fmr, sgn, yy; - int i, inu, iuf, kflag, nn, nw, nz; - double pi = 3.14159265358979324; - std::complex cy[2] = { 0.0 }; - std::complex css[3] = { 0.0 }; - std::complex csr[3] = { 0.0 }; - double bry[3] = { 0.0 }; - - nz = 0; - zn = -z; - nn = n; - nw = binu(zn, fnu, kode, nn, y, rl, fnul, tol, elim, alim); - if (nw >= 0) { + + inline int acon( + std::complex z, double fnu, int kode, int mr, int n, std::complex *y, double rl, double fnul, + double tol, double elim, double alim + ) { + + //***BEGIN PROLOGUE ZACON + //***REFER TO ZBESK,ZBESH // - // ANALYTIC CONTINUATION TO THE LEFT HALF PLANE FOR THE K FUNCTION + // ZACON APPLIES THE ANALYTIC CONTINUATION FORMULA // - nn = (n > 2 ? 2 : n); - nw = bknu(zn, fnu, kode, nn, cy, tol, elim, alim); - if (nw == 0) { - s1 = cy[0]; - fmr = mr; - sgn = ( fmr < 0 ? pi : -pi ); - csgn = std::complex(0.0, sgn); - if (kode != 1) { - yy = -std::imag(zn); - csgn *= std::complex(cos(yy), sin(yy)); - } - inu = (int)fnu; - arg = (fnu - inu)*sgn; - cspn = std::complex(cos(arg), sin(arg)); - if (inu % 2 == 1) { cspn = -cspn; } - iuf = 0; - c1 = s1; - c2 = y[0]; - ascle = 1e3*d1mach[0]/tol; - if (kode != 1) { - nw = s1s2(zn, &c1, &c2, ascle, alim, &iuf); - nz += nw; - sc1 = c1; - } - y[0] = cspn*c1 + csgn*c2; - if (n == 1) { return nz; } - cspn = -cspn; - s2 = cy[1]; - c1 = s2; - c2 = y[1]; - if (kode != 1) { - nw = s1s2(zn, &c1, &c2, ascle, alim, &iuf); - nz += nw; - sc2 = c1; - } - y[1] = cspn*c1 + csgn*c2; - if (n == 2) { return nz; } - cspn = -cspn; - rz = 2.0 / zn; - ck = (fnu + 1.0)*rz; + // K(FNU,ZN*EXP(MP))=K(FNU,ZN)*EXP(-MP*FNU) - MP*I(FNU,ZN) + // MP=PI*MR*std::complex(0.0,1.0) + // + // TO CONTINUE THE K FUNCTION FROM THE RIGHT HALF TO THE LEFT + // HALF Z PLANE + // + //***ROUTINES CALLED ZBINU,ZBKNU,ZS1S2,D1MACH,AZABS,ZMLT + //***END PROLOGUE ZACON + + std::complex ck, cs, cscl, cscr, csgn, cspn, c1, c2, rz, sc1, sc2 = 0.0, st, s1, s2, zn; + double arg, ascle, as2, bscle, c1i, c1m, c1r, fmr, sgn, yy; + int i, inu, iuf, kflag, nn, nw, nz; + double pi = 3.14159265358979324; + std::complex cy[2] = {0.0}; + std::complex css[3] = {0.0}; + std::complex csr[3] = {0.0}; + double bry[3] = {0.0}; + + nz = 0; + zn = -z; + nn = n; + nw = binu(zn, fnu, kode, nn, y, rl, fnul, tol, elim, alim); + if (nw >= 0) { // - // SCALE NEAR EXPONENT EXTREMES DURING RECURRENCE ON K FUNCTIONS + // ANALYTIC CONTINUATION TO THE LEFT HALF PLANE FOR THE K FUNCTION // - cscl = 1.0 / tol; - cscr = tol; - css[0] = cscl; - css[1] = 1.0; - css[2] = cscr; - csr[0] = cscr; - csr[1] = 1.0; - csr[2] = cscl; - bry[0] = ascle; - bry[1] = 1.0 / ascle; - bry[2] = d1mach[1]; - as2 = std::abs(s2); - kflag = 2; - if (as2 <= bry[0] ) { - kflag = 1; - } else { - if (as2 >= bry[1]) { - kflag = 3; + nn = (n > 2 ? 2 : n); + nw = bknu(zn, fnu, kode, nn, cy, tol, elim, alim); + if (nw == 0) { + s1 = cy[0]; + fmr = mr; + sgn = (fmr < 0 ? pi : -pi); + csgn = std::complex(0.0, sgn); + if (kode != 1) { + yy = -std::imag(zn); + csgn *= std::complex(cos(yy), sin(yy)); } - } - bscle = bry[kflag-1]; - s1 *= css[kflag-1]; - s2 *= css[kflag-1]; - cs = csr[kflag-1]; - for (i = 3; i < (n+1); i++) - { - st = s2; - s2 = ck*s2 + s1; - s1 = st; - c1 = s2*cs; - st = c1; - c2 = y[i-1]; + inu = (int)fnu; + arg = (fnu - inu) * sgn; + cspn = std::complex(cos(arg), sin(arg)); + if (inu % 2 == 1) { + cspn = -cspn; + } + iuf = 0; + c1 = s1; + c2 = y[0]; + ascle = 1e3 * d1mach[0] / tol; if (kode != 1) { - if (iuf >= 0) { - nw = s1s2(zn, &c1, &c2, ascle, alim, &iuf); - nz += nw; - sc1 = sc2; - sc2 = c1; - if (iuf == 3){ - iuf = -4; - s1 = sc1 * css[kflag-1]; - s2 = sc2 * css[kflag-1]; - st = sc2; - } - } + nw = s1s2(zn, &c1, &c2, ascle, alim, &iuf); + nz += nw; + sc1 = c1; + } + y[0] = cspn * c1 + csgn * c2; + if (n == 1) { + return nz; } - y[i-1] = cspn*c1 + csgn*c2; - ck += rz; cspn = -cspn; - if (kflag < 3) { - c1r = fabs(std::real(c1)); - c1i = fabs(std::imag(c1)); - c1m = fmax(c1r, c1i); - if (c1m > bscle) { - kflag += 1; - bscle = bry[kflag-1]; - s1 *= cs; - s2 = st; - s1 *= css[kflag-1]; - s2 *= css[kflag-1]; - cs = csr[kflag-1]; + s2 = cy[1]; + c1 = s2; + c2 = y[1]; + if (kode != 1) { + nw = s1s2(zn, &c1, &c2, ascle, alim, &iuf); + nz += nw; + sc2 = c1; + } + y[1] = cspn * c1 + csgn * c2; + if (n == 2) { + return nz; + } + cspn = -cspn; + rz = 2.0 / zn; + ck = (fnu + 1.0) * rz; + // + // SCALE NEAR EXPONENT EXTREMES DURING RECURRENCE ON K FUNCTIONS + // + cscl = 1.0 / tol; + cscr = tol; + css[0] = cscl; + css[1] = 1.0; + css[2] = cscr; + csr[0] = cscr; + csr[1] = 1.0; + csr[2] = cscl; + bry[0] = ascle; + bry[1] = 1.0 / ascle; + bry[2] = d1mach[1]; + as2 = std::abs(s2); + kflag = 2; + if (as2 <= bry[0]) { + kflag = 1; + } else { + if (as2 >= bry[1]) { + kflag = 3; } } + bscle = bry[kflag - 1]; + s1 *= css[kflag - 1]; + s2 *= css[kflag - 1]; + cs = csr[kflag - 1]; + for (i = 3; i < (n + 1); i++) { + st = s2; + s2 = ck * s2 + s1; + s1 = st; + c1 = s2 * cs; + st = c1; + c2 = y[i - 1]; + if (kode != 1) { + if (iuf >= 0) { + nw = s1s2(zn, &c1, &c2, ascle, alim, &iuf); + nz += nw; + sc1 = sc2; + sc2 = c1; + if (iuf == 3) { + iuf = -4; + s1 = sc1 * css[kflag - 1]; + s2 = sc2 * css[kflag - 1]; + st = sc2; + } + } + } + y[i - 1] = cspn * c1 + csgn * c2; + ck += rz; + cspn = -cspn; + if (kflag < 3) { + c1r = fabs(std::real(c1)); + c1i = fabs(std::imag(c1)); + c1m = fmax(c1r, c1i); + if (c1m > bscle) { + kflag += 1; + bscle = bry[kflag - 1]; + s1 *= cs; + s2 = st; + s1 *= css[kflag - 1]; + s2 *= css[kflag - 1]; + cs = csr[kflag - 1]; + } + } + } + return nz; } - return nz; } - } - nz = -1; - if (nw == -2) { nz = -2; } - return nz; -} - - -inline std::complex airy( - std::complex z, - int id, - int kode, - int *nz, - int *ierr -) { - - //***BEGIN PROLOGUE ZAIRY - //***DATE WRITTEN 830501 (YYMMDD) - //***REVISION DATE 890801 (YYMMDD) - //***CATEGORY NO. B5K - //***KEYWORDS AIRY FUNCTION,BESSEL FUNCTIONS OF ORDER ONE THIRD - //***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES - //***PURPOSE TO COMPUTE AIRY FUNCTIONS AI(Z) AND DAI(Z) FOR COMPLEX Z - //***DESCRIPTION - // - // ***A DOUBLE PRECISION ROUTINE*** - // ON KODE=1, ZAIRY COMPUTES THE COMPLEX AIRY FUNCTION AI(Z) OR - // ITS DERIVATIVE DAI(Z)/DZ ON ID=0 OR ID=1 RESPECTIVELY. ON - // KODE=2, A SCALING OPTION CEXP(ZTA)*AI(Z) OR CEXP(ZTA)* - // DAI(Z)/DZ IS PROVIDED TO REMOVE THE EXPONENTIAL DECAY IN - // -PI/3.LT.ARG(Z).LT.PI/3 AND THE EXPONENTIAL GROWTH IN - // PI/3.LT.ABS(ARG(Z)).LT.PI WHERE ZTA=(2/3)*Z*CSQRT(Z). - // - // WHILE THE AIRY FUNCTIONS AI(Z) AND DAI(Z)/DZ ARE ANALYTIC IN - // THE WHOLE Z PLANE, THE CORRESPONDING SCALED FUNCTIONS DEFINED - // FOR KODE=2 HAVE A CUT ALONG THE NEGATIVE REAL AXIS. - // DEFINITIONS AND NOTATION ARE FOUND IN THE NBS HANDBOOK OF - // MATHEMATICAL FUNCTIONS (REF. 1). - // - // INPUT ZR,ZI ARE DOUBLE PRECISION - // ZR,ZI - Z=std::complex(ZR,ZI) - // ID - ORDER OF DERIVATIVE, ID=0 OR ID=1 - // KODE - A PARAMETER TO INDICATE THE SCALING OPTION - // KODE= 1 RETURNS - // AI=AI(Z) ON ID=0 OR - // AI=DAI(Z)/DZ ON ID=1 - // = 2 RETURNS - // AI=CEXP(ZTA)*AI(Z) ON ID=0 OR - // AI=CEXP(ZTA)*DAI(Z)/DZ ON ID=1 WHERE - // ZTA=(2/3)*Z*CSQRT(Z) - // - // OUTPUT AIR,AII ARE DOUBLE PRECISION - // AIR,AII- COMPLEX ANSWER DEPENDING ON THE CHOICES FOR ID AND - // KODE - // NZ - UNDERFLOW INDICATOR - // NZ= 0 , NORMAL RETURN - // NZ= 1 , AI=std::complex(0.0D0,0.0D0) DUE TO UNDERFLOW IN - // -PI/3.LT.ARG(Z).LT.PI/3 ON KODE=1 - // IERR - ERROR FLAG - // IERR=0, NORMAL RETURN - COMPUTATION COMPLETED - // IERR=1, INPUT ERROR - NO COMPUTATION - // IERR=2, OVERFLOW - NO COMPUTATION, REAL(ZTA) - // TOO LARGE ON KODE=1 - // IERR=3, CABS(Z) LARGE - COMPUTATION COMPLETED - // LOSSES OF SIGNIFCANCE BY ARGUMENT REDUCTION - // PRODUCE LESS THAN HALF OF MACHINE ACCURACY - // IERR=4, CABS(Z) TOO LARGE - NO COMPUTATION - // COMPLETE LOSS OF ACCURACY BY ARGUMENT - // REDUCTION - // IERR=5, ERROR - NO COMPUTATION, - // ALGORITHM TERMINATION CONDITION NOT MET - // - //***LONG DESCRIPTION - // - // AI AND DAI ARE COMPUTED FOR CABS(Z).GT.1.0 FROM THE K BESSEL - // FUNCTIONS BY - // - // AI(Z)=C*SQRT(Z)*K(1/3,ZTA) , DAI(Z)=-C*Z*K(2/3,ZTA) - // C=1.0/(PI*SQRT(3.0)) - // ZTA=(2/3)*Z**(3/2) - // - // WITH THE POWER SERIES FOR CABS(Z).LE.1.0. - // - // IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- - // MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z IS LARGE, LOSSES - // OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. CONSEQUENTLY, IF - // THE MAGNITUDE OF ZETA=(2/3)*Z**1.5 EXCEEDS U1=SQRT(0.5/UR), - // THEN LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR - // FLAG IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS - // DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. - // ALSO, IF THE MAGNITUDE OF ZETA IS LARGER THAN U2=0.5/UR, THEN - // ALL SIGNIFICANCE IS LOST AND IERR=4. IN ORDER TO USE THE INT - // FUNCTION, ZETA MUST BE FURTHER RESTRICTED NOT TO EXCEED THE - // LARGEST INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF ZETA - // MUST BE RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, - // AND U3 ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE - // PRECISION ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE - // PRECISION ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMIT- - // ING IN THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT THE MAG- - // NITUDE OF Z CANNOT EXCEED 3.1E+4 IN SINGLE AND 2.1E+6 IN - // DOUBLE PRECISION ARITHMETIC. THIS ALSO MEANS THAT ONE CAN - // EXPECT TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, - // NO DIGITS IN SINGLE PRECISION AND ONLY 7 DIGITS IN DOUBLE - // PRECISION ARITHMETIC. SIMILAR CONSIDERATIONS HOLD FOR OTHER - // MACHINES. - // - // THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX - // BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT - // ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- - // SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE - // ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), - // ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF - // CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY - // HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN - // ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY - // SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER - // THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, - // 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS - // THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER - // COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY - // BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER - // COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE - // MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, - // THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, - // OR -PI/2+P. - // - //***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ - // AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF - // COMMERCE, 1955. - // - // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT - // AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 - // - // A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX - // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- - // 1018, MAY, 1985 - // - // A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX - // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS. - // MATH. SOFTWARE, 1986 - // - //***ROUTINES CALLED ZACAI,ZBKNU,AZEXP,AZSQRT,I1MACH,D1MACH - //***END PROLOGUE ZAIRY - - std::complex ai, csq, cy[1], s1, s2, trm1, trm2, zta, z3; - double aa, ad, ak, alim, atrm, az, az3, bk, ck, dig, dk, d1, d2,\ - elim, fid, fnu, rl, r1m5, sfac, tol, zi, zr, bb, alaz; - int iflag, k, k1, k2, mr, nn; - double tth = 2. / 3.; - double c1 = 0.35502805388781723926; /* 1/(Gamma(2/3) * 3**(2/3)) */ - double c2 = 0.25881940379280679841; /* 1/(Gamma(1/3) * 3**(1/3)) */ - double coef = 0.18377629847393068317; /* 1 / (sqrt(3) * PI) */ - - *ierr = 0; - *nz = 0; - ai = 0.; - if ((id < 0) || (id > 1)) { *ierr = 1; } - if ((kode < 1) || (kode > 2)) { *ierr = 1; } - if (*ierr != 0) return 0.; - az = std::abs(z); - tol = d1mach[3]; - fid = id; - - if (az <= 1.0) { - // - // POWER SERIES FOR ABS(Z) <= 1. - // - s1 = 1.0; - s2 = 1.0; - if (az < tol) { - aa = 1e3*d1mach[0]; - s1 = 0.; - if (id != 1) { - if (az > aa) { s1 = c2 * z; } - ai = c1 - s1; - return ai; - } - ai = -c2; - aa = sqrt(aa); - if (az > aa) { s1 = z * z * 0.5; } - ai += s1 * c1; - return ai; - } - aa = az*az; - if (aa >= tol/az) { - trm1 = 1.0; - trm2 = 1.0; - atrm = 1.0; - z3 = z*z*z; - az3 = az * aa; - ak = 2.0 + fid; - bk = 3.0 - fid - fid; - ck = 4.0 - fid; - dk = 3.0 + fid + fid; - d1 = ak * dk; - d2 = bk * ck; - ad = (d1 > d2 ? d2 : d1); - ak = 24.0 + 9.0*fid; - bk = 30.0 - 9.0*fid; - for (int k = 1; k < 26; k++) - { - trm1 *= z3/d1; - s1 += trm1; - trm2 *= z3/d2; - s2 += trm2; - atrm *= az3 / ad; - d1 += ak; - d2 += bk; - ad = (d1 > d2 ? d2 : d1); - if (atrm < tol*ad) { break; } - ak += 18.0; - bk += 18.0; - } + nz = -1; + if (nw == -2) { + nz = -2; } - if (id != 1) { - ai = s1*c1 - z*s2*c2; - if (kode == 1) { return ai; } - zta = z*std::sqrt(z)*tth; - ai *= std::exp(zta); - return ai; - } - ai = -s2*c2; - if (az > tol) { ai += z*z*s1*c1/(1. + fid); } - if (kode == 1) { return ai; } - zta = z*std::sqrt(z)*tth; - return ai*std::exp(zta); + return nz; } - // - // CASE FOR ABS(Z) > 1.0 - // - fnu = (1.0 + fid) / 3.0; - // - // SET PARAMETERS RELATED TO MACHINE CONSTANTS. - // TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. - // ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. - // EXP(-ELIM) < EXP(-ALIM)=EXP(-ELIM)/TOL AND - // EXP(ELIM) > EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR - // UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. - // RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. - // DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). - // - k1 = i1mach[14]; - k2 = i1mach[15]; - r1m5 = d1mach[4]; - k = ( abs(k1) > abs(k2) ? abs(k2) : abs(k1) ); - elim = 2.303 * (k*r1m5 - 3.0); - k1 = i1mach[13] - 1; - aa = r1m5*k1; - dig = (aa > 18.0 ? 18.0 : aa); - aa *= 2.303; - alim = elim + (-aa > -41.45 ? -aa : -41.45); - rl = 1.2*dig + 3.0; - alaz = log(az); - // - // TEST FOR RANGE - // - aa = 0.5 / tol; - bb = i1mach[8] * 0.5; - aa = (aa > bb ? bb : aa); - aa = pow(aa, tth); - if (az > aa) { - *ierr = 4; + + inline std::complex airy(std::complex z, int id, int kode, int *nz, int *ierr) { + + //***BEGIN PROLOGUE ZAIRY + //***DATE WRITTEN 830501 (YYMMDD) + //***REVISION DATE 890801 (YYMMDD) + //***CATEGORY NO. B5K + //***KEYWORDS AIRY FUNCTION,BESSEL FUNCTIONS OF ORDER ONE THIRD + //***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES + //***PURPOSE TO COMPUTE AIRY FUNCTIONS AI(Z) AND DAI(Z) FOR COMPLEX Z + //***DESCRIPTION + // + // ***A DOUBLE PRECISION ROUTINE*** + // ON KODE=1, ZAIRY COMPUTES THE COMPLEX AIRY FUNCTION AI(Z) OR + // ITS DERIVATIVE DAI(Z)/DZ ON ID=0 OR ID=1 RESPECTIVELY. ON + // KODE=2, A SCALING OPTION CEXP(ZTA)*AI(Z) OR CEXP(ZTA)* + // DAI(Z)/DZ IS PROVIDED TO REMOVE THE EXPONENTIAL DECAY IN + // -PI/3.LT.ARG(Z).LT.PI/3 AND THE EXPONENTIAL GROWTH IN + // PI/3.LT.ABS(ARG(Z)).LT.PI WHERE ZTA=(2/3)*Z*CSQRT(Z). + // + // WHILE THE AIRY FUNCTIONS AI(Z) AND DAI(Z)/DZ ARE ANALYTIC IN + // THE WHOLE Z PLANE, THE CORRESPONDING SCALED FUNCTIONS DEFINED + // FOR KODE=2 HAVE A CUT ALONG THE NEGATIVE REAL AXIS. + // DEFINITIONS AND NOTATION ARE FOUND IN THE NBS HANDBOOK OF + // MATHEMATICAL FUNCTIONS (REF. 1). + // + // INPUT ZR,ZI ARE DOUBLE PRECISION + // ZR,ZI - Z=std::complex(ZR,ZI) + // ID - ORDER OF DERIVATIVE, ID=0 OR ID=1 + // KODE - A PARAMETER TO INDICATE THE SCALING OPTION + // KODE= 1 RETURNS + // AI=AI(Z) ON ID=0 OR + // AI=DAI(Z)/DZ ON ID=1 + // = 2 RETURNS + // AI=CEXP(ZTA)*AI(Z) ON ID=0 OR + // AI=CEXP(ZTA)*DAI(Z)/DZ ON ID=1 WHERE + // ZTA=(2/3)*Z*CSQRT(Z) + // + // OUTPUT AIR,AII ARE DOUBLE PRECISION + // AIR,AII- COMPLEX ANSWER DEPENDING ON THE CHOICES FOR ID AND + // KODE + // NZ - UNDERFLOW INDICATOR + // NZ= 0 , NORMAL RETURN + // NZ= 1 , AI=std::complex(0.0D0,0.0D0) DUE TO UNDERFLOW IN + // -PI/3.LT.ARG(Z).LT.PI/3 ON KODE=1 + // IERR - ERROR FLAG + // IERR=0, NORMAL RETURN - COMPUTATION COMPLETED + // IERR=1, INPUT ERROR - NO COMPUTATION + // IERR=2, OVERFLOW - NO COMPUTATION, REAL(ZTA) + // TOO LARGE ON KODE=1 + // IERR=3, CABS(Z) LARGE - COMPUTATION COMPLETED + // LOSSES OF SIGNIFCANCE BY ARGUMENT REDUCTION + // PRODUCE LESS THAN HALF OF MACHINE ACCURACY + // IERR=4, CABS(Z) TOO LARGE - NO COMPUTATION + // COMPLETE LOSS OF ACCURACY BY ARGUMENT + // REDUCTION + // IERR=5, ERROR - NO COMPUTATION, + // ALGORITHM TERMINATION CONDITION NOT MET + // + //***LONG DESCRIPTION + // + // AI AND DAI ARE COMPUTED FOR CABS(Z).GT.1.0 FROM THE K BESSEL + // FUNCTIONS BY + // + // AI(Z)=C*SQRT(Z)*K(1/3,ZTA) , DAI(Z)=-C*Z*K(2/3,ZTA) + // C=1.0/(PI*SQRT(3.0)) + // ZTA=(2/3)*Z**(3/2) + // + // WITH THE POWER SERIES FOR CABS(Z).LE.1.0. + // + // IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- + // MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z IS LARGE, LOSSES + // OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. CONSEQUENTLY, IF + // THE MAGNITUDE OF ZETA=(2/3)*Z**1.5 EXCEEDS U1=SQRT(0.5/UR), + // THEN LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR + // FLAG IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS + // DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. + // ALSO, IF THE MAGNITUDE OF ZETA IS LARGER THAN U2=0.5/UR, THEN + // ALL SIGNIFICANCE IS LOST AND IERR=4. IN ORDER TO USE THE INT + // FUNCTION, ZETA MUST BE FURTHER RESTRICTED NOT TO EXCEED THE + // LARGEST INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF ZETA + // MUST BE RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, + // AND U3 ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE + // PRECISION ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE + // PRECISION ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMIT- + // ING IN THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT THE MAG- + // NITUDE OF Z CANNOT EXCEED 3.1E+4 IN SINGLE AND 2.1E+6 IN + // DOUBLE PRECISION ARITHMETIC. THIS ALSO MEANS THAT ONE CAN + // EXPECT TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, + // NO DIGITS IN SINGLE PRECISION AND ONLY 7 DIGITS IN DOUBLE + // PRECISION ARITHMETIC. SIMILAR CONSIDERATIONS HOLD FOR OTHER + // MACHINES. + // + // THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX + // BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT + // ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- + // SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE + // ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), + // ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF + // CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY + // HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN + // ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY + // SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER + // THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, + // 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS + // THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER + // COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY + // BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER + // COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE + // MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, + // THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, + // OR -PI/2+P. + // + //***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ + // AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF + // COMMERCE, 1955. + // + // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT + // AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 + // + // A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX + // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- + // 1018, MAY, 1985 + // + // A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX + // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS. + // MATH. SOFTWARE, 1986 + // + //***ROUTINES CALLED ZACAI,ZBKNU,AZEXP,AZSQRT,I1MACH,D1MACH + //***END PROLOGUE ZAIRY + + std::complex ai, csq, cy[1], s1, s2, trm1, trm2, zta, z3; + double aa, ad, ak, alim, atrm, az, az3, bk, ck, dig, dk, d1, d2, elim, fid, fnu, rl, r1m5, sfac, tol, zi, zr, + bb, alaz; + int iflag, k, k1, k2, mr, nn; + double tth = 2. / 3.; + double c1 = 0.35502805388781723926; /* 1/(Gamma(2/3) * 3**(2/3)) */ + double c2 = 0.25881940379280679841; /* 1/(Gamma(1/3) * 3**(1/3)) */ + double coef = 0.18377629847393068317; /* 1 / (sqrt(3) * PI) */ + + *ierr = 0; *nz = 0; - return 0.; - } - aa = sqrt(aa); - if (az > aa) { *ierr = 3; } - csq = std::sqrt(z); - zta = z * csq * tth; - // - // RE(ZTA) <= 0 WHEN RE(Z) < 0, ESPECIALLY WHEN IM(Z) IS SMALL - // - iflag = 0; - sfac = 1.0; - zi = std::imag(z); - zr = std::real(z); - ak = std::imag(zta); - if (zr < 0.0) { - bk = std::real(zta); - ck = -fabs(bk); - zta = std::complex(ck, ak); - } - if ((zi == 0.0) && (zr <= 0.0)) { - zta = std::complex(0.0, ak); - } - aa = std::real(zta); - if ((aa < 0.0) || (zr <= 0.0)) { - if (kode != 2) { + ai = 0.; + if ((id < 0) || (id > 1)) { + *ierr = 1; + } + if ((kode < 1) || (kode > 2)) { + *ierr = 1; + } + if (*ierr != 0) + return 0.; + az = std::abs(z); + tol = d1mach[3]; + fid = id; + + if (az <= 1.0) { // - // OVERFLOW TEST + // POWER SERIES FOR ABS(Z) <= 1. // - if (aa <= -alim) { - aa = -aa + 0.25*alaz; - iflag = 1; - sfac = tol; - if (aa > elim) { - /* 270 */ - *nz = 0; - *ierr = 2; + s1 = 1.0; + s2 = 1.0; + if (az < tol) { + aa = 1e3 * d1mach[0]; + s1 = 0.; + if (id != 1) { + if (az > aa) { + s1 = c2 * z; + } + ai = c1 - s1; + return ai; + } + ai = -c2; + aa = sqrt(aa); + if (az > aa) { + s1 = z * z * 0.5; + } + ai += s1 * c1; + return ai; + } + aa = az * az; + if (aa >= tol / az) { + trm1 = 1.0; + trm2 = 1.0; + atrm = 1.0; + z3 = z * z * z; + az3 = az * aa; + ak = 2.0 + fid; + bk = 3.0 - fid - fid; + ck = 4.0 - fid; + dk = 3.0 + fid + fid; + d1 = ak * dk; + d2 = bk * ck; + ad = (d1 > d2 ? d2 : d1); + ak = 24.0 + 9.0 * fid; + bk = 30.0 - 9.0 * fid; + for (int k = 1; k < 26; k++) { + trm1 *= z3 / d1; + s1 += trm1; + trm2 *= z3 / d2; + s2 += trm2; + atrm *= az3 / ad; + d1 += ak; + d2 += bk; + ad = (d1 > d2 ? d2 : d1); + if (atrm < tol * ad) { + break; + } + ak += 18.0; + bk += 18.0; + } + } + if (id != 1) { + ai = s1 * c1 - z * s2 * c2; + if (kode == 1) { return ai; } + zta = z * std::sqrt(z) * tth; + ai *= std::exp(zta); + return ai; + } + ai = -s2 * c2; + if (az > tol) { + ai += z * z * s1 * c1 / (1. + fid); } + if (kode == 1) { + return ai; + } + zta = z * std::sqrt(z) * tth; + return ai * std::exp(zta); } // - // CBKNU AND CACAI RETURN EXP(ZTA)*K(FNU,ZTA) ON KODE=2 + // CASE FOR ABS(Z) > 1.0 // - mr = 1; - if (zi < 0.0) { mr = -1; } - nn = acai(zta, fnu, kode, mr, 1, &cy[0], rl, tol, elim, alim); - if (nn < 0) { - if (nn == -1) { - *nz = 1; - return 0.; - } else { - *nz = 0; - *ierr = 5; - return 0.; - } + fnu = (1.0 + fid) / 3.0; + // + // SET PARAMETERS RELATED TO MACHINE CONSTANTS. + // TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. + // ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. + // EXP(-ELIM) < EXP(-ALIM)=EXP(-ELIM)/TOL AND + // EXP(ELIM) > EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR + // UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. + // RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. + // DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). + // + k1 = i1mach[14]; + k2 = i1mach[15]; + r1m5 = d1mach[4]; + k = (abs(k1) > abs(k2) ? abs(k2) : abs(k1)); + elim = 2.303 * (k * r1m5 - 3.0); + k1 = i1mach[13] - 1; + aa = r1m5 * k1; + dig = (aa > 18.0 ? 18.0 : aa); + aa *= 2.303; + alim = elim + (-aa > -41.45 ? -aa : -41.45); + rl = 1.2 * dig + 3.0; + alaz = log(az); + // + // TEST FOR RANGE + // + aa = 0.5 / tol; + bb = i1mach[8] * 0.5; + aa = (aa > bb ? bb : aa); + aa = pow(aa, tth); + if (az > aa) { + *ierr = 4; + *nz = 0; + return 0.; } - *nz += nn; - } else { - if (kode != 2) { + aa = sqrt(aa); + if (az > aa) { + *ierr = 3; + } + csq = std::sqrt(z); + zta = z * csq * tth; + // + // RE(ZTA) <= 0 WHEN RE(Z) < 0, ESPECIALLY WHEN IM(Z) IS SMALL + // + iflag = 0; + sfac = 1.0; + zi = std::imag(z); + zr = std::real(z); + ak = std::imag(zta); + if (zr < 0.0) { + bk = std::real(zta); + ck = -fabs(bk); + zta = std::complex(ck, ak); + } + if ((zi == 0.0) && (zr <= 0.0)) { + zta = std::complex(0.0, ak); + } + aa = std::real(zta); + if ((aa < 0.0) || (zr <= 0.0)) { + if (kode != 2) { + // + // OVERFLOW TEST + // + if (aa <= -alim) { + aa = -aa + 0.25 * alaz; + iflag = 1; + sfac = tol; + if (aa > elim) { + /* 270 */ + *nz = 0; + *ierr = 2; + return ai; + } + } + } // - // UNDERFLOW TEST + // CBKNU AND CACAI RETURN EXP(ZTA)*K(FNU,ZTA) ON KODE=2 // - if (aa >= alim) { - aa = -aa - 0.25 * alaz; - iflag = 2; - sfac = 1.0 / tol; - if (aa < -elim) { + mr = 1; + if (zi < 0.0) { + mr = -1; + } + nn = acai(zta, fnu, kode, mr, 1, &cy[0], rl, tol, elim, alim); + if (nn < 0) { + if (nn == -1) { *nz = 1; return 0.; + } else { + *nz = 0; + *ierr = 5; + return 0.; + } + } + *nz += nn; + } else { + if (kode != 2) { + // + // UNDERFLOW TEST + // + if (aa >= alim) { + aa = -aa - 0.25 * alaz; + iflag = 2; + sfac = 1.0 / tol; + if (aa < -elim) { + *nz = 1; + return 0.; + } } } + *nz = bknu(zta, fnu, kode, 1, &cy[0], tol, elim, alim); } - *nz = bknu(zta, fnu, kode, 1, &cy[0], tol, elim, alim); - } - s1 = cy[0]*coef; + s1 = cy[0] * coef; - if (iflag == 0) { + if (iflag == 0) { + if (id != 1) { + return csq * s1; + } + return (-z * s1); + } + s1 *= sfac; if (id != 1) { - return csq *s1; + s1 *= csq; + return (s1 / sfac); } - return (-z*s1); - } - s1 *= sfac; - if (id != 1) { - s1 *= csq; - return (s1/sfac); + s1 *= -z; + return (s1 / sfac); } - s1 *= -z; - return (s1/sfac); -} - - -inline int asyi( - std::complex z, - double fnu, - int kode, - int n, - std::complex *y, - double rl, - double tol, - double elim, - double alim -) { - - //***BEGIN PROLOGUE ZASYI - //***REFER TO ZBESI,ZBESK - // - // ZASYI COMPUTES THE I BESSEL FUNCTION FOR REAL(Z).GE.0.0 BY - // MEANS OF THE ASYMPTOTIC EXPANSION FOR LARGE CABS(Z) IN THE - // REGION CABS(Z).GT.MAX(RL,FNU*FNU/2). NZ=0 IS A NORMAL RETURN. - // NZ.LT.0 INDICATES AN OVERFLOW ON KODE=1. - // - //***ROUTINES CALLED D1MACH,AZABS,ZDIV,AZEXP,ZMLT,AZSQRT - //***END PROLOGUE ZASYI - - std::complex ak1, ck, cs1, cs2, cz, dk, ez, p1, rz, s2; - double aa, acz, aez, ak, arg, arm, atol, az, bb, bk, dfnu; - double dnu2, fdn, rtr1, s, sgn, sqk, x, yy; - int ib, il, inu, j, jl, k, koded, m, nn; - double pi = 3.14159265358979324; - double rpi = 0.159154943091895336; /* (1 / pi) */ - int nz = 0; - az = std::abs(z); - x = std::real(z); - arm = 1e3*d1mach[0]; - rtr1 = sqrt(arm); - il = (n > 2 ? 2 : n); - dfnu = fnu + (n - il); - // OVERFLOW TEST - ak1 = std::sqrt(rpi / z); - cz = z; - if (kode == 2) { cz = std::complex(0.0, std::imag(z)); } - acz = std::real(cz); - if (fabs(acz) <= elim) { - dnu2 = dfnu + dfnu; - koded = 1; - if (!((fabs(acz) > alim) && (n > 2))) { - koded = 0; - ak1 *= std::exp(cz); - } - fdn = 0.; - if (dnu2 > rtr1) { fdn = dnu2 * dnu2; } - ez = z * 8.; - // WHEN Z IS IMAGINARY, THE ERROR TEST MUST BE MADE - // RELATIVE TO THE FIRST RECIPROCAL POWER SINCE THIS - // IS THE LEADING TERM OF THE EXPANSION FOR THE - // IMAGINARY PART. - aez = 8. * az; - s = tol / aez; - jl = (int)(rl + rl) + 2; - yy = std::imag(z); - p1 = 0.; - if (yy != 0.) { - inu = (int)fnu; - arg = (fnu - inu) * pi; - inu += n - il; - ak = -sin(arg); - bk = cos(arg); - if (yy < 0.) { bk = -bk; } - p1 = std::complex(ak, bk); - if (inu % 2 == 1) { p1 = -p1; } - } - for (int k = 1; k < (il+1); k++) - { - sqk = fdn - 1.; - atol = s*fabs(sqk); - sgn = 1.; - cs1 = 1.; - cs2 = 1.; - ck = 1.; - ak = 0.; - aa = 1.; - bb = aez; - dk = ez; - j = 1; - for (j = 1; j < (jl+1); j++) - { - ck *= sqk / dk; - cs2 += ck; - sgn = -sgn; - cs1 += ck*sgn; - dk += ez; - aa *= fabs(sqk) / bb; - bb += aez; - ak += 8.; - sqk -= ak; - if (aa <= atol) { break; } - } - if ((j == (jl+1)) && (aa > atol)) { return -2; } - /* 50 */ - s2 = cs1; - if (x + x < elim) { s2 += p1*cs2*std::exp(-z-z); } - fdn += 8. * dfnu + 4.; - p1 = -p1; - m = n - il + k; - y[m - 1] = s2 * ak1; - } - if (n <= 2) { return nz; } - nn = n; - k = nn - 2; - ak = k; - rz = 2. / z; - ib = 3; - for (int i = ib; i < (nn+1); i++) - { - y[k-1] = (ak + fnu)*rz*y[k] + y[k+1]; - ak -= 1.; - k -=1; - } - if (koded == 0) { return nz; } - ck = std::exp(cz); - for (int i = 0; i < (nn + 1); i++) { y[i] *= ck; } - /* 90 */ - return nz; - } - /* 100 */ - return -1; -} - - -inline int besh( - std::complex z, - double fnu, - int kode, - int m, - int n, - std::complex *cy, - int *ierr -) { - - //***BEGIN PROLOGUE ZBESH - //***DATE WRITTEN 830501 (YYMMDD) - //***REVISION DATE 890801 (YYMMDD) - //***CATEGORY NO. B5K - //***KEYWORDS H-BESSEL FUNCTIONS,BESSEL FUNCTIONS OF COMPLEX ARGUMENT, - // BESSEL FUNCTIONS OF THIRD KIND,HANKEL FUNCTIONS - //***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES - //***PURPOSE TO COMPUTE THE H-BESSEL FUNCTIONS OF A COMPLEX ARGUMENT - //***DESCRIPTION - // - // ***A DOUBLE PRECISION ROUTINE*** - // ON KODE=1, ZBESH COMPUTES AN N MEMBER SEQUENCE OF COMPLEX - // HANKEL (BESSEL) FUNCTIONS CY(J)=H(M,FNU+J-1,Z) FOR KINDS M=1 - // OR 2, REAL, NONNEGATIVE ORDERS FNU+J-1, J=1,...,N, AND COMPLEX - // Z.NE.std::complex(0.0,0.0) IN THE CUT PLANE -PI.LT.ARG(Z).LE.PI. - // ON KODE=2, ZBESH RETURNS THE SCALED HANKEL FUNCTIONS - // - // CY(I)=EXP(-MM*Z*I)*H(M,FNU+J-1,Z) MM=3-2*M, I**2=-1. - // - // WHICH REMOVES THE EXPONENTIAL BEHAVIOR IN BOTH THE UPPER AND - // LOWER HALF PLANES. DEFINITIONS AND NOTATION ARE FOUND IN THE - // NBS HANDBOOK OF MATHEMATICAL FUNCTIONS (REF. 1). - // - // INPUT ZR,ZI,FNU ARE DOUBLE PRECISION - // ZR,ZI - Z=std::complex(ZR,ZI), Z.NE.std::complex(0.0D0,0.0D0), - // -PT.LT.ARG(Z).LE.PI - // FNU - ORDER OF INITIAL H FUNCTION, FNU.GE.0.0D0 - // KODE - A PARAMETER TO INDICATE THE SCALING OPTION - // KODE= 1 RETURNS - // CY(J)=H(M,FNU+J-1,Z), J=1,...,N - // = 2 RETURNS - // CY(J)=H(M,FNU+J-1,Z)*EXP(-I*Z*(3-2M)) - // J=1,...,N , I**2=-1 - // M - KIND OF HANKEL FUNCTION, M=1 OR 2 - // N - NUMBER OF MEMBERS IN THE SEQUENCE, N.GE.1 - // - // OUTPUT CYR,CYI ARE DOUBLE PRECISION - // CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS - // CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE - // CY(J)=H(M,FNU+J-1,Z) OR - // CY(J)=H(M,FNU+J-1,Z)*EXP(-I*Z*(3-2M)) J=1,...,N - // DEPENDING ON KODE, I**2=-1. - // NZ - NUMBER OF COMPONENTS SET TO ZERO DUE TO UNDERFLOW, - // NZ= 0 , NORMAL RETURN - // NZ.GT.0 , FIRST NZ COMPONENTS OF CY SET TO ZERO DUE - // TO UNDERFLOW, CY(J)=std::complex(0.0D0,0.0D0) - // J=1,...,NZ WHEN Y.GT.0.0 AND M=1 OR - // Y.LT.0.0 AND M=2. FOR THE COMPLMENTARY - // HALF PLANES, NZ STATES ONLY THE NUMBER - // OF UNDERFLOWS. - // IERR - ERROR FLAG - // IERR=0, NORMAL RETURN - COMPUTATION COMPLETED - // IERR=1, INPUT ERROR - NO COMPUTATION - // IERR=2, OVERFLOW - NO COMPUTATION, FNU TOO - // LARGE OR CABS(Z) TOO SMALL OR BOTH - // IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE - // BUT LOSSES OF SIGNIFCANCE BY ARGUMENT - // REDUCTION PRODUCE LESS THAN HALF OF MACHINE - // ACCURACY - // IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA- - // TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI- - // CANCE BY ARGUMENT REDUCTION - // IERR=5, ERROR - NO COMPUTATION, - // ALGORITHM TERMINATION CONDITION NOT MET - // - //***LONG DESCRIPTION - // - // THE COMPUTATION IS CARRIED OUT BY THE RELATION - // - // H(M,FNU,Z)=(1/MP)*EXP(-MP*FNU)*K(FNU,Z*EXP(-MP)) - // MP=MM*HPI*I, MM=3-2*M, HPI=PI/2, I**2=-1 - // - // FOR M=1 OR 2 WHERE THE K BESSEL FUNCTION IS COMPUTED FOR THE - // RIGHT HALF PLANE RE(Z).GE.0.0. THE K FUNCTION IS CONTINUED - // TO THE LEFT HALF PLANE BY THE RELATION - // - // K(FNU,Z*EXP(MP)) = EXP(-MP*FNU)*K(FNU,Z)-MP*I(FNU,Z) - // MP=MR*PI*I, MR=+1 OR -1, RE(Z).GT.0, I**2=-1 - // - // WHERE I(FNU,Z) IS THE I BESSEL FUNCTION. - // - // EXPONENTIAL DECAY OF H(M,FNU,Z) OCCURS IN THE UPPER HALF Z - // PLANE FOR M=1 AND THE LOWER HALF Z PLANE FOR M=2. EXPONENTIAL - // GROWTH OCCURS IN THE COMPLEMENTARY HALF PLANES. SCALING - // BY EXP(-MM*Z*I) REMOVES THE EXPONENTIAL BEHAVIOR IN THE - // WHOLE Z PLANE FOR Z TO INFINITY. - // - // FOR NEGATIVE ORDERS,THE FORMULAE - // - // H(1,-FNU,Z) = H(1,FNU,Z)*CEXP( PI*FNU*I) - // H(2,-FNU,Z) = H(2,FNU,Z)*CEXP(-PI*FNU*I) - // I**2=-1 - // - // CAN BE USED. - // - // IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- - // MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS - // LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. - // CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN - // LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG - // IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS - // DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. - // IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS - // LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS - // MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE - // INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS - // RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3 - // ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION - // ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION - // ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN - // THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT - // TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS - // IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC. - // SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES. - // - // THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX - // BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT - // ROUNDOFF,1.0D-18) IS THE NOMINAL PRECISION AND 10**S REPRE- - // SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE - // ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), - // ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF - // CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY - // HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN - // ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY - // SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER - // THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, - // 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS - // THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER - // COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY - // BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER - // COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE - // MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, - // THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, - // OR -PI/2+P. - // - //***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ - // AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF - // COMMERCE, 1955. - // - // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT - // BY D. E. AMOS, SAND83-0083, MAY, 1983. - // - // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT - // AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 - // - // A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX - // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- - // 1018, MAY, 1985 - // - // A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX - // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS. - // MATH. SOFTWARE, 1986 - // - //***ROUTINES CALLED ZACON,ZBKNU,ZBUNK,ZUOIK,AZABS,I1MACH,D1MACH - //***END PROLOGUE ZBESH - - std::complex zn, zt, csgn; - double aa, alim, aln, arg, az, cpn, dig, elim, fmm, fn, fnul, - rhpi, rl, r1m5, sgn, spn, tol, ufl, xn, xx, yn, yy, - bb, ascle, rtol, atol; - int i, inu, inuh, ir, k, k1, k2, mm, mr, nn, nuf, nw, nz; - - double hpi = 1.57079632679489662; /* 0.5 PI */ - - nz = 0; - xx = std::real(z); - yy = std::imag(z); - *ierr = 0; - - if ((xx == 0.0) && (yy == 0.0)) { *ierr = 1; } - if (fnu < 0.0) { *ierr = 1; } - if ((m < 1) || (m > 2)) { *ierr = 1; } - if ((kode < 1) || (kode > 2)) { *ierr = 1; } - if (n < 1) { *ierr = 1; } - if (*ierr != 0) { return nz; } - nn = n; - // - // SET PARAMETERS RELATED TO MACHINE CONSTANTS. - // TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. - // ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. - // EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND - // EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR - // UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. - // RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. - // DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). - // FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU - // - tol = fmax(d1mach[3], 1e-18); - k1 = i1mach[14]; - k2 = i1mach[15]; - r1m5 = d1mach[4]; - k = ( abs(k1) > abs(k2) ? abs(k2) : abs(k1) ); - elim = 2.303 * (k*r1m5 - 3.0); - k1 = i1mach[13] - 1; - aa = r1m5*k1; - dig = fmin(aa, 18.0); - aa *= 2.303; - alim = elim + fmax(-aa, -41.45); - fnul = 10.0 + 6.0 * (dig - 3.0); - rl = 1.2*dig + 3.0; - fn = fnu + (nn - 1); - mm = 3 - m - m; - fmm = mm; - zn = z * std::complex(0.0, -fmm); - xn = std::real(zn); - yn = std::imag(zn); - // - // TEST FOR PROPER RANGE - // - az = std::abs(z); - bb = d1mach[1] * 0.5; - aa = fmin(0.5 / tol, bb); - if ((az > aa) || (fn > aa)){ *ierr =4; return 0; } /* GO TO 260 */ - aa = sqrt(aa); - if (az > aa) { *ierr = 3; } - if (fn > aa) { *ierr = 3; } - // - // OVERFLOW TEST ON THE LAST MEMBER OF THE SEQUENCE - // - ufl = d1mach[0] * 1.0e3; - if (az < ufl) { *ierr = 2; return 0; } /* GO TO 230 */ - if (fnu <= fnul) { + inline int asyi( + std::complex z, double fnu, int kode, int n, std::complex *y, double rl, double tol, + double elim, double alim + ) { + + //***BEGIN PROLOGUE ZASYI + //***REFER TO ZBESI,ZBESK // - // Untangling GOTOs with explicit conditions + // ZASYI COMPUTES THE I BESSEL FUNCTION FOR REAL(Z).GE.0.0 BY + // MEANS OF THE ASYMPTOTIC EXPANSION FOR LARGE CABS(Z) IN THE + // REGION CABS(Z).GT.MAX(RL,FNU*FNU/2). NZ=0 IS A NORMAL RETURN. + // NZ.LT.0 INDICATES AN OVERFLOW ON KODE=1. // - if ((fn > 1.0) && (fn <= 2.0) && (az <= tol)) { - /* Failed through all checks */ - arg = 0.5 * az; - aln = -fn * log(arg); - if (aln > elim) { *ierr = 2; return 0; } /* GO TO 230 */ - /* GO TO 70 */ - } else if ((fn > 1.0) && (fn <= 2.0) && (az > tol)) { - /* Failed all but the az > tol hence do nothing and GO TO 70 */ - } else if ((fn > 1.0) && (fn > 2.0)) { - /* GO TO 60 */ - nuf = uoik(zn, fnu, kode, 2, nn, cy, tol, elim, alim); - if (nuf < 0) { *ierr = 2; return 0; } /* GO TO 230 */ - nz += nuf; - nn -= nuf; - // - // HERE NN=N OR NN=0 SINCE NUF=0,NN, OR -1 ON RETURN FROM CUOIK - // IF NUF=NN, THEN CY(I)=CZERO FOR ALL I - // - if (nn == 0) { - /* GO TO 140 */ - if (xn < 0.0) { *ierr = 2; return 0; } /* GO TO 230 */ + //***ROUTINES CALLED D1MACH,AZABS,ZDIV,AZEXP,ZMLT,AZSQRT + //***END PROLOGUE ZASYI + + std::complex ak1, ck, cs1, cs2, cz, dk, ez, p1, rz, s2; + double aa, acz, aez, ak, arg, arm, atol, az, bb, bk, dfnu; + double dnu2, fdn, rtr1, s, sgn, sqk, x, yy; + int ib, il, inu, j, jl, k, koded, m, nn; + double pi = 3.14159265358979324; + double rpi = 0.159154943091895336; /* (1 / pi) */ + int nz = 0; + az = std::abs(z); + x = std::real(z); + arm = 1e3 * d1mach[0]; + rtr1 = sqrt(arm); + il = (n > 2 ? 2 : n); + dfnu = fnu + (n - il); + // OVERFLOW TEST + ak1 = std::sqrt(rpi / z); + cz = z; + if (kode == 2) { + cz = std::complex(0.0, std::imag(z)); + } + acz = std::real(cz); + if (fabs(acz) <= elim) { + dnu2 = dfnu + dfnu; + koded = 1; + if (!((fabs(acz) > alim) && (n > 2))) { + koded = 0; + ak1 *= std::exp(cz); + } + fdn = 0.; + if (dnu2 > rtr1) { + fdn = dnu2 * dnu2; + } + ez = z * 8.; + // WHEN Z IS IMAGINARY, THE ERROR TEST MUST BE MADE + // RELATIVE TO THE FIRST RECIPROCAL POWER SINCE THIS + // IS THE LEADING TERM OF THE EXPANSION FOR THE + // IMAGINARY PART. + aez = 8. * az; + s = tol / aez; + jl = (int)(rl + rl) + 2; + yy = std::imag(z); + p1 = 0.; + if (yy != 0.) { + inu = (int)fnu; + arg = (fnu - inu) * pi; + inu += n - il; + ak = -sin(arg); + bk = cos(arg); + if (yy < 0.) { + bk = -bk; + } + p1 = std::complex(ak, bk); + if (inu % 2 == 1) { + p1 = -p1; + } + } + for (int k = 1; k < (il + 1); k++) { + sqk = fdn - 1.; + atol = s * fabs(sqk); + sgn = 1.; + cs1 = 1.; + cs2 = 1.; + ck = 1.; + ak = 0.; + aa = 1.; + bb = aez; + dk = ez; + j = 1; + for (j = 1; j < (jl + 1); j++) { + ck *= sqk / dk; + cs2 += ck; + sgn = -sgn; + cs1 += ck * sgn; + dk += ez; + aa *= fabs(sqk) / bb; + bb += aez; + ak += 8.; + sqk -= ak; + if (aa <= atol) { + break; + } + } + if ((j == (jl + 1)) && (aa > atol)) { + return -2; + } + + /* 50 */ + s2 = cs1; + if (x + x < elim) { + s2 += p1 * cs2 * std::exp(-z - z); + } + fdn += 8. * dfnu + 4.; + p1 = -p1; + m = n - il + k; + y[m - 1] = s2 * ak1; + } + if (n <= 2) { return nz; } - /* GO TO 70 */ - } else { - /* Passed the first hence GO TO 70 */ + nn = n; + k = nn - 2; + ak = k; + rz = 2. / z; + ib = 3; + for (int i = ib; i < (nn + 1); i++) { + y[k - 1] = (ak + fnu) * rz * y[k] + y[k + 1]; + ak -= 1.; + k -= 1; + } + if (koded == 0) { + return nz; + } + ck = std::exp(cz); + for (int i = 0; i < (nn + 1); i++) { + y[i] *= ck; + } + /* 90 */ + return nz; } + /* 100 */ + return -1; + } - /* GO TO 70 */ + inline int besh(std::complex z, double fnu, int kode, int m, int n, std::complex *cy, int *ierr) { + + //***BEGIN PROLOGUE ZBESH + //***DATE WRITTEN 830501 (YYMMDD) + //***REVISION DATE 890801 (YYMMDD) + //***CATEGORY NO. B5K + //***KEYWORDS H-BESSEL FUNCTIONS,BESSEL FUNCTIONS OF COMPLEX ARGUMENT, + // BESSEL FUNCTIONS OF THIRD KIND,HANKEL FUNCTIONS + //***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES + //***PURPOSE TO COMPUTE THE H-BESSEL FUNCTIONS OF A COMPLEX ARGUMENT + //***DESCRIPTION // - // More GOTOs untangling + // ***A DOUBLE PRECISION ROUTINE*** + // ON KODE=1, ZBESH COMPUTES AN N MEMBER SEQUENCE OF COMPLEX + // HANKEL (BESSEL) FUNCTIONS CY(J)=H(M,FNU+J-1,Z) FOR KINDS M=1 + // OR 2, REAL, NONNEGATIVE ORDERS FNU+J-1, J=1,...,N, AND COMPLEX + // Z.NE.std::complex(0.0,0.0) IN THE CUT PLANE -PI.LT.ARG(Z).LE.PI. + // ON KODE=2, ZBESH RETURNS THE SCALED HANKEL FUNCTIONS // - if ((xn < 0.0) || ((xn == 0.0) && (yn < 0.0) && (m == 2))) { - /* GO TO 80 */ - mr = -mm; - nw = acon(zn, fnu, kode, mr, nn, cy, rl, fnul, tol, elim, alim); - if (nw < 0) { - /* GO TO 240 */ - if (nw == -1) { *ierr = 2; return 0; } /* GO TO 230 */ - *ierr = 5; - return 0; - } - nz = nw; - /* GO TO 110 */ - } else { - // - // RIGHT HALF PLANE COMPUTATION, XN >= 0. .AND. (XN.NE.0. .OR. - // YN >= 0. .OR. M=1) - // - nz = bknu(zn, fnu, kode, nn, cy, tol, elim, alim); - /* GO TO 110 */ - } - } else { - /* GO TO 90 */ + // CY(I)=EXP(-MM*Z*I)*H(M,FNU+J-1,Z) MM=3-2*M, I**2=-1. // - // UNIFORM ASYMPTOTIC EXPANSIONS FOR FNU > FNUL + // WHICH REMOVES THE EXPONENTIAL BEHAVIOR IN BOTH THE UPPER AND + // LOWER HALF PLANES. DEFINITIONS AND NOTATION ARE FOUND IN THE + // NBS HANDBOOK OF MATHEMATICAL FUNCTIONS (REF. 1). // - mr = 0; - if (!((xn >= 0.0) && ((xn != 0.0) || (yn >= 0.0) || (m != 2)))) { - mr = -mm; - if ((xn == 0.0) && (yn < 0.0)) { zn = -zn; } + // INPUT ZR,ZI,FNU ARE DOUBLE PRECISION + // ZR,ZI - Z=std::complex(ZR,ZI), Z.NE.std::complex(0.0D0,0.0D0), + // -PT.LT.ARG(Z).LE.PI + // FNU - ORDER OF INITIAL H FUNCTION, FNU.GE.0.0D0 + // KODE - A PARAMETER TO INDICATE THE SCALING OPTION + // KODE= 1 RETURNS + // CY(J)=H(M,FNU+J-1,Z), J=1,...,N + // = 2 RETURNS + // CY(J)=H(M,FNU+J-1,Z)*EXP(-I*Z*(3-2M)) + // J=1,...,N , I**2=-1 + // M - KIND OF HANKEL FUNCTION, M=1 OR 2 + // N - NUMBER OF MEMBERS IN THE SEQUENCE, N.GE.1 + // + // OUTPUT CYR,CYI ARE DOUBLE PRECISION + // CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS + // CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE + // CY(J)=H(M,FNU+J-1,Z) OR + // CY(J)=H(M,FNU+J-1,Z)*EXP(-I*Z*(3-2M)) J=1,...,N + // DEPENDING ON KODE, I**2=-1. + // NZ - NUMBER OF COMPONENTS SET TO ZERO DUE TO UNDERFLOW, + // NZ= 0 , NORMAL RETURN + // NZ.GT.0 , FIRST NZ COMPONENTS OF CY SET TO ZERO DUE + // TO UNDERFLOW, CY(J)=std::complex(0.0D0,0.0D0) + // J=1,...,NZ WHEN Y.GT.0.0 AND M=1 OR + // Y.LT.0.0 AND M=2. FOR THE COMPLMENTARY + // HALF PLANES, NZ STATES ONLY THE NUMBER + // OF UNDERFLOWS. + // IERR - ERROR FLAG + // IERR=0, NORMAL RETURN - COMPUTATION COMPLETED + // IERR=1, INPUT ERROR - NO COMPUTATION + // IERR=2, OVERFLOW - NO COMPUTATION, FNU TOO + // LARGE OR CABS(Z) TOO SMALL OR BOTH + // IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE + // BUT LOSSES OF SIGNIFCANCE BY ARGUMENT + // REDUCTION PRODUCE LESS THAN HALF OF MACHINE + // ACCURACY + // IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA- + // TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI- + // CANCE BY ARGUMENT REDUCTION + // IERR=5, ERROR - NO COMPUTATION, + // ALGORITHM TERMINATION CONDITION NOT MET + // + //***LONG DESCRIPTION + // + // THE COMPUTATION IS CARRIED OUT BY THE RELATION + // + // H(M,FNU,Z)=(1/MP)*EXP(-MP*FNU)*K(FNU,Z*EXP(-MP)) + // MP=MM*HPI*I, MM=3-2*M, HPI=PI/2, I**2=-1 + // + // FOR M=1 OR 2 WHERE THE K BESSEL FUNCTION IS COMPUTED FOR THE + // RIGHT HALF PLANE RE(Z).GE.0.0. THE K FUNCTION IS CONTINUED + // TO THE LEFT HALF PLANE BY THE RELATION + // + // K(FNU,Z*EXP(MP)) = EXP(-MP*FNU)*K(FNU,Z)-MP*I(FNU,Z) + // MP=MR*PI*I, MR=+1 OR -1, RE(Z).GT.0, I**2=-1 + // + // WHERE I(FNU,Z) IS THE I BESSEL FUNCTION. + // + // EXPONENTIAL DECAY OF H(M,FNU,Z) OCCURS IN THE UPPER HALF Z + // PLANE FOR M=1 AND THE LOWER HALF Z PLANE FOR M=2. EXPONENTIAL + // GROWTH OCCURS IN THE COMPLEMENTARY HALF PLANES. SCALING + // BY EXP(-MM*Z*I) REMOVES THE EXPONENTIAL BEHAVIOR IN THE + // WHOLE Z PLANE FOR Z TO INFINITY. + // + // FOR NEGATIVE ORDERS,THE FORMULAE + // + // H(1,-FNU,Z) = H(1,FNU,Z)*CEXP( PI*FNU*I) + // H(2,-FNU,Z) = H(2,FNU,Z)*CEXP(-PI*FNU*I) + // I**2=-1 + // + // CAN BE USED. + // + // IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- + // MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS + // LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. + // CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN + // LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG + // IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS + // DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. + // IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS + // LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS + // MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE + // INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS + // RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3 + // ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION + // ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION + // ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN + // THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT + // TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS + // IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC. + // SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES. + // + // THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX + // BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT + // ROUNDOFF,1.0D-18) IS THE NOMINAL PRECISION AND 10**S REPRE- + // SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE + // ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), + // ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF + // CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY + // HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN + // ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY + // SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER + // THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, + // 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS + // THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER + // COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY + // BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER + // COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE + // MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, + // THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, + // OR -PI/2+P. + // + //***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ + // AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF + // COMMERCE, 1955. + // + // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT + // BY D. E. AMOS, SAND83-0083, MAY, 1983. + // + // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT + // AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 + // + // A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX + // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- + // 1018, MAY, 1985 + // + // A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX + // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS. + // MATH. SOFTWARE, 1986 + // + //***ROUTINES CALLED ZACON,ZBKNU,ZBUNK,ZUOIK,AZABS,I1MACH,D1MACH + //***END PROLOGUE ZBESH + + std::complex zn, zt, csgn; + double aa, alim, aln, arg, az, cpn, dig, elim, fmm, fn, fnul, rhpi, rl, r1m5, sgn, spn, tol, ufl, xn, xx, yn, + yy, bb, ascle, rtol, atol; + int i, inu, inuh, ir, k, k1, k2, mm, mr, nn, nuf, nw, nz; + + double hpi = 1.57079632679489662; /* 0.5 PI */ + + nz = 0; + xx = std::real(z); + yy = std::imag(z); + *ierr = 0; + + if ((xx == 0.0) && (yy == 0.0)) { + *ierr = 1; } - /* GO TO 100 */ - nw = bunk(zn, fnu, kode, mr, nn, cy, tol, elim, alim); - if (nw < 0) { - /* GO TO 240 */ - if (nw == -1) { *ierr = 2; return 0; } /* GO TO 230 */ - *ierr = 5; - return 0; + if (fnu < 0.0) { + *ierr = 1; } - nz += nw; - } - /* 110 */ - // - // H(M,FNU,Z) = -FMM*(I/HPI)*(ZT**FNU)*K(FNU,-Z*ZT) - // ZT=EXP(-FMM*HPI*I) = std::complex(0.0,-FMM), FMM=3-2*M, M=1,2 - // - sgn = (-fmm < 0 ? -hpi : hpi); - // - // CALCULATE EXP(FNU*HPI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE - // WHEN FNU IS LARGE - // - inu = (int)fnu; - inuh = inu / 2; - ir = inu - 2 * inuh; - arg = (fnu - (inu - ir)) * sgn; - rhpi = 1.0 / sgn; - cpn = rhpi * cos(arg); - spn = -rhpi * sin(arg); - csgn = std::complex(spn, cpn); - if (inuh % 2 == 1) { csgn = -csgn; } - zt = std::complex(0.0, -fmm); - rtol = 1.0 / tol; - ascle = ufl * rtol; - for (i = 1; i < (nn+1); i++) { - zn = cy[i-1]; - atol = 1.0; - if (fmax(fabs(std::real(zn)), fabs(std::imag(zn))) <= ascle) { - zn *= rtol; - atol = tol; + if ((m < 1) || (m > 2)) { + *ierr = 1; } - zn *= csgn; - cy[i-1] = zn * atol; - csgn *= zt; - } - return nz; -} - - -inline int besi( - std::complex z, - double fnu, - int kode, - int n, - std::complex *cy, - int *ierr -) { - - //***BEGIN PROLOGUE ZBESI - //***DATE WRITTEN 830501 (YYMMDD) - //***REVISION DATE 890801 (YYMMDD) - //***CATEGORY NO. B5K - //***KEYWORDS I-BESSEL FUNCTION,COMPLEX BESSEL FUNCTION, - // MODIFIED BESSEL FUNCTION OF THE FIRST KIND - //***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES - //***PURPOSE TO COMPUTE I-BESSEL FUNCTIONS OF COMPLEX ARGUMENT - //***DESCRIPTION - // - // ***A DOUBLE PRECISION ROUTINE*** - // ON KODE=1, ZBESI COMPUTES AN N MEMBER SEQUENCE OF COMPLEX - // BESSEL FUNCTIONS CY(J)=I(FNU+J-1,Z) FOR REAL, NONNEGATIVE - // ORDERS FNU+J-1, J=1,...,N AND COMPLEX Z IN THE CUT PLANE - // -PI.LT.ARG(Z).LE.PI. ON KODE=2, ZBESI RETURNS THE SCALED - // FUNCTIONS - // - // CY(J)=EXP(-ABS(X))*I(FNU+J-1,Z) J = 1,...,N , X=REAL(Z) - // - // WITH THE EXPONENTIAL GROWTH REMOVED IN BOTH THE LEFT AND - // RIGHT HALF PLANES FOR Z TO INFINITY. DEFINITIONS AND NOTATION - // ARE FOUND IN THE NBS HANDBOOK OF MATHEMATICAL FUNCTIONS - // (REF. 1). - // - // INPUT ZR,ZI,FNU ARE DOUBLE PRECISION - // ZR,ZI - Z=std::complex(ZR,ZI), -PI.LT.ARG(Z).LE.PI - // FNU - ORDER OF INITIAL I FUNCTION, FNU.GE.0.0D0 - // KODE - A PARAMETER TO INDICATE THE SCALING OPTION - // KODE= 1 RETURNS - // CY(J)=I(FNU+J-1,Z), J=1,...,N - // = 2 RETURNS - // CY(J)=I(FNU+J-1,Z)*EXP(-ABS(X)), J=1,...,N - // N - NUMBER OF MEMBERS OF THE SEQUENCE, N.GE.1 - // - // OUTPUT CYR,CYI ARE DOUBLE PRECISION - // CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS - // CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE - // CY(J)=I(FNU+J-1,Z) OR - // CY(J)=I(FNU+J-1,Z)*EXP(-ABS(X)) J=1,...,N - // DEPENDING ON KODE, X=REAL(Z) - // NZ - NUMBER OF COMPONENTS SET TO ZERO DUE TO UNDERFLOW, - // NZ= 0 , NORMAL RETURN - // NZ.GT.0 , LAST NZ COMPONENTS OF CY SET TO ZERO - // TO UNDERFLOW, CY(J)=std::complex(0.0D0,0.0D0) - // J = N-NZ+1,...,N - // IERR - ERROR FLAG - // IERR=0, NORMAL RETURN - COMPUTATION COMPLETED - // IERR=1, INPUT ERROR - NO COMPUTATION - // IERR=2, OVERFLOW - NO COMPUTATION, REAL(Z) TOO - // LARGE ON KODE=1 - // IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE - // BUT LOSSES OF SIGNIFCANCE BY ARGUMENT - // REDUCTION PRODUCE LESS THAN HALF OF MACHINE - // ACCURACY - // IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA- - // TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI- - // CANCE BY ARGUMENT REDUCTION - // IERR=5, ERROR - NO COMPUTATION, - // ALGORITHM TERMINATION CONDITION NOT MET - // - //***LONG DESCRIPTION - // - // THE COMPUTATION IS CARRIED OUT BY THE POWER SERIES FOR - // SMALL CABS(Z), THE ASYMPTOTIC EXPANSION FOR LARGE CABS(Z), - // THE MILLER ALGORITHM NORMALIZED BY THE WRONSKIAN AND A - // NEUMANN SERIES FOR IMTERMEDIATE MAGNITUDES, AND THE - // UNIFORM ASYMPTOTIC EXPANSIONS FOR I(FNU,Z) AND J(FNU,Z) - // FOR LARGE ORDERS. BACKWARD RECURRENCE IS USED TO GENERATE - // SEQUENCES OR REDUCE ORDERS WHEN NECESSARY. - // - // THE CALCULATIONS ABOVE ARE DONE IN THE RIGHT HALF PLANE AND - // CONTINUED INTO THE LEFT HALF PLANE BY THE FORMULA - // - // I(FNU,Z*EXP(M*PI)) = EXP(M*PI*FNU)*I(FNU,Z) REAL(Z).GT.0.0 - // M = +I OR -I, I**2=-1 - // - // FOR NEGATIVE ORDERS,THE FORMULA - // - // I(-FNU,Z) = I(FNU,Z) + (2/PI)*SIN(PI*FNU)*K(FNU,Z) - // - // CAN BE USED. HOWEVER,FOR LARGE ORDERS CLOSE TO INTEGERS, THE - // THE FUNCTION CHANGES RADICALLY. WHEN FNU IS A LARGE POSITIVE - // INTEGER,THE MAGNITUDE OF I(-FNU,Z)=I(FNU,Z) IS A LARGE - // NEGATIVE POWER OF TEN. BUT WHEN FNU IS NOT AN INTEGER, - // K(FNU,Z) DOMINATES IN MAGNITUDE WITH A LARGE POSITIVE POWER OF - // TEN AND THE MOST THAT THE SECOND TERM CAN BE REDUCED IS BY - // UNIT ROUNDOFF FROM THE COEFFICIENT. THUS, WIDE CHANGES CAN - // OCCUR WITHIN UNIT ROUNDOFF OF A LARGE INTEGER FOR FNU. HERE, - // LARGE MEANS FNU.GT.CABS(Z). - // - // IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- - // MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS - // LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. - // CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN - // LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG - // IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS - // DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. - // IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS - // LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS - // MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE - // INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS - // RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3 - // ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION - // ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION - // ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN - // THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT - // TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS - // IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC. - // SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES. - // - // THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX - // BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT - // ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- - // SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE - // ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), - // ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF - // CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY - // HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN - // ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY - // SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER - // THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, - // 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS - // THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER - // COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY - // BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER - // COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE - // MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, - // THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, - // OR -PI/2+P. - // - //***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ - // AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF - // COMMERCE, 1955. - // - // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT - // BY D. E. AMOS, SAND83-0083, MAY, 1983. - // - // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT - // AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 - // - // A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX - // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- - // 1018, MAY, 1985 - // - // A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX - // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS. - // MATH. SOFTWARE, 1986 - // - //***ROUTINES CALLED ZBINU,I1MACH,D1MACH - //***END PROLOGUE ZBESI - - std::complex csgn, zn; - double aa, alim, arg, atol, ascle, az, bb, dig, elim, fn, fnul, rl, rtol,\ - r1m5, tol, xx, yy; - int i, inu, k, k1, k2, nn, nz; - double pi = 3.14159265358979324; - - *ierr = 0; - nz = 0; - if (fnu < 0.0) { *ierr = 1; } - if ((kode < 1) || (kode > 2)) { *ierr = 1; } - if (n < 1) { *ierr = 1; } - if (*ierr != 0) { return nz; } - xx = std::real(z); - yy = std::imag(z); - // - // SET PARAMETERS RELATED TO MACHINE CONSTANTS. - // TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. - // ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. - // EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND - // EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR - // UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. - // RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. - // DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). - // FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU - // - tol = fmax(d1mach[3], 1e-18); - k1 = i1mach[14]; - k2 = i1mach[15]; - r1m5 = d1mach[4]; - k = ( abs(k1) > abs(k2) ? abs(k2) : abs(k1) ); - elim = 2.303 * (k*r1m5 - 3.0); - k1 = i1mach[13] - 1; - aa = r1m5*k1; - dig = fmin(aa, 18.0); - aa *= 2.303; - alim = elim + fmax(-aa, -41.45); - rl = 1.2 * dig + 3.0; - fnul = 10.0 + 6.0 * (dig - 3.0); - // - // TEST FOR PROPER RANGE - // - az = std::abs(z); - fn = fnu + (n - 1); - aa = 0.5 / tol; - bb = i1mach[8]*0.5; - aa = fmin(aa, bb); - if ((az > aa) || (fn > aa)) { - *ierr = 4; - return 0; - } - aa = sqrt(aa); - if (az > aa) { *ierr = 3; } - if (fn > aa) { *ierr = 3; } - zn = z; - csgn = 1.0; - if (xx < 0.0) { - zn = -z; + if ((kode < 1) || (kode > 2)) { + *ierr = 1; + } + if (n < 1) { + *ierr = 1; + } + if (*ierr != 0) { + return nz; + } + nn = n; // - // CALCULATE CSGN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE - // WHEN FNU IS LARGE + // SET PARAMETERS RELATED TO MACHINE CONSTANTS. + // TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. + // ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. + // EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND + // EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR + // UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. + // RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. + // DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). + // FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU // - inu = (int)fnu; - arg = (fnu - inu)*pi; - if (yy < 0.0) { arg = -arg; } - csgn = std::complex(cos(arg), sin(arg)); - if (inu % 2 == 1) { csgn = -csgn; } - } - /* 40 */ - nz = binu(zn, fnu, kode, n, cy, rl, fnul, tol, elim, alim); - if (nz < 0) { - if (nz == -2) { - *ierr = 5; + tol = fmax(d1mach[3], 1e-18); + k1 = i1mach[14]; + k2 = i1mach[15]; + r1m5 = d1mach[4]; + k = (abs(k1) > abs(k2) ? abs(k2) : abs(k1)); + elim = 2.303 * (k * r1m5 - 3.0); + k1 = i1mach[13] - 1; + aa = r1m5 * k1; + dig = fmin(aa, 18.0); + aa *= 2.303; + alim = elim + fmax(-aa, -41.45); + fnul = 10.0 + 6.0 * (dig - 3.0); + rl = 1.2 * dig + 3.0; + fn = fnu + (nn - 1); + mm = 3 - m - m; + fmm = mm; + zn = z * std::complex(0.0, -fmm); + xn = std::real(zn); + yn = std::imag(zn); + // + // TEST FOR PROPER RANGE + // + az = std::abs(z); + bb = d1mach[1] * 0.5; + aa = fmin(0.5 / tol, bb); + if ((az > aa) || (fn > aa)) { + *ierr = 4; return 0; + } /* GO TO 260 */ + aa = sqrt(aa); + if (az > aa) { + *ierr = 3; } - *ierr = 2; - return 0; - } - if (xx > 0.0) { return nz; } - // - // ANALYTIC CONTINUATION TO THE LEFT HALF PLANE - // - nn = n - nz; - if (nn == 0) { return nz; } - rtol = 1.0 / tol; - ascle = d1mach[0]*rtol*1e3; - for (i = 1; i < (nn+1); i++) - { - zn = cy[i-1]; - atol = 1.0; - if (fmax(fabs(std::real(zn)), fabs(std::imag(zn))) <= ascle) { - zn *= rtol; - atol = tol; - } - cy[i-1] = atol*(zn*csgn); - csgn = -csgn; - } - *ierr = 0; - return nz; -} - - -inline int besj( - std::complex z, - double fnu, - int kode, - int n, - std::complex *cy, - int *ierr -) { - - //***BEGIN PROLOGUE ZBESJ - //***DATE WRITTEN 830501 (YYMMDD) - //***REVISION DATE 890801 (YYMMDD) - //***CATEGORY NO. B5K - //***KEYWORDS J-BESSEL FUNCTION,BESSEL FUNCTION OF COMPLEX ARGUMENT, - // BESSEL FUNCTION OF FIRST KIND - //***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES - //***PURPOSE TO COMPUTE THE J-BESSEL FUNCTION OF A COMPLEX ARGUMENT - //***DESCRIPTION - // - // ***A DOUBLE PRECISION ROUTINE*** - // ON KODE=1, CBESJ COMPUTES AN N MEMBER SEQUENCE OF COMPLEX - // BESSEL FUNCTIONS CY(I)=J(FNU+I-1,Z) FOR REAL, NONNEGATIVE - // ORDERS FNU+I-1, I=1,...,N AND COMPLEX Z IN THE CUT PLANE - // -PI.LT.ARG(Z).LE.PI. ON KODE=2, CBESJ RETURNS THE SCALED - // FUNCTIONS - // - // CY(I)=EXP(-ABS(Y))*J(FNU+I-1,Z) I = 1,...,N , Y=AIMAG(Z) - // - // WHICH REMOVE THE EXPONENTIAL GROWTH IN BOTH THE UPPER AND - // LOWER HALF PLANES FOR Z TO INFINITY. DEFINITIONS AND NOTATION - // ARE FOUND IN THE NBS HANDBOOK OF MATHEMATICAL FUNCTIONS - // (REF. 1). - // - // INPUT ZR,ZI,FNU ARE DOUBLE PRECISION - // ZR,ZI - Z=std::complex(ZR,ZI), -PI.LT.ARG(Z).LE.PI - // FNU - ORDER OF INITIAL J FUNCTION, FNU.GE.0.0D0 - // KODE - A PARAMETER TO INDICATE THE SCALING OPTION - // KODE= 1 RETURNS - // CY(I)=J(FNU+I-1,Z), I=1,...,N - // = 2 RETURNS - // CY(I)=J(FNU+I-1,Z)EXP(-ABS(Y)), I=1,...,N - // N - NUMBER OF MEMBERS OF THE SEQUENCE, N.GE.1 - // - // OUTPUT CYR,CYI ARE DOUBLE PRECISION - // CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS - // CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE - // CY(I)=J(FNU+I-1,Z) OR - // CY(I)=J(FNU+I-1,Z)EXP(-ABS(Y)) I=1,...,N - // DEPENDING ON KODE, Y=AIMAG(Z). - // NZ - NUMBER OF COMPONENTS SET TO ZERO DUE TO UNDERFLOW, - // NZ= 0 , NORMAL RETURN - // NZ.GT.0 , LAST NZ COMPONENTS OF CY SET ZERO DUE - // TO UNDERFLOW, CY(I)=std::complex(0.0D0,0.0D0), - // I = N-NZ+1,...,N - // IERR - ERROR FLAG - // IERR=0, NORMAL RETURN - COMPUTATION COMPLETED - // IERR=1, INPUT ERROR - NO COMPUTATION - // IERR=2, OVERFLOW - NO COMPUTATION, AIMAG(Z) - // TOO LARGE ON KODE=1 - // IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE - // BUT LOSSES OF SIGNIFCANCE BY ARGUMENT - // REDUCTION PRODUCE LESS THAN HALF OF MACHINE - // ACCURACY - // IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA- - // TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI- - // CANCE BY ARGUMENT REDUCTION - // IERR=5, ERROR - NO COMPUTATION, - // ALGORITHM TERMINATION CONDITION NOT MET - // - //***LONG DESCRIPTION - // - // THE COMPUTATION IS CARRIED OUT BY THE FORMULA - // - // J(FNU,Z)=EXP( FNU*PI*I/2)*I(FNU,-I*Z) AIMAG(Z).GE.0.0 - // - // J(FNU,Z)=EXP(-FNU*PI*I/2)*I(FNU, I*Z) AIMAG(Z).LT.0.0 - // - // WHERE I**2 = -1 AND I(FNU,Z) IS THE I BESSEL FUNCTION. - // - // FOR NEGATIVE ORDERS,THE FORMULA - // - // J(-FNU,Z) = J(FNU,Z)*COS(PI*FNU) - Y(FNU,Z)*SIN(PI*FNU) - // - // CAN BE USED. HOWEVER,FOR LARGE ORDERS CLOSE TO INTEGERS, THE - // THE FUNCTION CHANGES RADICALLY. WHEN FNU IS A LARGE POSITIVE - // INTEGER,THE MAGNITUDE OF J(-FNU,Z)=J(FNU,Z)*COS(PI*FNU) IS A - // LARGE NEGATIVE POWER OF TEN. BUT WHEN FNU IS NOT AN INTEGER, - // Y(FNU,Z) DOMINATES IN MAGNITUDE WITH A LARGE POSITIVE POWER OF - // TEN AND THE MOST THAT THE SECOND TERM CAN BE REDUCED IS BY - // UNIT ROUNDOFF FROM THE COEFFICIENT. THUS, WIDE CHANGES CAN - // OCCUR WITHIN UNIT ROUNDOFF OF A LARGE INTEGER FOR FNU. HERE, - // LARGE MEANS FNU.GT.CABS(Z). - // - // IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- - // MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS - // LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. - // CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN - // LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG - // IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS - // DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. - // IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS - // LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS - // MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE - // INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS - // RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3 - // ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION - // ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION - // ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN - // THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT - // TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS - // IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC. - // SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES. - // - // THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX - // BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT - // ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- - // SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE - // ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), - // ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF - // CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY - // HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN - // ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY - // SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER - // THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, - // 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS - // THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER - // COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY - // BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER - // COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE - // MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, - // THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, - // OR -PI/2+P. - // - //***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ - // AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF - // COMMERCE, 1955. - // - // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT - // BY D. E. AMOS, SAND83-0083, MAY, 1983. - // - // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT - // AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 - // - // A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX - // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- - // 1018, MAY, 1985 - // - // A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX - // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS. - // MATH. SOFTWARE, 1986 - // - //***ROUTINES CALLED ZBINU,I1MACH,D1MACH - //***END PROLOGUE ZBESJ - - std::complex ci, csgn, zn; - double aa, alim, arg, dig, elim, fnul, rl, r1, r1m5, r2, - tol, yy, az, fn, bb, ascle, rtol, atol; - int i, inu, inuh, ir, k1, k2, nl, nz, k; - double hpi = 1.570796326794896619; - - *ierr = 0; - nz = 0; - if (fnu < 0.0) *ierr = 1; - if (kode < 1 || kode > 2) *ierr = 1; - if (n < 1) *ierr = 1; - if (*ierr != 0) return nz; - // - // SET PARAMETERS RELATED TO MACHINE CONSTANTS. - // TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. - // ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. - // EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND - // EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR - // UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. - // RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. - // DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). - // FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU. - // - tol = fmax(d1mach[3], 1e-18); - k1 = i1mach[14]; - k2 = i1mach[15]; - r1m5 = d1mach[4]; - k = ( abs(k1) > abs(k2) ? abs(k2) : abs(k1) ); - elim = 2.303 * (k*r1m5 - 3.0); - k1 = i1mach[13] - 1; - aa = r1m5*k1; - dig = fmin(aa, 18.0); - aa *= 2.303; - alim = elim + fmax(-aa, -41.45); - fnul = 10.0 + 6.0 * (dig - 3.0); - rl = 1.2*dig + 3.0; - // - // TEST FOR PROPER RANGE - // - yy = std::imag(z); - az = std::abs(z); - fn = fnu + (n - 1); - - aa = 0.5 / tol; - bb = d1mach[1] * 0.5; - aa = fmin(aa, bb); - if ((az > aa) || (fn > aa)) { - *ierr = 4; - return 0; - } - aa = sqrt(aa); - if (az > aa) { *ierr = 3; } - if (fn > aa) { *ierr = 3; } - // - // CALCULATE CSGN = EXP(FNU*HPI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE - // WHEN FNU IS LARGE - // - ci.imag(1); - inu = (int)fnu; - inuh = inu / 2; - ir = inu - 2*inuh; - arg = (fnu - (inu - ir)) * hpi; - r1 = cos(arg); - r2 = sin(arg); - csgn = std::complex(r1, r2); - if (inuh % 2 == 1) { csgn = -csgn; } - // - // ZN IS IN THE RIGHT HALF PLANE - // - zn = -z * ci; - if (yy < 0.0) { - zn = -zn; - csgn = conj(csgn); - ci = conj(ci); - } - nz = binu(zn, fnu, kode, n, cy, rl, fnul, tol, elim, alim); - if (nz < 0) { - if (nz == -2) { *ierr = 5; return 0; } - *ierr = 2; - return 0; - } - nl = n - nz; - if (nl == 0) { return nz; } - rtol = 1.0 / tol; - ascle = d1mach[0]*rtol*1e3; - for (i = 1; i < (nl+1); i++) - { - zn = cy[i-1]; - aa = std::real(zn); - bb = std::imag(zn); - atol = 1.0; - if (fmax(fabs(aa), fabs(bb)) <= ascle) { - zn *= rtol; - atol = tol; + if (fn > aa) { + *ierr = 3; } - cy[i-1] = atol*(zn * csgn); - csgn = csgn * ci; - } - return nz; -} - - -inline int besk( - std::complex z, - double fnu, - int kode, - int n, - std::complex *cy, - int *ierr -) { - - //***BEGIN PROLOGUE ZBESK - //***DATE WRITTEN 830501 (YYMMDD) - //***REVISION DATE 890801 (YYMMDD) - //***CATEGORY NO. B5K - //***KEYWORDS K-BESSEL FUNCTION,COMPLEX BESSEL FUNCTION, - // MODIFIED BESSEL FUNCTION OF THE SECOND KIND, - // BESSEL FUNCTION OF THE THIRD KIND - //***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES - //***PURPOSE TO COMPUTE K-BESSEL FUNCTIONS OF COMPLEX ARGUMENT - //***DESCRIPTION - // - // ***A DOUBLE PRECISION ROUTINE*** - // - // ON KODE=1, CBESK COMPUTES AN N MEMBER SEQUENCE OF COMPLEX - // BESSEL FUNCTIONS CY(J)=K(FNU+J-1,Z) FOR REAL, NONNEGATIVE - // ORDERS FNU+J-1, J=1,...,N AND COMPLEX Z.NE.std::complex(0.0,0.0) - // IN THE CUT PLANE -PI.LT.ARG(Z).LE.PI. ON KODE=2, CBESK - // RETURNS THE SCALED K FUNCTIONS, - // - // CY(J)=EXP(Z)*K(FNU+J-1,Z) , J=1,...,N, - // - // WHICH REMOVE THE EXPONENTIAL BEHAVIOR IN BOTH THE LEFT AND - // RIGHT HALF PLANES FOR Z TO INFINITY. DEFINITIONS AND - // NOTATION ARE FOUND IN THE NBS HANDBOOK OF MATHEMATICAL - // FUNCTIONS (REF. 1). - // - // INPUT ZR,ZI,FNU ARE DOUBLE PRECISION - // ZR,ZI - Z=std::complex(ZR,ZI), Z.NE.std::complex(0.0D0,0.0D0), - // -PI.LT.ARG(Z).LE.PI - // FNU - ORDER OF INITIAL K FUNCTION, FNU.GE.0.0D0 - // N - NUMBER OF MEMBERS OF THE SEQUENCE, N.GE.1 - // KODE - A PARAMETER TO INDICATE THE SCALING OPTION - // KODE= 1 RETURNS - // CY(I)=K(FNU+I-1,Z), I=1,...,N - // = 2 RETURNS - // CY(I)=K(FNU+I-1,Z)*EXP(Z), I=1,...,N - // - // OUTPUT CYR,CYI ARE DOUBLE PRECISION - // CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS - // CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE - // CY(I)=K(FNU+I-1,Z), I=1,...,N OR - // CY(I)=K(FNU+I-1,Z)*EXP(Z), I=1,...,N - // DEPENDING ON KODE - // NZ - NUMBER OF COMPONENTS SET TO ZERO DUE TO UNDERFLOW. - // NZ= 0 , NORMAL RETURN - // NZ.GT.0 , FIRST NZ COMPONENTS OF CY SET TO ZERO DUE - // TO UNDERFLOW, CY(I)=std::complex(0.0D0,0.0D0), - // I=1,...,N WHEN X.GE.0.0. WHEN X.LT.0.0 - // NZ STATES ONLY THE NUMBER OF UNDERFLOWS - // IN THE SEQUENCE. - // - // IERR - ERROR FLAG - // IERR=0, NORMAL RETURN - COMPUTATION COMPLETED - // IERR=1, INPUT ERROR - NO COMPUTATION - // IERR=2, OVERFLOW - NO COMPUTATION, FNU IS - // TOO LARGE OR CABS(Z) IS TOO SMALL OR BOTH - // IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE - // BUT LOSSES OF SIGNIFCANCE BY ARGUMENT - // REDUCTION PRODUCE LESS THAN HALF OF MACHINE - // ACCURACY - // IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA- - // TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI- - // CANCE BY ARGUMENT REDUCTION - // IERR=5, ERROR - NO COMPUTATION, - // ALGORITHM TERMINATION CONDITION NOT MET - // - //***LONG DESCRIPTION - // - // EQUATIONS OF THE REFERENCE ARE IMPLEMENTED FOR SMALL ORDERS - // DNU AND DNU+1.0 IN THE RIGHT HALF PLANE X.GE.0.0. FORWARD - // RECURRENCE GENERATES HIGHER ORDERS. K IS CONTINUED TO THE LEFT - // HALF PLANE BY THE RELATION - // - // K(FNU,Z*EXP(MP)) = EXP(-MP*FNU)*K(FNU,Z)-MP*I(FNU,Z) - // MP=MR*PI*I, MR=+1 OR -1, RE(Z).GT.0, I**2=-1 - // - // WHERE I(FNU,Z) IS THE I BESSEL FUNCTION. - // - // FOR LARGE ORDERS, FNU.GT.FNUL, THE K FUNCTION IS COMPUTED - // BY MEANS OF ITS UNIFORM ASYMPTOTIC EXPANSIONS. - // - // FOR NEGATIVE ORDERS, THE FORMULA - // - // K(-FNU,Z) = K(FNU,Z) - // - // CAN BE USED. - // - // CBESK ASSUMES THAT A SIGNIFICANT DIGIT SINH(X) FUNCTION IS - // AVAILABLE. - // - // IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- - // MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS - // LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. - // CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN - // LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG - // IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS - // DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. - // IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS - // LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS - // MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE - // INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS - // RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3 - // ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION - // ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION - // ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN - // THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT - // TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS - // IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC. - // SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES. - // - // THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX - // BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT - // ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- - // SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE - // ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), - // ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF - // CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY - // HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN - // ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY - // SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER - // THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, - // 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS - // THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER - // COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY - // BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER - // COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE - // MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, - // THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, - // OR -PI/2+P. - // - //***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ - // AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF - // COMMERCE, 1955. - // - // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT - // BY D. E. AMOS, SAND83-0083, MAY, 1983. - // - // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT - // AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983. - // - // A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX - // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- - // 1018, MAY, 1985 - // - // A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX - // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS. - // MATH. SOFTWARE, 1986 - // - //***ROUTINES CALLED ZACON,ZBKNU,ZBUNK,ZUOIK,AZABS,I1MACH,D1MACH - //***END PROLOGUE ZBESK - - double xx = std::real(z); - double yy = std::imag(z); - double aa, alim, aln, arg, az, dig, elim, fn, fnul, rl, r1m5, tol, ufl, bb; - int k, k1, k2, mr, nn, nuf, nw, nz; - - *ierr = 0; - nz = 0; - - if ((yy == 0.0) && (xx == 0.0)) { *ierr = 1; } - if (fnu < 0.0) { *ierr = 1; } - if (kode < 1 || kode > 2) { *ierr = 1; } - if (n < 1) { *ierr = 1; } - if (*ierr != 0) { return nz; } - - nn = n; - // - // SET PARAMETERS RELATED TO MACHINE CONSTANTS. - // TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. - // ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. - // EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND - // EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR - // UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. - // RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. - // DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). - // FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU - // - tol = fmax(d1mach[3], 1e-18); - k1 = i1mach[14]; - k2 = i1mach[15]; - r1m5 = d1mach[4]; - k = ( abs(k1) > abs(k2) ? abs(k2) : abs(k1) ); - elim = 2.303 * (k*r1m5 - 3.0); - k1 = i1mach[13] - 1; - aa = r1m5*k1; - dig = fmin(aa, 18.0); - aa *= 2.303; - alim = elim + fmax(-aa, -41.45); - fnul = 10.0 + 6.0 * (dig - 3.0); - rl = 1.2 * dig + 3.0; - // - // TEST FOR PROPER RANGE - // - az = std::abs(z); - fn = fnu + (nn - 1); - aa = 0.5 / tol; - bb = i1mach[8] * 0.5; - aa = fmin(aa, bb); - if ((az > aa) || (fn > aa)) { - *ierr = 4; - return 0; - } - aa = sqrt(aa); - if (az > aa) { *ierr = 3; } - if (fn > aa) { *ierr = 3; } - // - // OVERFLOW TEST ON THE LAST MEMBER OF THE SEQUENCE - // - ufl = d1mach[0] * 1.0E+3; - if (az < ufl) { - *ierr = 2; - return 0; - } - if (fnu <= fnul) { - if (fn > 1.0) { - if (fn <= 2.0) { - if (az <= tol) { - arg = 0.5 * az; - aln = -fn * log(arg); - if (aln > elim) { *ierr = 2; return 0; } - } + // + // OVERFLOW TEST ON THE LAST MEMBER OF THE SEQUENCE + // + ufl = d1mach[0] * 1.0e3; + if (az < ufl) { + *ierr = 2; + return 0; + } /* GO TO 230 */ + if (fnu <= fnul) { + // + // Untangling GOTOs with explicit conditions + // + if ((fn > 1.0) && (fn <= 2.0) && (az <= tol)) { + /* Failed through all checks */ + arg = 0.5 * az; + aln = -fn * log(arg); + if (aln > elim) { + *ierr = 2; + return 0; + } /* GO TO 230 */ + /* GO TO 70 */ + } else if ((fn > 1.0) && (fn <= 2.0) && (az > tol)) { + /* Failed all but the az > tol hence do nothing and GO TO 70 */ + } else if ((fn > 1.0) && (fn > 2.0)) { /* GO TO 60 */ - } else { - nuf = uoik(z, fnu, kode, 2, nn, cy, tol, elim, alim); - if (nuf < 0) { *ierr = 2; return 0; } + nuf = uoik(zn, fnu, kode, 2, nn, cy, tol, elim, alim); + if (nuf < 0) { + *ierr = 2; + return 0; + } /* GO TO 230 */ nz += nuf; nn -= nuf; // @@ -2227,4019 +1424,5171 @@ inline int besk( // IF NUF=NN, THEN CY(I)=CZERO FOR ALL I // if (nn == 0) { - if (xx < 0.0) { *ierr = 2; return 0; } + /* GO TO 140 */ + if (xn < 0.0) { + *ierr = 2; + return 0; + } /* GO TO 230 */ return nz; } + /* GO TO 70 */ + } else { + /* Passed the first hence GO TO 70 */ } - } - /* 60 */ - if (xx >= 0.0) { + /* GO TO 70 */ + // + // More GOTOs untangling + // + if ((xn < 0.0) || ((xn == 0.0) && (yn < 0.0) && (m == 2))) { + /* GO TO 80 */ + mr = -mm; + nw = acon(zn, fnu, kode, mr, nn, cy, rl, fnul, tol, elim, alim); + if (nw < 0) { + /* GO TO 240 */ + if (nw == -1) { + *ierr = 2; + return 0; + } /* GO TO 230 */ + *ierr = 5; + return 0; + } + nz = nw; + /* GO TO 110 */ + } else { + // + // RIGHT HALF PLANE COMPUTATION, XN >= 0. .AND. (XN.NE.0. .OR. + // YN >= 0. .OR. M=1) + // + nz = bknu(zn, fnu, kode, nn, cy, tol, elim, alim); + /* GO TO 110 */ + } + } else { + /* GO TO 90 */ // - // RIGHT HALF PLANE COMPUTATION, REAL(Z) >= 0. + // UNIFORM ASYMPTOTIC EXPANSIONS FOR FNU > FNUL // - nw = bknu(z, fnu, kode, nn, cy, tol, elim, alim); + mr = 0; + if (!((xn >= 0.0) && ((xn != 0.0) || (yn >= 0.0) || (m != 2)))) { + mr = -mm; + if ((xn == 0.0) && (yn < 0.0)) { + zn = -zn; + } + } + /* GO TO 100 */ + nw = bunk(zn, fnu, kode, mr, nn, cy, tol, elim, alim); if (nw < 0) { + /* GO TO 240 */ if (nw == -1) { *ierr = 2; - } else { - *ierr = 5; - } + return 0; + } /* GO TO 230 */ + *ierr = 5; return 0; } - return nw; + nz += nw; } - /* 70 */ + /* 110 */ // - // LEFT HALF PLANE COMPUTATION - // PI/2 < ARG(Z) <= PI AND -PI < ARG(Z) < -PI/2. + // H(M,FNU,Z) = -FMM*(I/HPI)*(ZT**FNU)*K(FNU,-Z*ZT) + // ZT=EXP(-FMM*HPI*I) = std::complex(0.0,-FMM), FMM=3-2*M, M=1,2 // - if (nz != 0) { *ierr = 2; return 0; } - mr = 1; - if (yy < 0.0) { mr = -1; } - nw = acon(z, fnu, kode, mr, nn, cy, rl, fnul, tol, elim, alim); - if (nw < 0) { - if (nw == -1) { - *ierr = 2; + sgn = (-fmm < 0 ? -hpi : hpi); + // + // CALCULATE EXP(FNU*HPI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE + // WHEN FNU IS LARGE + // + inu = (int)fnu; + inuh = inu / 2; + ir = inu - 2 * inuh; + arg = (fnu - (inu - ir)) * sgn; + rhpi = 1.0 / sgn; + cpn = rhpi * cos(arg); + spn = -rhpi * sin(arg); + csgn = std::complex(spn, cpn); + if (inuh % 2 == 1) { + csgn = -csgn; + } + zt = std::complex(0.0, -fmm); + rtol = 1.0 / tol; + ascle = ufl * rtol; + for (i = 1; i < (nn + 1); i++) { + zn = cy[i - 1]; + atol = 1.0; + if (fmax(fabs(std::real(zn)), fabs(std::imag(zn))) <= ascle) { + zn *= rtol; + atol = tol; + } + zn *= csgn; + cy[i - 1] = zn * atol; + csgn *= zt; + } + return nz; + } + + inline int besi(std::complex z, double fnu, int kode, int n, std::complex *cy, int *ierr) { + + //***BEGIN PROLOGUE ZBESI + //***DATE WRITTEN 830501 (YYMMDD) + //***REVISION DATE 890801 (YYMMDD) + //***CATEGORY NO. B5K + //***KEYWORDS I-BESSEL FUNCTION,COMPLEX BESSEL FUNCTION, + // MODIFIED BESSEL FUNCTION OF THE FIRST KIND + //***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES + //***PURPOSE TO COMPUTE I-BESSEL FUNCTIONS OF COMPLEX ARGUMENT + //***DESCRIPTION + // + // ***A DOUBLE PRECISION ROUTINE*** + // ON KODE=1, ZBESI COMPUTES AN N MEMBER SEQUENCE OF COMPLEX + // BESSEL FUNCTIONS CY(J)=I(FNU+J-1,Z) FOR REAL, NONNEGATIVE + // ORDERS FNU+J-1, J=1,...,N AND COMPLEX Z IN THE CUT PLANE + // -PI.LT.ARG(Z).LE.PI. ON KODE=2, ZBESI RETURNS THE SCALED + // FUNCTIONS + // + // CY(J)=EXP(-ABS(X))*I(FNU+J-1,Z) J = 1,...,N , X=REAL(Z) + // + // WITH THE EXPONENTIAL GROWTH REMOVED IN BOTH THE LEFT AND + // RIGHT HALF PLANES FOR Z TO INFINITY. DEFINITIONS AND NOTATION + // ARE FOUND IN THE NBS HANDBOOK OF MATHEMATICAL FUNCTIONS + // (REF. 1). + // + // INPUT ZR,ZI,FNU ARE DOUBLE PRECISION + // ZR,ZI - Z=std::complex(ZR,ZI), -PI.LT.ARG(Z).LE.PI + // FNU - ORDER OF INITIAL I FUNCTION, FNU.GE.0.0D0 + // KODE - A PARAMETER TO INDICATE THE SCALING OPTION + // KODE= 1 RETURNS + // CY(J)=I(FNU+J-1,Z), J=1,...,N + // = 2 RETURNS + // CY(J)=I(FNU+J-1,Z)*EXP(-ABS(X)), J=1,...,N + // N - NUMBER OF MEMBERS OF THE SEQUENCE, N.GE.1 + // + // OUTPUT CYR,CYI ARE DOUBLE PRECISION + // CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS + // CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE + // CY(J)=I(FNU+J-1,Z) OR + // CY(J)=I(FNU+J-1,Z)*EXP(-ABS(X)) J=1,...,N + // DEPENDING ON KODE, X=REAL(Z) + // NZ - NUMBER OF COMPONENTS SET TO ZERO DUE TO UNDERFLOW, + // NZ= 0 , NORMAL RETURN + // NZ.GT.0 , LAST NZ COMPONENTS OF CY SET TO ZERO + // TO UNDERFLOW, CY(J)=std::complex(0.0D0,0.0D0) + // J = N-NZ+1,...,N + // IERR - ERROR FLAG + // IERR=0, NORMAL RETURN - COMPUTATION COMPLETED + // IERR=1, INPUT ERROR - NO COMPUTATION + // IERR=2, OVERFLOW - NO COMPUTATION, REAL(Z) TOO + // LARGE ON KODE=1 + // IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE + // BUT LOSSES OF SIGNIFCANCE BY ARGUMENT + // REDUCTION PRODUCE LESS THAN HALF OF MACHINE + // ACCURACY + // IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA- + // TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI- + // CANCE BY ARGUMENT REDUCTION + // IERR=5, ERROR - NO COMPUTATION, + // ALGORITHM TERMINATION CONDITION NOT MET + // + //***LONG DESCRIPTION + // + // THE COMPUTATION IS CARRIED OUT BY THE POWER SERIES FOR + // SMALL CABS(Z), THE ASYMPTOTIC EXPANSION FOR LARGE CABS(Z), + // THE MILLER ALGORITHM NORMALIZED BY THE WRONSKIAN AND A + // NEUMANN SERIES FOR IMTERMEDIATE MAGNITUDES, AND THE + // UNIFORM ASYMPTOTIC EXPANSIONS FOR I(FNU,Z) AND J(FNU,Z) + // FOR LARGE ORDERS. BACKWARD RECURRENCE IS USED TO GENERATE + // SEQUENCES OR REDUCE ORDERS WHEN NECESSARY. + // + // THE CALCULATIONS ABOVE ARE DONE IN THE RIGHT HALF PLANE AND + // CONTINUED INTO THE LEFT HALF PLANE BY THE FORMULA + // + // I(FNU,Z*EXP(M*PI)) = EXP(M*PI*FNU)*I(FNU,Z) REAL(Z).GT.0.0 + // M = +I OR -I, I**2=-1 + // + // FOR NEGATIVE ORDERS,THE FORMULA + // + // I(-FNU,Z) = I(FNU,Z) + (2/PI)*SIN(PI*FNU)*K(FNU,Z) + // + // CAN BE USED. HOWEVER,FOR LARGE ORDERS CLOSE TO INTEGERS, THE + // THE FUNCTION CHANGES RADICALLY. WHEN FNU IS A LARGE POSITIVE + // INTEGER,THE MAGNITUDE OF I(-FNU,Z)=I(FNU,Z) IS A LARGE + // NEGATIVE POWER OF TEN. BUT WHEN FNU IS NOT AN INTEGER, + // K(FNU,Z) DOMINATES IN MAGNITUDE WITH A LARGE POSITIVE POWER OF + // TEN AND THE MOST THAT THE SECOND TERM CAN BE REDUCED IS BY + // UNIT ROUNDOFF FROM THE COEFFICIENT. THUS, WIDE CHANGES CAN + // OCCUR WITHIN UNIT ROUNDOFF OF A LARGE INTEGER FOR FNU. HERE, + // LARGE MEANS FNU.GT.CABS(Z). + // + // IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- + // MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS + // LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. + // CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN + // LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG + // IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS + // DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. + // IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS + // LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS + // MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE + // INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS + // RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3 + // ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION + // ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION + // ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN + // THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT + // TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS + // IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC. + // SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES. + // + // THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX + // BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT + // ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- + // SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE + // ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), + // ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF + // CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY + // HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN + // ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY + // SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER + // THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, + // 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS + // THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER + // COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY + // BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER + // COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE + // MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, + // THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, + // OR -PI/2+P. + // + //***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ + // AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF + // COMMERCE, 1955. + // + // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT + // BY D. E. AMOS, SAND83-0083, MAY, 1983. + // + // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT + // AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 + // + // A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX + // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- + // 1018, MAY, 1985 + // + // A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX + // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS. + // MATH. SOFTWARE, 1986 + // + //***ROUTINES CALLED ZBINU,I1MACH,D1MACH + //***END PROLOGUE ZBESI + + std::complex csgn, zn; + double aa, alim, arg, atol, ascle, az, bb, dig, elim, fn, fnul, rl, rtol, r1m5, tol, xx, yy; + int i, inu, k, k1, k2, nn, nz; + double pi = 3.14159265358979324; + + *ierr = 0; + nz = 0; + if (fnu < 0.0) { + *ierr = 1; + } + if ((kode < 1) || (kode > 2)) { + *ierr = 1; + } + if (n < 1) { + *ierr = 1; + } + if (*ierr != 0) { + return nz; + } + xx = std::real(z); + yy = std::imag(z); + // + // SET PARAMETERS RELATED TO MACHINE CONSTANTS. + // TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. + // ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. + // EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND + // EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR + // UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. + // RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. + // DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). + // FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU + // + tol = fmax(d1mach[3], 1e-18); + k1 = i1mach[14]; + k2 = i1mach[15]; + r1m5 = d1mach[4]; + k = (abs(k1) > abs(k2) ? abs(k2) : abs(k1)); + elim = 2.303 * (k * r1m5 - 3.0); + k1 = i1mach[13] - 1; + aa = r1m5 * k1; + dig = fmin(aa, 18.0); + aa *= 2.303; + alim = elim + fmax(-aa, -41.45); + rl = 1.2 * dig + 3.0; + fnul = 10.0 + 6.0 * (dig - 3.0); + // + // TEST FOR PROPER RANGE + // + az = std::abs(z); + fn = fnu + (n - 1); + aa = 0.5 / tol; + bb = i1mach[8] * 0.5; + aa = fmin(aa, bb); + if ((az > aa) || (fn > aa)) { + *ierr = 4; + return 0; + } + aa = sqrt(aa); + if (az > aa) { + *ierr = 3; + } + if (fn > aa) { + *ierr = 3; + } + zn = z; + csgn = 1.0; + if (xx < 0.0) { + zn = -z; + // + // CALCULATE CSGN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE + // WHEN FNU IS LARGE + // + inu = (int)fnu; + arg = (fnu - inu) * pi; + if (yy < 0.0) { + arg = -arg; + } + csgn = std::complex(cos(arg), sin(arg)); + if (inu % 2 == 1) { + csgn = -csgn; + } + } + /* 40 */ + nz = binu(zn, fnu, kode, n, cy, rl, fnul, tol, elim, alim); + if (nz < 0) { + if (nz == -2) { + *ierr = 5; + return 0; + } + *ierr = 2; + return 0; + } + if (xx > 0.0) { + return nz; + } + // + // ANALYTIC CONTINUATION TO THE LEFT HALF PLANE + // + nn = n - nz; + if (nn == 0) { + return nz; + } + rtol = 1.0 / tol; + ascle = d1mach[0] * rtol * 1e3; + for (i = 1; i < (nn + 1); i++) { + zn = cy[i - 1]; + atol = 1.0; + if (fmax(fabs(std::real(zn)), fabs(std::imag(zn))) <= ascle) { + zn *= rtol; + atol = tol; + } + cy[i - 1] = atol * (zn * csgn); + csgn = -csgn; + } + *ierr = 0; + return nz; + } + + inline int besj(std::complex z, double fnu, int kode, int n, std::complex *cy, int *ierr) { + + //***BEGIN PROLOGUE ZBESJ + //***DATE WRITTEN 830501 (YYMMDD) + //***REVISION DATE 890801 (YYMMDD) + //***CATEGORY NO. B5K + //***KEYWORDS J-BESSEL FUNCTION,BESSEL FUNCTION OF COMPLEX ARGUMENT, + // BESSEL FUNCTION OF FIRST KIND + //***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES + //***PURPOSE TO COMPUTE THE J-BESSEL FUNCTION OF A COMPLEX ARGUMENT + //***DESCRIPTION + // + // ***A DOUBLE PRECISION ROUTINE*** + // ON KODE=1, CBESJ COMPUTES AN N MEMBER SEQUENCE OF COMPLEX + // BESSEL FUNCTIONS CY(I)=J(FNU+I-1,Z) FOR REAL, NONNEGATIVE + // ORDERS FNU+I-1, I=1,...,N AND COMPLEX Z IN THE CUT PLANE + // -PI.LT.ARG(Z).LE.PI. ON KODE=2, CBESJ RETURNS THE SCALED + // FUNCTIONS + // + // CY(I)=EXP(-ABS(Y))*J(FNU+I-1,Z) I = 1,...,N , Y=AIMAG(Z) + // + // WHICH REMOVE THE EXPONENTIAL GROWTH IN BOTH THE UPPER AND + // LOWER HALF PLANES FOR Z TO INFINITY. DEFINITIONS AND NOTATION + // ARE FOUND IN THE NBS HANDBOOK OF MATHEMATICAL FUNCTIONS + // (REF. 1). + // + // INPUT ZR,ZI,FNU ARE DOUBLE PRECISION + // ZR,ZI - Z=std::complex(ZR,ZI), -PI.LT.ARG(Z).LE.PI + // FNU - ORDER OF INITIAL J FUNCTION, FNU.GE.0.0D0 + // KODE - A PARAMETER TO INDICATE THE SCALING OPTION + // KODE= 1 RETURNS + // CY(I)=J(FNU+I-1,Z), I=1,...,N + // = 2 RETURNS + // CY(I)=J(FNU+I-1,Z)EXP(-ABS(Y)), I=1,...,N + // N - NUMBER OF MEMBERS OF THE SEQUENCE, N.GE.1 + // + // OUTPUT CYR,CYI ARE DOUBLE PRECISION + // CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS + // CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE + // CY(I)=J(FNU+I-1,Z) OR + // CY(I)=J(FNU+I-1,Z)EXP(-ABS(Y)) I=1,...,N + // DEPENDING ON KODE, Y=AIMAG(Z). + // NZ - NUMBER OF COMPONENTS SET TO ZERO DUE TO UNDERFLOW, + // NZ= 0 , NORMAL RETURN + // NZ.GT.0 , LAST NZ COMPONENTS OF CY SET ZERO DUE + // TO UNDERFLOW, CY(I)=std::complex(0.0D0,0.0D0), + // I = N-NZ+1,...,N + // IERR - ERROR FLAG + // IERR=0, NORMAL RETURN - COMPUTATION COMPLETED + // IERR=1, INPUT ERROR - NO COMPUTATION + // IERR=2, OVERFLOW - NO COMPUTATION, AIMAG(Z) + // TOO LARGE ON KODE=1 + // IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE + // BUT LOSSES OF SIGNIFCANCE BY ARGUMENT + // REDUCTION PRODUCE LESS THAN HALF OF MACHINE + // ACCURACY + // IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA- + // TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI- + // CANCE BY ARGUMENT REDUCTION + // IERR=5, ERROR - NO COMPUTATION, + // ALGORITHM TERMINATION CONDITION NOT MET + // + //***LONG DESCRIPTION + // + // THE COMPUTATION IS CARRIED OUT BY THE FORMULA + // + // J(FNU,Z)=EXP( FNU*PI*I/2)*I(FNU,-I*Z) AIMAG(Z).GE.0.0 + // + // J(FNU,Z)=EXP(-FNU*PI*I/2)*I(FNU, I*Z) AIMAG(Z).LT.0.0 + // + // WHERE I**2 = -1 AND I(FNU,Z) IS THE I BESSEL FUNCTION. + // + // FOR NEGATIVE ORDERS,THE FORMULA + // + // J(-FNU,Z) = J(FNU,Z)*COS(PI*FNU) - Y(FNU,Z)*SIN(PI*FNU) + // + // CAN BE USED. HOWEVER,FOR LARGE ORDERS CLOSE TO INTEGERS, THE + // THE FUNCTION CHANGES RADICALLY. WHEN FNU IS A LARGE POSITIVE + // INTEGER,THE MAGNITUDE OF J(-FNU,Z)=J(FNU,Z)*COS(PI*FNU) IS A + // LARGE NEGATIVE POWER OF TEN. BUT WHEN FNU IS NOT AN INTEGER, + // Y(FNU,Z) DOMINATES IN MAGNITUDE WITH A LARGE POSITIVE POWER OF + // TEN AND THE MOST THAT THE SECOND TERM CAN BE REDUCED IS BY + // UNIT ROUNDOFF FROM THE COEFFICIENT. THUS, WIDE CHANGES CAN + // OCCUR WITHIN UNIT ROUNDOFF OF A LARGE INTEGER FOR FNU. HERE, + // LARGE MEANS FNU.GT.CABS(Z). + // + // IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- + // MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS + // LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. + // CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN + // LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG + // IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS + // DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. + // IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS + // LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS + // MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE + // INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS + // RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3 + // ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION + // ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION + // ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN + // THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT + // TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS + // IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC. + // SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES. + // + // THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX + // BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT + // ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- + // SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE + // ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), + // ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF + // CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY + // HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN + // ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY + // SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER + // THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, + // 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS + // THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER + // COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY + // BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER + // COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE + // MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, + // THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, + // OR -PI/2+P. + // + //***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ + // AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF + // COMMERCE, 1955. + // + // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT + // BY D. E. AMOS, SAND83-0083, MAY, 1983. + // + // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT + // AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 + // + // A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX + // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- + // 1018, MAY, 1985 + // + // A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX + // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS. + // MATH. SOFTWARE, 1986 + // + //***ROUTINES CALLED ZBINU,I1MACH,D1MACH + //***END PROLOGUE ZBESJ + + std::complex ci, csgn, zn; + double aa, alim, arg, dig, elim, fnul, rl, r1, r1m5, r2, tol, yy, az, fn, bb, ascle, rtol, atol; + int i, inu, inuh, ir, k1, k2, nl, nz, k; + double hpi = 1.570796326794896619; + + *ierr = 0; + nz = 0; + if (fnu < 0.0) + *ierr = 1; + if (kode < 1 || kode > 2) + *ierr = 1; + if (n < 1) + *ierr = 1; + if (*ierr != 0) + return nz; + // + // SET PARAMETERS RELATED TO MACHINE CONSTANTS. + // TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. + // ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. + // EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND + // EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR + // UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. + // RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. + // DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). + // FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU. + // + tol = fmax(d1mach[3], 1e-18); + k1 = i1mach[14]; + k2 = i1mach[15]; + r1m5 = d1mach[4]; + k = (abs(k1) > abs(k2) ? abs(k2) : abs(k1)); + elim = 2.303 * (k * r1m5 - 3.0); + k1 = i1mach[13] - 1; + aa = r1m5 * k1; + dig = fmin(aa, 18.0); + aa *= 2.303; + alim = elim + fmax(-aa, -41.45); + fnul = 10.0 + 6.0 * (dig - 3.0); + rl = 1.2 * dig + 3.0; + // + // TEST FOR PROPER RANGE + // + yy = std::imag(z); + az = std::abs(z); + fn = fnu + (n - 1); + + aa = 0.5 / tol; + bb = d1mach[1] * 0.5; + aa = fmin(aa, bb); + if ((az > aa) || (fn > aa)) { + *ierr = 4; + return 0; + } + aa = sqrt(aa); + if (az > aa) { + *ierr = 3; + } + if (fn > aa) { + *ierr = 3; + } + // + // CALCULATE CSGN = EXP(FNU*HPI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE + // WHEN FNU IS LARGE + // + ci.imag(1); + inu = (int)fnu; + inuh = inu / 2; + ir = inu - 2 * inuh; + arg = (fnu - (inu - ir)) * hpi; + r1 = cos(arg); + r2 = sin(arg); + csgn = std::complex(r1, r2); + if (inuh % 2 == 1) { + csgn = -csgn; + } + // + // ZN IS IN THE RIGHT HALF PLANE + // + zn = -z * ci; + if (yy < 0.0) { + zn = -zn; + csgn = conj(csgn); + ci = conj(ci); + } + nz = binu(zn, fnu, kode, n, cy, rl, fnul, tol, elim, alim); + if (nz < 0) { + if (nz == -2) { + *ierr = 5; + return 0; + } + *ierr = 2; + return 0; + } + nl = n - nz; + if (nl == 0) { + return nz; + } + rtol = 1.0 / tol; + ascle = d1mach[0] * rtol * 1e3; + for (i = 1; i < (nl + 1); i++) { + zn = cy[i - 1]; + aa = std::real(zn); + bb = std::imag(zn); + atol = 1.0; + if (fmax(fabs(aa), fabs(bb)) <= ascle) { + zn *= rtol; + atol = tol; + } + cy[i - 1] = atol * (zn * csgn); + csgn = csgn * ci; + } + return nz; + } + + inline int besk(std::complex z, double fnu, int kode, int n, std::complex *cy, int *ierr) { + + //***BEGIN PROLOGUE ZBESK + //***DATE WRITTEN 830501 (YYMMDD) + //***REVISION DATE 890801 (YYMMDD) + //***CATEGORY NO. B5K + //***KEYWORDS K-BESSEL FUNCTION,COMPLEX BESSEL FUNCTION, + // MODIFIED BESSEL FUNCTION OF THE SECOND KIND, + // BESSEL FUNCTION OF THE THIRD KIND + //***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES + //***PURPOSE TO COMPUTE K-BESSEL FUNCTIONS OF COMPLEX ARGUMENT + //***DESCRIPTION + // + // ***A DOUBLE PRECISION ROUTINE*** + // + // ON KODE=1, CBESK COMPUTES AN N MEMBER SEQUENCE OF COMPLEX + // BESSEL FUNCTIONS CY(J)=K(FNU+J-1,Z) FOR REAL, NONNEGATIVE + // ORDERS FNU+J-1, J=1,...,N AND COMPLEX Z.NE.std::complex(0.0,0.0) + // IN THE CUT PLANE -PI.LT.ARG(Z).LE.PI. ON KODE=2, CBESK + // RETURNS THE SCALED K FUNCTIONS, + // + // CY(J)=EXP(Z)*K(FNU+J-1,Z) , J=1,...,N, + // + // WHICH REMOVE THE EXPONENTIAL BEHAVIOR IN BOTH THE LEFT AND + // RIGHT HALF PLANES FOR Z TO INFINITY. DEFINITIONS AND + // NOTATION ARE FOUND IN THE NBS HANDBOOK OF MATHEMATICAL + // FUNCTIONS (REF. 1). + // + // INPUT ZR,ZI,FNU ARE DOUBLE PRECISION + // ZR,ZI - Z=std::complex(ZR,ZI), Z.NE.std::complex(0.0D0,0.0D0), + // -PI.LT.ARG(Z).LE.PI + // FNU - ORDER OF INITIAL K FUNCTION, FNU.GE.0.0D0 + // N - NUMBER OF MEMBERS OF THE SEQUENCE, N.GE.1 + // KODE - A PARAMETER TO INDICATE THE SCALING OPTION + // KODE= 1 RETURNS + // CY(I)=K(FNU+I-1,Z), I=1,...,N + // = 2 RETURNS + // CY(I)=K(FNU+I-1,Z)*EXP(Z), I=1,...,N + // + // OUTPUT CYR,CYI ARE DOUBLE PRECISION + // CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS + // CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE + // CY(I)=K(FNU+I-1,Z), I=1,...,N OR + // CY(I)=K(FNU+I-1,Z)*EXP(Z), I=1,...,N + // DEPENDING ON KODE + // NZ - NUMBER OF COMPONENTS SET TO ZERO DUE TO UNDERFLOW. + // NZ= 0 , NORMAL RETURN + // NZ.GT.0 , FIRST NZ COMPONENTS OF CY SET TO ZERO DUE + // TO UNDERFLOW, CY(I)=std::complex(0.0D0,0.0D0), + // I=1,...,N WHEN X.GE.0.0. WHEN X.LT.0.0 + // NZ STATES ONLY THE NUMBER OF UNDERFLOWS + // IN THE SEQUENCE. + // + // IERR - ERROR FLAG + // IERR=0, NORMAL RETURN - COMPUTATION COMPLETED + // IERR=1, INPUT ERROR - NO COMPUTATION + // IERR=2, OVERFLOW - NO COMPUTATION, FNU IS + // TOO LARGE OR CABS(Z) IS TOO SMALL OR BOTH + // IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE + // BUT LOSSES OF SIGNIFCANCE BY ARGUMENT + // REDUCTION PRODUCE LESS THAN HALF OF MACHINE + // ACCURACY + // IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA- + // TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI- + // CANCE BY ARGUMENT REDUCTION + // IERR=5, ERROR - NO COMPUTATION, + // ALGORITHM TERMINATION CONDITION NOT MET + // + //***LONG DESCRIPTION + // + // EQUATIONS OF THE REFERENCE ARE IMPLEMENTED FOR SMALL ORDERS + // DNU AND DNU+1.0 IN THE RIGHT HALF PLANE X.GE.0.0. FORWARD + // RECURRENCE GENERATES HIGHER ORDERS. K IS CONTINUED TO THE LEFT + // HALF PLANE BY THE RELATION + // + // K(FNU,Z*EXP(MP)) = EXP(-MP*FNU)*K(FNU,Z)-MP*I(FNU,Z) + // MP=MR*PI*I, MR=+1 OR -1, RE(Z).GT.0, I**2=-1 + // + // WHERE I(FNU,Z) IS THE I BESSEL FUNCTION. + // + // FOR LARGE ORDERS, FNU.GT.FNUL, THE K FUNCTION IS COMPUTED + // BY MEANS OF ITS UNIFORM ASYMPTOTIC EXPANSIONS. + // + // FOR NEGATIVE ORDERS, THE FORMULA + // + // K(-FNU,Z) = K(FNU,Z) + // + // CAN BE USED. + // + // CBESK ASSUMES THAT A SIGNIFICANT DIGIT SINH(X) FUNCTION IS + // AVAILABLE. + // + // IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- + // MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS + // LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. + // CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN + // LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG + // IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS + // DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. + // IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS + // LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS + // MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE + // INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS + // RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3 + // ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION + // ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION + // ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN + // THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT + // TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS + // IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC. + // SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES. + // + // THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX + // BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT + // ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- + // SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE + // ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), + // ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF + // CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY + // HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN + // ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY + // SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER + // THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, + // 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS + // THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER + // COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY + // BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER + // COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE + // MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, + // THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, + // OR -PI/2+P. + // + //***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ + // AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF + // COMMERCE, 1955. + // + // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT + // BY D. E. AMOS, SAND83-0083, MAY, 1983. + // + // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT + // AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983. + // + // A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX + // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- + // 1018, MAY, 1985 + // + // A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX + // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS. + // MATH. SOFTWARE, 1986 + // + //***ROUTINES CALLED ZACON,ZBKNU,ZBUNK,ZUOIK,AZABS,I1MACH,D1MACH + //***END PROLOGUE ZBESK + + double xx = std::real(z); + double yy = std::imag(z); + double aa, alim, aln, arg, az, dig, elim, fn, fnul, rl, r1m5, tol, ufl, bb; + int k, k1, k2, mr, nn, nuf, nw, nz; + + *ierr = 0; + nz = 0; + + if ((yy == 0.0) && (xx == 0.0)) { + *ierr = 1; + } + if (fnu < 0.0) { + *ierr = 1; + } + if (kode < 1 || kode > 2) { + *ierr = 1; + } + if (n < 1) { + *ierr = 1; + } + if (*ierr != 0) { + return nz; + } + + nn = n; + // + // SET PARAMETERS RELATED TO MACHINE CONSTANTS. + // TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. + // ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. + // EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND + // EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR + // UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. + // RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. + // DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). + // FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU + // + tol = fmax(d1mach[3], 1e-18); + k1 = i1mach[14]; + k2 = i1mach[15]; + r1m5 = d1mach[4]; + k = (abs(k1) > abs(k2) ? abs(k2) : abs(k1)); + elim = 2.303 * (k * r1m5 - 3.0); + k1 = i1mach[13] - 1; + aa = r1m5 * k1; + dig = fmin(aa, 18.0); + aa *= 2.303; + alim = elim + fmax(-aa, -41.45); + fnul = 10.0 + 6.0 * (dig - 3.0); + rl = 1.2 * dig + 3.0; + // + // TEST FOR PROPER RANGE + // + az = std::abs(z); + fn = fnu + (nn - 1); + aa = 0.5 / tol; + bb = i1mach[8] * 0.5; + aa = fmin(aa, bb); + if ((az > aa) || (fn > aa)) { + *ierr = 4; + return 0; + } + aa = sqrt(aa); + if (az > aa) { + *ierr = 3; + } + if (fn > aa) { + *ierr = 3; + } + // + // OVERFLOW TEST ON THE LAST MEMBER OF THE SEQUENCE + // + ufl = d1mach[0] * 1.0E+3; + if (az < ufl) { + *ierr = 2; + return 0; + } + if (fnu <= fnul) { + if (fn > 1.0) { + if (fn <= 2.0) { + if (az <= tol) { + arg = 0.5 * az; + aln = -fn * log(arg); + if (aln > elim) { + *ierr = 2; + return 0; + } + } + /* GO TO 60 */ + } else { + nuf = uoik(z, fnu, kode, 2, nn, cy, tol, elim, alim); + if (nuf < 0) { + *ierr = 2; + return 0; + } + nz += nuf; + nn -= nuf; + // + // HERE NN=N OR NN=0 SINCE NUF=0,NN, OR -1 ON RETURN FROM CUOIK + // IF NUF=NN, THEN CY(I)=CZERO FOR ALL I + // + if (nn == 0) { + if (xx < 0.0) { + *ierr = 2; + return 0; + } + return nz; + } + } + } + + /* 60 */ + if (xx >= 0.0) { + // + // RIGHT HALF PLANE COMPUTATION, REAL(Z) >= 0. + // + nw = bknu(z, fnu, kode, nn, cy, tol, elim, alim); + if (nw < 0) { + if (nw == -1) { + *ierr = 2; + } else { + *ierr = 5; + } + return 0; + } + return nw; + } + /* 70 */ + // + // LEFT HALF PLANE COMPUTATION + // PI/2 < ARG(Z) <= PI AND -PI < ARG(Z) < -PI/2. + // + if (nz != 0) { + *ierr = 2; + return 0; + } + mr = 1; + if (yy < 0.0) { + mr = -1; + } + nw = acon(z, fnu, kode, mr, nn, cy, rl, fnul, tol, elim, alim); + if (nw < 0) { + if (nw == -1) { + *ierr = 2; + } else { + *ierr = 5; + } + return 0; + } + return nw; + } + + /* 80 */ + // + // UNIFORM ASYMPTOTIC EXPANSIONS FOR FNU > FNUL + // + mr = 0; + if (xx < 0.0) { + mr = 1; + if (yy < 0.0) { + mr = -1; + } + } + nw = bunk(z, fnu, kode, mr, nn, cy, tol, elim, alim); + if (nw < 0) { + if (nw == -1) { + *ierr = 2; + } else { + *ierr = 5; + } + return 0; + } + nz += nw; + return nz; + } + + inline int besy(std::complex z, double fnu, int kode, int n, std::complex *cy, int *ierr) { + + //***BEGIN PROLOGUE ZBESY + //***DATE WRITTEN 830501 (YYMMDD) + //***REVISION DATE 890801 (YYMMDD) + //***CATEGORY NO. B5K + //***KEYWORDS Y-BESSEL FUNCTION,BESSEL FUNCTION OF COMPLEX ARGUMENT, + // BESSEL FUNCTION OF SECOND KIND + //***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES + //***PURPOSE TO COMPUTE THE Y-BESSEL FUNCTION OF A COMPLEX ARGUMENT + //***DESCRIPTION + // + // ***A DOUBLE PRECISION ROUTINE*** + // + // ON KODE=1, CBESY COMPUTES AN N MEMBER SEQUENCE OF COMPLEX + // BESSEL FUNCTIONS CY(I)=Y(FNU+I-1,Z) FOR REAL, NONNEGATIVE + // ORDERS FNU+I-1, I=1,...,N AND COMPLEX Z IN THE CUT PLANE + // -PI.LT.ARG(Z).LE.PI. ON KODE=2, CBESY RETURNS THE SCALED + // FUNCTIONS + // + // CY(I)=EXP(-ABS(Y))*Y(FNU+I-1,Z) I = 1,...,N , Y=AIMAG(Z) + // + // WHICH REMOVE THE EXPONENTIAL GROWTH IN BOTH THE UPPER AND + // LOWER HALF PLANES FOR Z TO INFINITY. DEFINITIONS AND NOTATION + // ARE FOUND IN THE NBS HANDBOOK OF MATHEMATICAL FUNCTIONS + // (REF. 1). + // + // INPUT ZR,ZI,FNU ARE DOUBLE PRECISION + // ZR,ZI - Z=std::complex(ZR,ZI), Z.NE.std::complex(0.0D0,0.0D0), + // -PI.LT.ARG(Z).LE.PI + // FNU - ORDER OF INITIAL Y FUNCTION, FNU.GE.0.0D0 + // KODE - A PARAMETER TO INDICATE THE SCALING OPTION + // KODE= 1 RETURNS + // CY(I)=Y(FNU+I-1,Z), I=1,...,N + // = 2 RETURNS + // CY(I)=Y(FNU+I-1,Z)*EXP(-ABS(Y)), I=1,...,N + // WHERE Y=AIMAG(Z) + // N - NUMBER OF MEMBERS OF THE SEQUENCE, N.GE.1 + // CWRKR, - DOUBLE PRECISION WORK VECTORS OF DIMENSION AT + // CWRKI AT LEAST N + // + // OUTPUT CYR,CYI ARE DOUBLE PRECISION + // CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS + // CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE + // CY(I)=Y(FNU+I-1,Z) OR + // CY(I)=Y(FNU+I-1,Z)*EXP(-ABS(Y)) I=1,...,N + // DEPENDING ON KODE. + // NZ - NZ=0 , A NORMAL RETURN + // NZ.GT.0 , NZ COMPONENTS OF CY SET TO ZERO DUE TO + // UNDERFLOW (GENERALLY ON KODE=2) + // IERR - ERROR FLAG + // IERR=0, NORMAL RETURN - COMPUTATION COMPLETED + // IERR=1, INPUT ERROR - NO COMPUTATION + // IERR=2, OVERFLOW - NO COMPUTATION, FNU IS + // TOO LARGE OR CABS(Z) IS TOO SMALL OR BOTH + // IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE + // BUT LOSSES OF SIGNIFCANCE BY ARGUMENT + // REDUCTION PRODUCE LESS THAN HALF OF MACHINE + // ACCURACY + // IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA- + // TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI- + // CANCE BY ARGUMENT REDUCTION + // IERR=5, ERROR - NO COMPUTATION, + // ALGORITHM TERMINATION CONDITION NOT MET + // IERR=6, Memory allocation failed. + // + //***LONG DESCRIPTION + // + // THE COMPUTATION IS CARRIED OUT BY THE FORMULA + // + // Y(FNU,Z)=0.5*(H(1,FNU,Z)-H(2,FNU,Z))/I + // + // WHERE I**2 = -1 AND THE HANKEL BESSEL FUNCTIONS H(1,FNU,Z) + // AND H(2,FNU,Z) ARE CALCULATED IN CBESH. + // + // FOR NEGATIVE ORDERS,THE FORMULA + // + // Y(-FNU,Z) = Y(FNU,Z)*COS(PI*FNU) + J(FNU,Z)*SIN(PI*FNU) + // + // CAN BE USED. HOWEVER,FOR LARGE ORDERS CLOSE TO HALF ODD + // INTEGERS THE FUNCTION CHANGES RADICALLY. WHEN FNU IS A LARGE + // POSITIVE HALF ODD INTEGER,THE MAGNITUDE OF Y(-FNU,Z)=J(FNU,Z)* + // SIN(PI*FNU) IS A LARGE NEGATIVE POWER OF TEN. BUT WHEN FNU IS + // NOT A HALF ODD INTEGER, Y(FNU,Z) DOMINATES IN MAGNITUDE WITH A + // LARGE POSITIVE POWER OF TEN AND THE MOST THAT THE SECOND TERM + // CAN BE REDUCED IS BY UNIT ROUNDOFF FROM THE COEFFICIENT. THUS, + // WIDE CHANGES CAN OCCUR WITHIN UNIT ROUNDOFF OF A LARGE HALF + // ODD INTEGER. HERE, LARGE MEANS FNU.GT.CABS(Z). + // + // IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- + // MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS + // LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. + // CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN + // LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG + // IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS + // DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. + // IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS + // LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS + // MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE + // INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS + // RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3 + // ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION + // ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION + // ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN + // THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT + // TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS + // IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC. + // SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES. + // + // THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX + // BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT + // ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- + // SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE + // ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), + // ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF + // CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY + // HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN + // ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY + // SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER + // THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, + // 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS + // THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER + // COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY + // BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER + // COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE + // MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, + // THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, + // OR -PI/2+P. + // + //***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ + // AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF + // COMMERCE, 1955. + // + // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT + // BY D. E. AMOS, SAND83-0083, MAY, 1983. + // + // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT + // AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 + // + // A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX + // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- + // 1018, MAY, 1985 + // + // A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX + // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS. + // MATH. SOFTWARE, 1986 + // + //***ROUTINES CALLED ZBESH,I1MACH,D1MACH + //***END PROLOGUE ZBESY + + std::complex c1, c2, hci, st; + double elim, exr, exi, ey, tay, xx, yy, ascle, rtol, atol, tol, aa, bb, r1m5; + int i, k, k1, k2, nz, nz1, nz2; + + xx = std::real(z); + yy = std::imag(z); + *ierr = 0; + nz = 0; + + if ((xx == 0.0) && (yy == 0.0)) { + *ierr = 1; + } + if (fnu < 0.0) { + *ierr = 1; + } + if ((kode < 1) || (kode > 2)) { + *ierr = 1; + } + if (n < 1) { + *ierr = 1; + } + if (*ierr != 0) { + return nz; + } + + hci = std::complex(0.0, 0.5); + nz1 = besh(z, fnu, kode, 1, n, cy, ierr); + if ((*ierr != 0) && (*ierr != 3)) { + return 0; + } + + auto cwrk = std::unique_ptr[]>{new (std::nothrow) std::complex[n]}; + if (cwrk == nullptr) { + *ierr = 6; // Memory allocation failed. + return 0; + } + + nz2 = besh(z, fnu, kode, 2, n, cwrk.get(), ierr); + if ((*ierr != 0) && (*ierr != 3)) { + return 0; + } + + nz = (nz1 > nz2 ? nz2 : nz1); + if (kode != 2) { + for (i = 1; i < (n + 1); i++) { + cy[i - 1] = hci * (cwrk[i - 1] - cy[i - 1]); + } + return nz; + } + + tol = fmax(d1mach[3], 1e-18); + k1 = i1mach[14]; + k2 = i1mach[15]; + r1m5 = d1mach[4]; + k = (abs(k1) > abs(k2) ? abs(k2) : abs(k1)); + // + // ELIM IS THE APPROXIMATE EXPONENTIAL UNDER- AND OVERFLOW LIMIT + // + elim = 2.303 * (k * r1m5 - 3.0); + exr = cos(xx); + exi = sin(xx); + ey = 0.0; + tay = fabs(yy + yy); + if (tay < elim) { + ey = exp(-tay); + } + if (yy < 0.0) { + /* 90 */ + c1 = std::complex(exr, exi); + c2 = ey * std::complex(exr, -exi); + } else { + c1 = ey * std::complex(exr, exi); + c2 = std::complex(exr, -exi); + } + + nz = 0; + rtol = 1.0 / tol; + ascle = 1e3 * d1mach[0] * rtol; + for (i = 1; i < (n + 1); i++) { + aa = std::real(cwrk[i - 1]); + bb = std::imag(cwrk[i - 1]); + atol = 1.0; + if (fmax(fabs(aa), fabs(bb)) <= ascle) { + aa *= rtol; + bb *= rtol; + atol = tol; + } + + st = std::complex(aa, bb) * c2 * atol; + aa = std::real(cy[i - 1]); + bb = std::imag(cy[i - 1]); + atol = 1.0; + if (fmax(fabs(aa), fabs(bb)) <= ascle) { + aa *= rtol; + bb *= rtol; + atol = tol; + } + + st -= std::complex(aa, bb) * c1 * atol; + cy[i - 1] = st * hci; + if ((st == 0.0) && (ey == 0.0)) { + nz += 1; + } + } + + return nz; + } + + inline int binu( + std::complex z, double fnu, int kode, int n, std::complex *cy, double rl, double fnul, + double tol, double elim, double alim + ) { + + //***BEGIN PROLOGUE ZBINU + //***REFER TO ZBESH,ZBESI,ZBESJ,ZBESK,ZAIRY,ZBIRY + // + // ZBINU COMPUTES THE I FUNCTION IN THE RIGHT HALF Z PLANE + // + //***ROUTINES CALLED AZABS,ZASYI,ZBUNI,ZMLRI,ZSERI,ZUOIK,ZWRSK + //***END PROLOGUE ZBINU + + std::complex cw[2] = {0.}; + double az, dfnu; + int inw, nlast, nn, nui, nw, nz; + + nz = 0; + az = std::abs(z); + nn = n; + dfnu = fnu + n - 1; + if ((az <= 2.) || (az * az * 0.25 <= (dfnu + 1.0))) { + /* GOTO 10 */ + nw = seri(z, fnu, kode, n, cy, tol, elim, alim); + inw = abs(nw); + nz += inw; + nn -= inw; + if (nn == 0) { + return nz; + } + if (nw >= 0) { + return nz; + } + dfnu = fnu + nn - 1; + } + /* GOTO 30 conditions*/ + // + // ASYMPTOTIC EXPANSION FOR LARGE Z + // + if (az < rl) { + /* 40 */ + if (dfnu <= 1.0) { + /* 70 */ + // + // MILLER ALGORITHM NORMALIZED BY THE SERIES + // + nw = mlri(z, fnu, kode, n, cy, tol); + if (nw < 0) { + nz = -1; + if (nw == -2) { + nz = -2; + } + return nz; + } + return nz; + } + /* GO TO 50 */ + } else { + if ((dfnu <= 1.0) || (az + az >= dfnu * dfnu)) { + /* 30 */ + // + // ASYMPTOTIC EXPANSION FOR LARGE Z + // + nw = asyi(z, fnu, kode, n, cy, rl, tol, elim, alim); + if (nw < 0) { + nz = -1; + if (nw == -2) { + nz = -2; + } + return nz; + } + return nz; + } + /* GO TO 50 */ + } + /* 50 */ + // + // OVERFLOW AND UNDERFLOW TEST ON I SEQUENCE FOR MILLER ALGORITHM + // + nw = uoik(z, fnu, kode, 1, nn, cy, tol, elim, alim); + if (nw < 0) { + nz = -1; + if (nw == -2) { + nz = -2; + } + return nz; + } + nz += nw; + nn -= nw; + if (nn == 0) { + return nz; + } + dfnu = fnu + (nn - 1); + /* GOTO 110s handled here */ + if ((dfnu > fnul) || (az > fnul)) { + // + // INCREMENT FNU+NN-1 UP TO FNUL, COMPUTE AND RECUR BACKWARD + // + nui = (int)(fnul - dfnu) + 1; + nui = (nui > 0 ? nui : 0); + nw = buni(z, fnu, kode, nn, cy, nui, &nlast, fnul, tol, elim, alim); + if (nw < 0) { + nz = -1; + if (nw == -2) { + nz = -2; + } + return nz; + } + nz += nw; + if (nlast == 0) { + return nz; + } + nn = nlast; + } + /* 60 */ + if (az <= rl) { + /* 70 */ + nw = mlri(z, fnu, kode, n, cy, tol); + if (nw < 0) { + nz = -1; + if (nw == -2) { + nz = -2; + } + return nz; + } + return nz; + } + /* 80 */ + // + // MILLER ALGORITHM NORMALIZED BY THE WRONSKIAN + // + // + // OVERFLOW TEST ON K FUNCTIONS USED IN WRONSKIAN + // + nw = uoik(z, fnu, kode, 2, 2, cw, tol, elim, alim); + if (nw < 0) { + nz = nn; + /* 90 */ + for (int i = 0; i < nn; i++) { + cy[i] = 0.0; + } + return nz; + } + /* 100 */ + if (nw > 0) { + return -1; + } + nw = wrsk(z, fnu, kode, nn, cy, cw, tol, elim, alim); + if (nw < 0) { + nz = -1; + if (nw == -2) { + nz = -2; + } + return nz; + } + return nz; + } + + inline std::complex biry(std::complex z, int id, int kode, int *ierr) { + + //***BEGIN PROLOGUE ZBIRY + //***DATE WRITTEN 830501 (YYMMDD) + //***REVISION DATE 890801 (YYMMDD) + //***CATEGORY NO. B5K + //***KEYWORDS AIRY FUNCTION,BESSEL FUNCTIONS OF ORDER ONE THIRD + //***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES + //***PURPOSE TO COMPUTE AIRY FUNCTIONS BI(Z) AND DBI(Z) FOR COMPLEX Z + //***DESCRIPTION + // + // ***A DOUBLE PRECISION ROUTINE*** + // ON KODE=1, CBIRY COMPUTES THE COMPLEX AIRY FUNCTION BI(Z) OR + // ITS DERIVATIVE DBI(Z)/DZ ON ID=0 OR ID=1 RESPECTIVELY. ON + // KODE=2, A SCALING OPTION CEXP(-AXZTA)*BI(Z) OR CEXP(-AXZTA)* + // DBI(Z)/DZ IS PROVIDED TO REMOVE THE EXPONENTIAL BEHAVIOR IN + // BOTH THE LEFT AND RIGHT HALF PLANES WHERE + // ZTA=(2/3)*Z*CSQRT(Z)=std::complex(XZTA,YZTA) AND AXZTA=ABS(XZTA). + // DEFINITIONS AND NOTATION ARE FOUND IN THE NBS HANDBOOK OF + // MATHEMATICAL FUNCTIONS (REF. 1). + // + // INPUT ZR,ZI ARE DOUBLE PRECISION + // ZR,ZI - Z=std::complex(ZR,ZI) + // ID - ORDER OF DERIVATIVE, ID=0 OR ID=1 + // KODE - A PARAMETER TO INDICATE THE SCALING OPTION + // KODE= 1 RETURNS + // BI=BI(Z) ON ID=0 OR + // BI=DBI(Z)/DZ ON ID=1 + // = 2 RETURNS + // BI=CEXP(-AXZTA)*BI(Z) ON ID=0 OR + // BI=CEXP(-AXZTA)*DBI(Z)/DZ ON ID=1 WHERE + // ZTA=(2/3)*Z*CSQRT(Z)=std::complex(XZTA,YZTA) + // AND AXZTA=ABS(XZTA) + // + // OUTPUT BIR,BII ARE DOUBLE PRECISION + // BIR,BII- COMPLEX ANSWER DEPENDING ON THE CHOICES FOR ID AND + // KODE + // IERR - ERROR FLAG + // IERR=0, NORMAL RETURN - COMPUTATION COMPLETED + // IERR=1, INPUT ERROR - NO COMPUTATION + // IERR=2, OVERFLOW - NO COMPUTATION, REAL(Z) + // TOO LARGE ON KODE=1 + // IERR=3, CABS(Z) LARGE - COMPUTATION COMPLETED + // LOSSES OF SIGNIFCANCE BY ARGUMENT REDUCTION + // PRODUCE LESS THAN HALF OF MACHINE ACCURACY + // IERR=4, CABS(Z) TOO LARGE - NO COMPUTATION + // COMPLETE LOSS OF ACCURACY BY ARGUMENT + // REDUCTION + // IERR=5, ERROR - NO COMPUTATION, + // ALGORITHM TERMINATION CONDITION NOT MET + // + //***LONG DESCRIPTION + // + // BI AND DBI ARE COMPUTED FOR CABS(Z).GT.1.0 FROM THE I BESSEL + // FUNCTIONS BY + // + // BI(Z)=C*SQRT(Z)*( I(-1/3,ZTA) + I(1/3,ZTA) ) + // DBI(Z)=C * Z * ( I(-2/3,ZTA) + I(2/3,ZTA) ) + // C=1.0/SQRT(3.0) + // ZTA=(2/3)*Z**(3/2) + // + // WITH THE POWER SERIES FOR CABS(Z).LE.1.0. + // + // IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- + // MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z IS LARGE, LOSSES + // OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. CONSEQUENTLY, IF + // THE MAGNITUDE OF ZETA=(2/3)*Z**1.5 EXCEEDS U1=SQRT(0.5/UR), + // THEN LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR + // FLAG IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS + // DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. + // ALSO, IF THE MAGNITUDE OF ZETA IS LARGER THAN U2=0.5/UR, THEN + // ALL SIGNIFICANCE IS LOST AND IERR=4. IN ORDER TO USE THE INT + // FUNCTION, ZETA MUST BE FURTHER RESTRICTED NOT TO EXCEED THE + // LARGEST INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF ZETA + // MUST BE RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, + // AND U3 ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE + // PRECISION ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE + // PRECISION ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMIT- + // ING IN THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT THE MAG- + // NITUDE OF Z CANNOT EXCEED 3.1E+4 IN SINGLE AND 2.1E+6 IN + // DOUBLE PRECISION ARITHMETIC. THIS ALSO MEANS THAT ONE CAN + // EXPECT TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, + // NO DIGITS IN SINGLE PRECISION AND ONLY 7 DIGITS IN DOUBLE + // PRECISION ARITHMETIC. SIMILAR CONSIDERATIONS HOLD FOR OTHER + // MACHINES. + // + // THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX + // BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT + // ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- + // SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE + // ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), + // ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF + // CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY + // HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN + // ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY + // SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER + // THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, + // 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS + // THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER + // COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY + // BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER + // COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE + // MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, + // THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, + // OR -PI/2+P. + // + //***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ + // AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF + // COMMERCE, 1955. + // + // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT + // AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 + // + // A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX + // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- + // 1018, MAY, 1985 + // + // A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX + // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS. + // MATH. SOFTWARE, 1986 + // + //***ROUTINES CALLED ZBINU,AZABS,ZDIV,AZSQRT,D1MACH,I1MACH + //***END PROLOGUE ZBIRY + + std::complex bi, csq, s1, s2, trm1, trm2, zta, z3; + double aa, ad, ak, alim, atrm, az, az3, bb, bk, ck, dig, dk, d1, d2, elim, fid, fmr, fnu, fnul, rl, r1m5, sfac, + tol, zi, zr; + int k, k1, k2, nz; + std::complex cy[2] = {0.0}; + double tth = 2. / 3.; + double c1 = 0.614926627446000735150922369; /* 1/( 3**(1/6) Gamma(2/3)) */ + double c2 = 0.448288357353826357914823710; /* 3**(1/6) / Gamma(1/3) */ + double coef = 0.577350269189625764509148780; /* sqrt( 1 / 3) */ + double pi = 3.141592653589793238462643383; + + *ierr = 0; + nz = 0; + if ((id < 0) || (id > 1)) { + *ierr = 1; + } + if ((kode < 1) || (kode > 2)) { + *ierr = 1; + } + if (*ierr != 0) { + return 0.0; + } + az = std::abs(z); + tol = fmax(d1mach[3], 1e-18); + fid = id; + if (az <= 1.0) { + // + // POWER SERIES FOR ABS(Z) <= 1. + // + s1 = 1.0; + s2 = 1.0; + if (az < tol) { + aa = c1 * (1.0 - fid) + fid * c2; + return aa; + } + aa = az * az; + if (aa >= tol / az) { + trm1 = 1.0; + trm2 = 1.0; + atrm = 1.0; + z3 = z * z * z; + az3 = az * aa; + ak = 2.0 + fid; + bk = 3.0 - fid - fid; + ck = 4.0 - fid; + dk = 3.0 + fid + fid; + d1 = ak * dk; + d2 = bk * ck; + ad = fmin(d1, d2); + ak = 24.0 + 9.0 * fid; + bk = 30.0 - 9.0 * fid; + for (k = 1; k < 26; k++) { + trm1 *= z3 / d1; + s1 += trm1; + trm2 *= z3 / d2; + s2 += trm2; + atrm *= az3 / ad; + d1 += ak; + d2 += bk; + ad = fmin(d1, d2); + if (atrm < tol * ad) { + break; + } + ak += 18.0; + bk += 18.0; + } + /* 30 */ + } + /* 40 */ + if (id != 1) { + bi = s1 * c1 + z * s2 * c2; + if (kode == 1) { + return bi; + } + zta = z * std::sqrt(z) * tth; + aa = -fabs(std::real(zta)); + bi *= exp(aa); + return bi; + } + /* 50 */ + bi = s2 * c2; + if (az > tol) { + bi += z * z * s1 * c1 / (1.0 + fid); + } + if (kode == 1) { + return bi; + } + zta = z * std::sqrt(z) * tth; + aa = -fabs(std::real(zta)); + bi *= exp(aa); + return bi; + } + /* 70 */ + // + // CASE FOR ABS(Z) > 1.0 + // + fnu = (1.0 + fid) / 3.0; + // + // SET PARAMETERS RELATED TO MACHINE CONSTANTS. + // TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. + // ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. + // EXP(-ELIM) < EXP(-ALIM)=EXP(-ELIM)/TOL AND + // EXP(ELIM) > EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR + // UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. + // RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. + // DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). + // FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU. + // + k1 = i1mach[14]; + k2 = i1mach[15]; + r1m5 = d1mach[4]; + k = (abs(k1) > abs(k2) ? abs(k2) : abs(k1)); + elim = 2.303 * (k * r1m5 - 3.0); + k1 = i1mach[13] - 1; + aa = r1m5 * k1; + dig = fmin(aa, 18.0); + aa *= 2.303; + alim = elim + fmax(-aa, -41.45); + rl = 1.2 * dig + 3.0; + fnul = 10.0 + 6.0 * (dig - 3.0); + // + // TEST FOR RANGE + // + aa = 0.5 / tol; + bb = i1mach[8] * 0.5; + aa = fmin(aa, bb); + aa = pow(aa, tth); + if (az > aa) { + *ierr = 4; + return 0.0; + } + aa = sqrt(aa); + if (az > aa) { + *ierr = 3; + } + csq = std::sqrt(z); + zta = z * csq * tth; + // + // RE(ZTA) <= 0 WHEN RE(Z) < 0, ESPECIALLY WHEN IM(Z) IS SMALL + // + sfac = 1.0; + zi = std::imag(z); + zr = std::real(z); + ak = std::imag(zta); + if (zr < 0.0) { + bk = std::real(zta); + ck = -fabs(bk); + zta = std::complex(ck, ak); + } + /* 80 */ + if ((zi == 0.0) && (zr <= 0.0)) { + zta = std::complex(0.0, ak); + } + /* 90 */ + aa = std::real(zta); + if (kode != 2) { + // + // OVERFLOW TEST + // + bb = fabs(aa); + if (bb >= alim) { + bb += 0.25 * log(az); + sfac = tol; + if (bb > elim) { + *ierr = 2; + return 0.0; + } + } + } + /* 100 */ + fmr = 0.0; + if ((aa < 0.0) || (zr <= 0.0)) { + fmr = pi; + if (zi < 0.0) { + fmr = -pi; + } + zta = -zta; + } + /* 110 */ + // + // AA=FACTOR FOR ANALYTIC CONTINUATION OF I(FNU,ZTA) + // KODE=2 RETURNS EXP(-ABS(XZTA))*I(FNU,ZTA) FROM CBINU + // + nz = binu(zta, fnu, kode, 1, cy, rl, fnul, tol, elim, alim); + if (nz < 0) { + if (nz == -1) { + *ierr = 2; } else { *ierr = 5; } - return 0; + return 0.0; } - return nw; + aa = fmr * fnu; + z3 = sfac; + s1 = cy[0] * std::complex(cos(aa), sin(aa)) * z3; + fnu = (2.0 - fid) / 3.0; + nz = binu(zta, fnu, kode, 2, cy, rl, fnul, tol, elim, alim); + cy[0] *= z3; + cy[1] *= z3; + // + // BACKWARD RECUR ONE STEP FOR ORDERS -1/3 OR -2/3 + // + s2 = cy[0] * (fnu + fnu) / zta + cy[1]; + aa = fmr * (fnu - 1.0); + s1 = (s1 + s2 * std::complex(cos(aa), sin(aa))) * coef; + if (id != 1) { + s1 *= csq; + bi = s1 / sfac; + return bi; + } + /* 120 */ + s1 *= z; + bi = s1 / sfac; + return bi; } - /* 80 */ + inline int bknu( + std::complex z, double fnu, int kode, int n, std::complex *y, double tol, double elim, + double alim + ) { + + //***BEGIN PROLOGUE ZBKNU + //***REFER TO ZBESI,ZBESK,ZAIRY,ZBESH + // + // ZBKNU COMPUTES THE K BESSEL FUNCTION IN THE RIGHT HALF Z PLANE. + // + //***ROUTINES CALLED DGAMLN,I1MACH,D1MACH,ZKSCL,ZSHCH,ZUCHK,AZABS,ZDIV, + // AZEXP,AZLOG,ZMLT,AZSQRT + //***END PROLOGUE ZBKNU + + std::complex cch, ck, coef, crsc, cs, cscl, csh, cz, f, fmu, p, pt, p1, p2, q, rz, smu, st, s1, s2, zd; + double aa, ak, ascle, a1, a2, bb, bk, caz, dnu, dnu2, etest, fc, fhs, fk, fks, g1, g2, p2i, p2m, p2r, rk, s, tm, + t1, t2, xx, yy, elm, xd, yd, alas, as; + int iflag, inu, k, kflag, kk, koded, j, ic, inub, i = 1; + std::complex cy[2]; + + int kmax = 30; + double r1 = 2.; + double pi = 3.14159265358979324; + double rthpi = 1.25331413731550025; + double spi = 1.90985931710274403; + double hpi = 1.57079632679489662; + double fpi = 1.89769999331517738; + double tth = 2. / 3.; + double cc[8] = {5.77215664901532861e-01, -4.20026350340952355e-02, -4.21977345555443367e-02, + 7.21894324666309954e-03, -2.15241674114950973e-04, -2.01348547807882387e-05, + 1.13302723198169588e-06, 6.11609510448141582e-09}; + xx = std::real(z); + yy = std::imag(z); + caz = std::abs(z); + cscl = 1. / tol; + crsc = tol; + std::complex css[3] = {cscl, 1., crsc}; + std::complex csr[3] = {crsc, 1., cscl}; + double bry[3] = {1e3 * d1mach[0] / tol, tol / (1e3 * d1mach[0]), d1mach[1]}; + int nz = 0; + iflag = 0; + koded = kode; + rz = 2. / z; + inu = (int)(fnu + 0.5); + dnu = fnu - inu; + // Definitions for silencing initialization warnings. + s1 = 0.0; + s2 = 0.0; + ck = 0.0; + dnu2 = 0.0; + if (fabs(dnu) != 0.5) { + if (fabs(dnu) > tol) { + dnu2 = dnu * dnu; + } + if (caz <= r1) { + // + // SERIES FOR ABS(Z) <= R1 + // + fc = 1.; + smu = std::log(rz); + fmu = smu * dnu; + csh = std::sinh(fmu); + cch = std::cosh(fmu); + if (dnu != 0.0) { + fc = dnu * pi; + fc *= 1. / sin(fc); + smu = csh / dnu; + } + a2 = 1. + dnu; + // + // GAM(1-Z)*GAM(1+Z)=PI*Z/SIN(PI*Z), T1=1/GAM(1-DNU), T2=1/GAM(1+DNU) + // + t2 = exp(-gamln(a2)); + t1 = 1. / (t2 * fc); + if (fabs(dnu) <= 0.1) { + // + // SERIES FOR F0 TO RESOLVE INDETERMINACY FOR SMALL ABS(DNU) + // + ak = 1.; + s = cc[0]; + for (int k = 2; k < 9; k++) { + ak *= dnu2; + tm = cc[k - 1] * ak; + s += tm; + if (fabs(tm) < tol) { + break; + } + } + g1 = -s; + } else { + g1 = (t1 - t2) / (dnu + dnu); + } + g2 = 0.5 * (t1 + t2); + f = fc * (g1 * cch + smu * g2); + pt = std::exp(fmu); + p = (0.5 / t2) * pt; + q = (0.5 / t1) / pt; + s1 = f; + s2 = p; + ak = 1.0; + a1 = 1.0; + ck = 1.0; + bk = 1.0 - dnu2; + if ((inu <= 0) && (n <= 1)) { + // + // GENERATE K(FNU,Z), 0.0D0 <= FNU < 0.5D0 AND N=1 + // + if (caz >= tol) { + cz = z * z * 0.25; + t1 = 0.25 * caz * caz; + do { + f = (f * ak + p + q) / bk; + p = p / (ak - dnu); + q = q / (ak + dnu); + rk = 1.0 / ak; + ck *= cz * rk; + s1 += ck * f; + a1 *= t1 * rk; + bk += ak + ak + 1.0; + ak += 1.0; + } while (a1 > tol); + } + y[0] = s1; + if (koded == 1) { + return nz; + } + y[0] = s1 * std::exp(z); + return nz; + } + // + // GENERATE K(DNU,Z) AND K(DNU+1,Z) FOR FORWARD RECURRENCE + // + if (caz >= tol) { + cz = z * z * 0.25; + t1 = 0.25 * caz * caz; + do { + f = (f * ak + p + q) / bk; + p *= 1.0 / (ak - dnu); + q *= 1.0 / (ak + dnu); + rk = 1. / ak; + ck *= cz * rk; + s1 += ck * f; + s2 += ck * (p - f * ak); + a1 *= t1 * rk; + bk += ak + ak + 1.0; + ak += 1.0; + } while (a1 > tol); + } + kflag = 2; + bk = std::real(smu); + a1 = fnu + 1.; + ak = a1 * fabs(bk); + if (ak > alim) { + kflag = 3; + } + p2 = s2 * css[kflag - 1]; + s2 = p2 * rz; + s1 *= css[kflag - 1]; + if (koded != 1) { + f = std::exp(z); + s1 *= f; + s2 *= f; + } + goto L100; + } + } + // + // IFLAG=0 MEANS NO UNDERFLOW OCCURRED + // IFLAG=1 MEANS AN UNDERFLOW OCCURRED- COMPUTATION PROCEEDS WITH + // KODED=2 AND A TEST FOR ON SCALE VALUES IS MADE DURING FORWARD + // RECURSION + // + coef = rthpi / std::sqrt(z); + kflag = 2; + if (koded != 2) { + if (xx > alim) { + koded = 2; + iflag = 1; + kflag = 2; + } else { + a1 = exp(-xx) * std::real(css[kflag - 1]); + pt = a1 * std::complex(cos(yy), -sin(yy)); + coef *= pt; + } + } + + if (fabs(dnu) == 0.5) { + s1 = coef; + s2 = coef; + goto L100; + } + // + // MILLER ALGORITHM FOR ABS(Z) > R1 + // + ak = fabs(cos(pi * dnu)); + if (ak == 0.) { + s1 = coef; + s2 = coef; + goto L100; + } + fhs = fabs(0.25 - dnu2); + if (fhs == 0.) { + s1 = coef; + s2 = coef; + goto L100; + } + // + // COMPUTE R2=F(E). IF ABS(Z) >= R2, USE FORWARD RECURRENCE TO + // DETERMINE THE BACKWARD INDEX K. R2=F(E) IS A STRAIGHT LINE ON + // 12 <= E <= 60. E IS COMPUTED FROM 2**(-E)=B**(1-DIGITS(0.0_dp))= + // TOL WHERE B IS THE BASE OF THE ARITHMETIC. + // + t1 = (i1mach[13] - 1) * d1mach[4] * (log(10) / log(2)); + t1 = fmin(fmax(t1, 12.0), 60.0); + t2 = tth * t1 - 6.0; + if (xx == 0.) { + t1 = hpi; + } else { + t1 = fabs(atan(yy / xx)); + } + if (t2 <= caz) { + // + // FORWARD RECURRENCE LOOP WHEN ABS(Z) >= R2 + // + etest = ak / (pi * caz * tol); + fk = 1.0; + if (etest < 1.0) { + goto L80; + } + fks = 2.0; + rk = caz + caz + 2.0; + a1 = 0.0; + a2 = 1.0; + for (i = 1; i < (kmax + 1); i++) { + ak = fhs / fks; + bk = rk / (fk + 1.0); + tm = a2; + a2 = bk * a2 - ak * a1; + a1 = tm; + rk += 2.; + fks += fk + fk + 2.0; + fhs += fk + fk; + fk += 1.0; + tm = fabs(a2) * fk; + if (etest < tm) { + /* goto 160 */ + break; + } + if (i == kmax) { + /* Didn't break so goes to 310 */ + return -2; + } + } + + /* 160 */ + fk += spi * t1 * sqrt(t2 / caz); + fhs = fabs(0.25 - dnu2); + } else { + // + // COMPUTE BACKWARD INDEX K FOR ABS(Z) < R2 + // + a2 = sqrt(caz); + ak *= fpi / (tol * sqrt(a2)); + aa = 3.0 * t1 / (1.0 + caz); + bb = 14.7 * t1 / (28.0 + caz); + ak = (log(ak) + caz * cos(aa) / (1.0 + 0.008 * caz)) / cos(bb); + fk = 0.12125 * ak * ak / caz + 1.5; + } + L80: + // + // BACKWARD RECURRENCE LOOP FOR MILLER ALGORITHM + // + k = (int)fk; + fk = (double)k; + fks = fk * fk; + p1 = 0.0; + p2 = tol; + cs = p2; + for (i = 1; i < (k + 1); i++) { + a1 = fks - fk; + a2 = (fks + fk) / (a1 + fhs); + rk = 2.0 / (fk + 1.); + t1 = (fk + xx) * rk; + t2 = yy * rk; + pt = p2; + p2 = (p2 * std::complex(t1, t2) - p1) * a2; + p1 = pt; + cs += p2; + fks = a1 - fk + 1.0; + fk -= 1.0; + } + + // + // COMPUTE (P2/CS)=(P2/ABS(CS))*(CONJG(CS)/ABS(CS)) FOR BETTER SCALING + // + tm = std::abs(cs); + pt = 1.0 / tm; + s1 = pt * p2; + cs = conj(cs) * pt; + s1 *= coef * cs; + if ((inu <= 0) && (n <= 1)) { + zd = z; + if (iflag == 1) { + goto L190; + } + goto L130; + } + // + // COMPUTE P1/P2=(P1/ABS(P2)*CONJG(P2)/ABS(P2) FOR SCALING + // + tm = std::abs(p2); + pt = 1.0 / tm; + p1 = pt * p1; + p2 = conj(p2) * pt; + pt = p1 * p2; + s2 = s1 * (1. + (dnu + 0.5 - pt) / z); + // + // FORWARD RECURSION ON THE THREE TERM RECURSION RELATION WITH + // SCALING NEAR EXPONENT EXTREMES ON KFLAG=1 OR KFLAG=3 + // + L100: + ck = (dnu + 1.) * rz; + if (n == 1) { + inu -= 1; + } + if (inu <= 0) { + if (n <= 1) { + s1 = s2; + } + zd = z; + if (iflag == 1) { + goto L190; + } + goto L130; + } + inub = 1; + if (iflag == 1) { + goto L160; + } + L110: + p1 = csr[kflag - 1]; + ascle = bry[kflag - 1]; + for (i = inub; i < inu + 1; i++) { + st = s2; + s2 = ck * s2 + s1; + s1 = st; + ck += rz; + if (kflag < 3) { + p2 = s2 * p1; + p2m = fmax(fabs(std::real(p2)), fabs(std::imag(p2))); + if (p2m > ascle) { + kflag += 1; + ascle = bry[kflag - 1]; + s1 *= p1; + s2 = p2; + s1 *= css[kflag - 1]; + s2 *= css[kflag - 1]; + p1 = csr[kflag - 1]; + } + } + } + if (n == 1) { + s1 = s2; + } + + L130: + y[0] = s1 * csr[kflag - 1]; + if (n == 1) { + return nz; + } + y[1] = s2 * csr[kflag - 1]; + if (n == 2) { + return nz; + } + kk = 2; + L140: + kk += 1; + if (kk > n) { + return nz; + } + p1 = csr[kflag - 1]; + ascle = bry[kflag - 1]; + for (i = kk; i < (n + 1); i++) { + p2 = s2; + s2 = ck * s2 + s1; + s1 = p2; + ck += rz; + p2 = s2 * p1; + y[i - 1] = p2; + if (kflag < 3) { + p2m = fmax(fabs(std::real(p2)), fabs(std::imag(p2))); + if (p2m > ascle) { + kflag += 1; + ascle = bry[kflag - 1]; + s1 *= p1; + s2 = p2; + s1 *= css[kflag - 1]; + s2 *= css[kflag - 1]; + p1 = csr[kflag - 1]; + } + } + } + return nz; // - // UNIFORM ASYMPTOTIC EXPANSIONS FOR FNU > FNUL + // IFLAG=1 CASES, FORWARD RECURRENCE ON SCALED VALUES ON UNDERFLOW // - mr = 0; - if (xx < 0.0) { - mr = 1; - if (yy < 0.0) { mr = -1; } + L160: + elm = exp(-elim); + ascle = bry[0]; + zd = z; + xd = xx; + yd = yy; + ic = -1; + j = 2; + for (i = 1; i < (inu + 1); i++) { + st = s2; + s2 = ck * s2 + s1; + s1 = st; + ck += rz; + as = std::abs(s2); + alas = log(as); + p2r = alas - xd; + if (p2r >= -elim) { + p2 = -zd + std::log(s2); + p2r = std::real(p2); + p2i = std::imag(p2); + p2m = exp(p2r) / tol; + p1 = p2m * std::complex(cos(p2i), sin(p2i)); + if (!(uchk(p1, ascle, tol))) { + j = 3 - j; + cy[j - 1] = p1; + if (ic == i - 1) { + goto L180; + } + ic = i; + continue; + } + } + if (alas >= 0.5 * elim) { + xd -= elim; + s1 *= elm; + s2 *= elm; + zd = std::complex(xd, yd); + } + } + if (n == 1) { + s1 = s2; + } + goto L190; + L180: + kflag = 1; + inub = i + 1; + s2 = cy[j - 1]; + j = 3 - j; + s1 = cy[j - 1]; + if (inub <= inu) { + goto L110; + } + if (n == 1) { + s1 = s2; + } + goto L130; + L190: + y[0] = s1; + if (n != 1) { + y[1] = s2; + } + ascle = bry[0]; + nz = kscl(zd, fnu, n, &y[0], rz, &ascle, tol, elim); + inu = n - nz; + if (inu <= 0) { + return nz; + } + kk = nz + 1; + s1 = y[kk - 1]; + y[kk - 1] = s1 * csr[0]; + if (inu == 1) { + return nz; + } + kk = nz + 2; + s2 = y[kk - 1]; + y[kk - 1] = s2 * csr[0]; + if (inu == 2) { + return nz; + } + t2 = fnu + (kk - 1); + ck = t2 * rz; + kflag = 1; + goto L140; } - nw = bunk(z, fnu, kode, mr, nn, cy, tol, elim, alim); - if (nw < 0) { - if (nw == -1) { - *ierr = 2; + + inline int buni( + std::complex z, double fnu, int kode, int n, std::complex *y, int nui, int *nlast, double fnul, + double tol, double elim, double alim + ) { + + //***BEGIN PROLOGUE ZBUNI + //***REFER TO ZBESI,ZBESK + // + // ZBUNI COMPUTES THE I BESSEL FUNCTION FOR LARGE CABS(Z).GT. + // FNUL AND FNU+N-1.LT.FNUL. THE ORDER IS INCREASED FROM + // FNU+N-1 GREATER THAN FNUL BY ADDING NUI AND COMPUTING + // ACCORDING TO THE UNIFORM ASYMPTOTIC EXPANSION FOR I(FNU,Z) + // ON IFORM=1 AND THE EXPANSION FOR J(FNU,Z) ON IFORM=2 + // + //***ROUTINES CALLED ZUNI1,ZUNI2,AZABS,D1MACH + //***END PROLOGUE ZBUNI + + std::complex cscl, cscr, rz, st, s1, s2; + double ax, ay, dfnu, fnui, gnu, xx, yy, ascle, str, sti, stm; + int i, iflag, iform, k, nl, nw, nz; + std::complex cy[2] = {0.0}; + double bry[3] = {0.0}; + + nz = 0; + xx = std::real(z); + yy = std::imag(z); + ax = fabs(xx) + sqrt(3.); + ay = fabs(yy); + iform = 1; + if (ay > ax) { + iform = 2; + } + if (nui == 0) { + if (iform != 2) { + uni1(z, fnu, kode, n, y, &nw, nlast, fnul, tol, elim, alim); + } else { + uni2(z, fnu, kode, n, y, &nw, nlast, fnul, tol, elim, alim); + } + if (nw < 0) { + nz = -1; + if (nw == -2) { + nz = -2; + } + return nz; + } + return nw; + } + + fnui = nui; + dfnu = fnu + (n - 1); + gnu = dfnu + fnui; + if (iform != 2) { + // + // ASYMPTOTIC EXPANSION FOR I(FNU,Z) FOR LARGE FNU APPLIED IN + // -PI/3 <= ARG(Z) <= PI/3 + // + uni1(z, gnu, kode, 2, cy, &nw, nlast, fnul, tol, elim, alim); } else { - *ierr = 5; + uni2(z, gnu, kode, 2, cy, &nw, nlast, fnul, tol, elim, alim); } - return 0; - } - nz += nw; - return nz; -} - - -inline int besy( - std::complex z, - double fnu, - int kode, - int n, - std::complex *cy, - int *ierr -) { - - //***BEGIN PROLOGUE ZBESY - //***DATE WRITTEN 830501 (YYMMDD) - //***REVISION DATE 890801 (YYMMDD) - //***CATEGORY NO. B5K - //***KEYWORDS Y-BESSEL FUNCTION,BESSEL FUNCTION OF COMPLEX ARGUMENT, - // BESSEL FUNCTION OF SECOND KIND - //***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES - //***PURPOSE TO COMPUTE THE Y-BESSEL FUNCTION OF A COMPLEX ARGUMENT - //***DESCRIPTION - // - // ***A DOUBLE PRECISION ROUTINE*** - // - // ON KODE=1, CBESY COMPUTES AN N MEMBER SEQUENCE OF COMPLEX - // BESSEL FUNCTIONS CY(I)=Y(FNU+I-1,Z) FOR REAL, NONNEGATIVE - // ORDERS FNU+I-1, I=1,...,N AND COMPLEX Z IN THE CUT PLANE - // -PI.LT.ARG(Z).LE.PI. ON KODE=2, CBESY RETURNS THE SCALED - // FUNCTIONS - // - // CY(I)=EXP(-ABS(Y))*Y(FNU+I-1,Z) I = 1,...,N , Y=AIMAG(Z) - // - // WHICH REMOVE THE EXPONENTIAL GROWTH IN BOTH THE UPPER AND - // LOWER HALF PLANES FOR Z TO INFINITY. DEFINITIONS AND NOTATION - // ARE FOUND IN THE NBS HANDBOOK OF MATHEMATICAL FUNCTIONS - // (REF. 1). - // - // INPUT ZR,ZI,FNU ARE DOUBLE PRECISION - // ZR,ZI - Z=std::complex(ZR,ZI), Z.NE.std::complex(0.0D0,0.0D0), - // -PI.LT.ARG(Z).LE.PI - // FNU - ORDER OF INITIAL Y FUNCTION, FNU.GE.0.0D0 - // KODE - A PARAMETER TO INDICATE THE SCALING OPTION - // KODE= 1 RETURNS - // CY(I)=Y(FNU+I-1,Z), I=1,...,N - // = 2 RETURNS - // CY(I)=Y(FNU+I-1,Z)*EXP(-ABS(Y)), I=1,...,N - // WHERE Y=AIMAG(Z) - // N - NUMBER OF MEMBERS OF THE SEQUENCE, N.GE.1 - // CWRKR, - DOUBLE PRECISION WORK VECTORS OF DIMENSION AT - // CWRKI AT LEAST N - // - // OUTPUT CYR,CYI ARE DOUBLE PRECISION - // CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS - // CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE - // CY(I)=Y(FNU+I-1,Z) OR - // CY(I)=Y(FNU+I-1,Z)*EXP(-ABS(Y)) I=1,...,N - // DEPENDING ON KODE. - // NZ - NZ=0 , A NORMAL RETURN - // NZ.GT.0 , NZ COMPONENTS OF CY SET TO ZERO DUE TO - // UNDERFLOW (GENERALLY ON KODE=2) - // IERR - ERROR FLAG - // IERR=0, NORMAL RETURN - COMPUTATION COMPLETED - // IERR=1, INPUT ERROR - NO COMPUTATION - // IERR=2, OVERFLOW - NO COMPUTATION, FNU IS - // TOO LARGE OR CABS(Z) IS TOO SMALL OR BOTH - // IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE - // BUT LOSSES OF SIGNIFCANCE BY ARGUMENT - // REDUCTION PRODUCE LESS THAN HALF OF MACHINE - // ACCURACY - // IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA- - // TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI- - // CANCE BY ARGUMENT REDUCTION - // IERR=5, ERROR - NO COMPUTATION, - // ALGORITHM TERMINATION CONDITION NOT MET - // IERR=6, Memory allocation failed. - // - //***LONG DESCRIPTION - // - // THE COMPUTATION IS CARRIED OUT BY THE FORMULA - // - // Y(FNU,Z)=0.5*(H(1,FNU,Z)-H(2,FNU,Z))/I - // - // WHERE I**2 = -1 AND THE HANKEL BESSEL FUNCTIONS H(1,FNU,Z) - // AND H(2,FNU,Z) ARE CALCULATED IN CBESH. - // - // FOR NEGATIVE ORDERS,THE FORMULA - // - // Y(-FNU,Z) = Y(FNU,Z)*COS(PI*FNU) + J(FNU,Z)*SIN(PI*FNU) - // - // CAN BE USED. HOWEVER,FOR LARGE ORDERS CLOSE TO HALF ODD - // INTEGERS THE FUNCTION CHANGES RADICALLY. WHEN FNU IS A LARGE - // POSITIVE HALF ODD INTEGER,THE MAGNITUDE OF Y(-FNU,Z)=J(FNU,Z)* - // SIN(PI*FNU) IS A LARGE NEGATIVE POWER OF TEN. BUT WHEN FNU IS - // NOT A HALF ODD INTEGER, Y(FNU,Z) DOMINATES IN MAGNITUDE WITH A - // LARGE POSITIVE POWER OF TEN AND THE MOST THAT THE SECOND TERM - // CAN BE REDUCED IS BY UNIT ROUNDOFF FROM THE COEFFICIENT. THUS, - // WIDE CHANGES CAN OCCUR WITHIN UNIT ROUNDOFF OF A LARGE HALF - // ODD INTEGER. HERE, LARGE MEANS FNU.GT.CABS(Z). - // - // IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- - // MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS - // LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. - // CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN - // LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG - // IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS - // DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. - // IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS - // LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS - // MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE - // INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS - // RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3 - // ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION - // ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION - // ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN - // THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT - // TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS - // IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC. - // SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES. - // - // THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX - // BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT - // ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- - // SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE - // ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), - // ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF - // CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY - // HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN - // ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY - // SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER - // THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, - // 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS - // THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER - // COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY - // BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER - // COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE - // MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, - // THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, - // OR -PI/2+P. - // - //***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ - // AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF - // COMMERCE, 1955. - // - // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT - // BY D. E. AMOS, SAND83-0083, MAY, 1983. - // - // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT - // AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 - // - // A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX - // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- - // 1018, MAY, 1985 - // - // A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX - // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS. - // MATH. SOFTWARE, 1986 - // - //***ROUTINES CALLED ZBESH,I1MACH,D1MACH - //***END PROLOGUE ZBESY - - std::complex c1, c2, hci, st; - double elim, exr, exi, ey, tay, xx, yy, ascle, rtol, atol, tol, aa, bb, r1m5; - int i, k, k1, k2, nz, nz1, nz2; - - xx = std::real(z); - yy = std::imag(z); - *ierr = 0; - nz = 0; - - if ((xx == 0.0) && (yy == 0.0)) { *ierr = 1; } - if (fnu < 0.0) { *ierr = 1; } - if ((kode < 1) || (kode > 2)) { *ierr = 1; } - if (n < 1) { *ierr = 1; } - if (*ierr != 0) { return nz; } - - hci = std::complex(0.0, 0.5); - nz1 = besh(z, fnu, kode, 1, n, cy, ierr); - if ((*ierr != 0) && (*ierr != 3)) { return 0; } - - auto cwrk = std::unique_ptr[]> - {new (std::nothrow) std::complex[n]}; - if (cwrk == nullptr) { - *ierr = 6; // Memory allocation failed. - return 0; + if (nw >= 0) { + if (nw != 0) { + *nlast = n; + return nz; + } + ay = std::abs(cy[0]); + // + // SCALE BACKWARD RECURRENCE, BRY(3) IS DEFINED BUT NEVER USED + // + bry[0] = 1e3 * d1mach[0] / tol; + bry[1] = tol / 1e3 * d1mach[0]; + bry[2] = bry[1]; + iflag = 2; + ascle = bry[1]; + ax = 1.0; + cscl = ax; + if (ay <= bry[0]) { + iflag = 1; + ascle = bry[0]; + ax = 1.0 / tol; + cscl = ax; + } else { + if (ay >= bry[1]) { + iflag = 3; + ascle = bry[2]; + ax = tol; + cscl = ax; + } + } + ay = 1.0 / ax; + cscr = ay; + s1 = cy[1] * cscl; + s2 = cy[0] * cscl; + rz = 2.0 / z; + for (i = 1; i < (nui + 1); i++) { + st = s2; + s2 = (dfnu + fnui) * rz * st + s1; + s1 = st; + fnui -= 1.0; + if (iflag < 3) { + st = s2 * cscr; + str = fabs(std::real(st)); + sti = fabs(std::imag(st)); + stm = fmax(str, sti); + if (stm > ascle) { + iflag += 1; + ascle = bry[iflag - 1]; + s1 *= cscr; + s2 = st; + ax *= tol; + ay = 1.0 / ax; + cscl = ax; + cscr = ay; + s1 *= cscl; + s2 *= cscl; + } + } + } + y[n - 1] = s2 * cscr; + if (n == 1) { + return nz; + } + nl = n - 1; + fnui = nl; + k = nl; + for (i = 0; i < (nl + 1); i++) { + st = s2; + s2 = (fnu + fnui) * rz * s2 + s1; + s1 = st; + st = s2 * cscr; + y[k - 1] = st; + fnui -= 1.0; + k -= 1; + if (iflag < 3) { + st = s2 * cscr; + str = fabs(std::real(st)); + sti = fabs(std::imag(st)); + stm = fmax(str, sti); + if (stm > ascle) { + iflag += 1; + ascle = bry[iflag - 1]; + s1 *= cscr; + s2 = st; + ax *= tol; + ay = 1.0 / ax; + cscl = ax; + cscr = ay; + s1 *= cscl; + s2 *= cscl; + } + } + } + return nz; + } + nz = -1; + if (nw == -2) { + nz = -2; + } + return nz; } - nz2 = besh(z, fnu, kode, 2, n, cwrk.get(), ierr); - if ((*ierr != 0) && (*ierr != 3)) { return 0; } + inline int bunk( + std::complex z, double fnu, int kode, int mr, int n, std::complex *y, double tol, double elim, + double alim + ) { + + //***BEGIN PROLOGUE ZBUNK + //***REFER TO ZBESK,ZBESH + // + // ZBUNK COMPUTES THE K BESSEL FUNCTION FOR FNU.GT.FNUL. + // ACCORDING TO THE UNIFORM ASYMPTOTIC EXPANSION FOR K(FNU,Z) + // IN ZUNK1 AND THE EXPANSION FOR H(2,FNU,Z) IN ZUNK2 + // + //***ROUTINES CALLED ZUNK1,ZUNK2 + //***END PROLOGUE ZBUNK + + double ax, ay; + + int nz = 0; + ax = fabs(std::real(z)) * 1.7321; + ay = fabs(std::imag(z)); - nz = (nz1 > nz2 ? nz2 : nz1); - if (kode != 2) { - for (i = 1; i < (n+1); i++) - { - cy[i-1] = hci * (cwrk[i-1] - cy[i-1]); + if (ay <= ax) { + // + // Asymptotic expansion for K(FNU,Z) for large FNU applied in + // -PI/3 <= ARG(Z) <= PI/3 + // + nz = unk1(z, fnu, kode, mr, n, y, tol, elim, alim); + } else { + // + // Asymptotic expansion for H(2, FNU, Z*EXP(M*HPI)) for large FNU + // applied in PI/3 < ABS(ARG(Z)) <= PI/2 where M = +I or -I and HPI = PI/2 + // + nz = unk2(z, fnu, kode, mr, n, y, tol, elim, alim); } return nz; } - tol = fmax(d1mach[3], 1e-18); - k1 = i1mach[14]; - k2 = i1mach[15]; - r1m5 = d1mach[4]; - k = ( abs(k1) > abs(k2) ? abs(k2) : abs(k1) ); - // - // ELIM IS THE APPROXIMATE EXPONENTIAL UNDER- AND OVERFLOW LIMIT - // - elim = 2.303 * (k*r1m5 - 3.0); - exr = cos(xx); - exi = sin(xx); - ey = 0.0; - tay = fabs(yy + yy); - if (tay < elim) { ey = exp(-tay); } - if (yy < 0.0) { - /* 90 */ - c1 = std::complex(exr, exi); - c2 = ey*std::complex(exr, -exi); - } else { - c1 = ey*std::complex(exr, exi); - c2 = std::complex(exr, -exi); - } + inline double gamln(double z) { - nz = 0; - rtol = 1.0 / tol; - ascle = 1e3*d1mach[0]*rtol; - for (i = 1; i< (n+1); i++) - { - aa = std::real(cwrk[i-1]); - bb = std::imag(cwrk[i-1]); - atol = 1.0; - if (fmax(fabs(aa), fabs(bb)) <= ascle) { - aa *= rtol; - bb *= rtol; - atol = tol; - } + //***BEGIN PROLOGUE DGAMLN + //***DATE WRITTEN 830501 (YYMMDD) + //***REVISION DATE 830501 (YYMMDD) + //***CATEGORY NO. B5F + //***KEYWORDS GAMMA FUNCTION,LOGARITHM OF GAMMA FUNCTION + //***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES + //***PURPOSE TO COMPUTE THE LOGARITHM OF THE GAMMA FUNCTION + //***DESCRIPTION + // + // **** A DOUBLE PRECISION ROUTINE **** + // DGAMLN COMPUTES THE NATURAL LOG OF THE GAMMA FUNCTION FOR + // Z.GT.0. THE ASYMPTOTIC EXPANSION IS USED TO GENERATE VALUES + // GREATER THAN ZMIN WHICH ARE ADJUSTED BY THE RECURSION + // G(Z+1)=Z*G(Z) FOR Z.LE.ZMIN. THE FUNCTION WAS MADE AS + // PORTABLE AS POSSIBLE BY COMPUTIMG ZMIN FROM THE NUMBER OF BASE + // 10 DIGITS IN A WORD, RLN=AMAX1(-ALOG10(R1MACH(4)),0.5E-18) + // LIMITED TO 18 DIGITS OF (RELATIVE) ACCURACY. + // + // SINCE INTEGER ARGUMENTS ARE COMMON, A TABLE LOOK UP ON 100 + // VALUES IS USED FOR SPEED OF EXECUTION. + // + // DESCRIPTION OF ARGUMENTS + // + // INPUT Z IS D0UBLE PRECISION + // Z - ARGUMENT, Z.GT.0.0D0 + // + // OUTPUT DGAMLN IS DOUBLE PRECISION + // DGAMLN - NATURAL LOG OF THE GAMMA FUNCTION AT Z.NE.0.0D0 + // IERR - ERROR FLAG + // IERR=0, NORMAL RETURN, COMPUTATION COMPLETED + // IERR=1, Z.LE.0.0D0, NO COMPUTATION + // + // + //***REFERENCES COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT + // BY D. E. AMOS, SAND83-0083, MAY, 1983. + //***ROUTINES CALLED I1MACH,D1MACH + //***END PROLOGUE DGAMLN + + int i1m, mz; + double fln, fz, rln, s, tlg, trm, tst, t1, wdtol, zdmy, zinc, zm, zmin, zp, zsq; + const double con = 1.83787706640934548; /* LN(2*PI) */ + int nz = 0; + if (z > 0.0) { + if (z <= 101.0) { + nz = (int)z; + fz = z - nz; + if (fz <= 0.0) { + if (nz <= 100) { + return dgamln_gln[nz - 1]; + } + } + } + wdtol = fmax(d1mach[3], 1e-18); + i1m = i1mach[13]; + rln = d1mach[4] * i1m; + fln = fmax(fmin(rln, 20.), 3.0) - 3.0; + zm = 1.8 + 0.3875 * fln; + mz = ((int)zm) + 1; + zmin = mz; + zdmy = z; + zinc = 0.0; + if (z < zmin) { + zinc = zmin - nz; + zdmy = z + zinc; + } + zp = 1. / zdmy; + t1 = dgamln_cf[0] * zp; + s = t1; + if (zp >= wdtol) { + zsq = zp * zp; + tst = t1 * wdtol; + for (int i = 2; i < 23; i++) { + zp *= zsq; + trm = dgamln_cf[i - 1] * zp; + if (fabs(trm) < tst) { + break; + } + s += trm; + } + } - st = std::complex(aa, bb) * c2 * atol; - aa = std::real(cy[i-1]); - bb = std::imag(cy[i-1]); - atol = 1.0; - if (fmax(fabs(aa), fabs(bb)) <= ascle) { - aa *= rtol; - bb *= rtol; - atol = tol; + if (zinc == 0.) { + tlg = log(z); + return z * (tlg - 1.0) + 0.5 * (con - tlg) + s; + } + zp = 1.0; + nz = (int)zinc; + for (int i = 0; i < nz; i++) { + zp *= (z + i); + } + tlg = log(zdmy); + return zdmy * (tlg - 1.0) - log(zp) + 0.5 * (con - tlg) + s; } - - st -= std::complex(aa, bb) * c1 * atol; - cy[i-1] = st*hci; - if ((st == 0.0) && (ey == 0.0)) { nz += 1; } + // Zero or negative argument + return NAN; } - return nz; -} - - -inline int binu( - std::complex z, - double fnu, - int kode, - int n, - std::complex *cy, - double rl, - double fnul, - double tol, - double elim, - double alim -) { - - //***BEGIN PROLOGUE ZBINU - //***REFER TO ZBESH,ZBESI,ZBESJ,ZBESK,ZAIRY,ZBIRY - // - // ZBINU COMPUTES THE I FUNCTION IN THE RIGHT HALF Z PLANE - // - //***ROUTINES CALLED AZABS,ZASYI,ZBUNI,ZMLRI,ZSERI,ZUOIK,ZWRSK - //***END PROLOGUE ZBINU - - std::complex cw[2] = { 0. }; - double az, dfnu; - int inw, nlast, nn, nui, nw, nz; - - nz = 0; - az = std::abs(z); - nn = n; - dfnu = fnu + n - 1; - if ((az <= 2.) || (az*az*0.25 <= (dfnu + 1.0))) { - /* GOTO 10 */ - nw = seri(z,fnu, kode, n, cy, tol, elim, alim); - inw = abs(nw); - nz += inw; - nn -= inw; - if (nn == 0) { return nz; } - if (nw >= 0) { return nz; } - dfnu = fnu + nn - 1; - } - /* GOTO 30 conditions*/ - // - // ASYMPTOTIC EXPANSION FOR LARGE Z - // - if (az < rl) { - /* 40 */ - if (dfnu <= 1.0) { - /* 70 */ - // - // MILLER ALGORITHM NORMALIZED BY THE SERIES - // - nw = mlri(z, fnu, kode, n, cy, tol); - if (nw < 0) { - nz = -1; - if (nw == -2) { - nz = -2; - } - return nz; + inline int mlri(std::complex z, double fnu, int kode, int n, std::complex *y, double tol) { + + //***BEGIN PROLOGUE ZMLRI + //***REFER TO ZBESI,ZBESK + // + // ZMLRI COMPUTES THE I BESSEL FUNCTION FOR RE(Z).GE.0.0 BY THE + // MILLER ALGORITHM NORMALIZED BY A NEUMANN SERIES. + // + //***ROUTINES CALLED DGAMLN,D1MACH,AZABS,AZEXP,AZLOG,ZMLT + //***END PROLOGUE ZMLRI + + std::complex ck, cnorm, pt, p1, p2, rz, sum; + double ack, ak, ap, at, az, bk, fkap, fkk, flam, fnf, rho, rho2, scle, tfnf, tst, x; + int i, iaz, ifnu, inu, itime, k, kk, km, m, nz; + scle = d1mach[0] / tol; + nz = 0; + az = std::abs(z); + x = std::real(z); + iaz = (int)az; + ifnu = (int)fnu; + inu = ifnu + n - 1; + at = iaz + 1; + ck = at / z; + rz = 2. / z; + p1 = 0.; + p2 = 1.; + ack = (at + 1.0) / az; + rho = ack + sqrt(ack * ack - 1.); + rho2 = rho * rho; + tst = (rho2 + rho2) / ((rho2 - 1.0) * (rho - 1.0)); + tst /= tol; + // + // COMPUTE RELATIVE TRUNCATION ERROR INDEX FOR SERIES + // + ak = at; + i = 1; + for (i = 1; i < 81; i++) { + pt = p2; + p2 = p1 - ck * p2; + p1 = pt; + ck += rz; + ap = std::abs(p2); + if (ap > tst * ak * ak) { + break; + } + ak += 1.0; + if (i == 80) { + /* Exhausted loop without break */ + return -2; } - return nz; } - /* GO TO 50 */ - } else { - if ((dfnu <= 1.0) || (az+az >= dfnu*dfnu)) { - /* 30 */ + i += 1; + k = 0; + if (inu >= iaz) { // - // ASYMPTOTIC EXPANSION FOR LARGE Z + // COMPUTE RELATIVE TRUNCATION ERROR FOR RATIOS // - nw = asyi(z, fnu, kode, n, cy, rl, tol, elim, alim); - if (nw < 0) { - nz = -1; - if (nw == -2) { - nz = -2; + p1 = 0.0; + p2 = 1.0; + at = inu + 1; + ck = at / z; + ack = at / az; + tst = sqrt(ack / tol); + itime = 1; + k = 1; + for (k = 1; k < 81; k++) { + pt = p2; + p2 = p1 - ck * p2; + p1 = pt; + ck += rz; + ap = std::abs(p2); + if (ap >= tst) { + if (itime == 2) { + break; + } + ack = std::abs(ck); + flam = ack + sqrt(ack * ack - 1.0); + fkap = ap / std::abs(p1); + rho = fmin(flam, fkap); + tst *= sqrt(rho / (rho * rho - 1.0)); + itime = 2; + } + if (k == 80) { + /* Exhausted loop without break */ + return -2; } - return nz; } - return nz; } - /* GO TO 50 */ - } - /* 50 */ - // - // OVERFLOW AND UNDERFLOW TEST ON I SEQUENCE FOR MILLER ALGORITHM - // - nw = uoik(z, fnu, kode, 1, nn, cy, tol, elim, alim); - if (nw < 0) { - nz = -1; - if (nw == -2) { nz = -2; } + // + // BACKWARD RECURRENCE AND SUM NORMALIZING RELATION + // + k += 1; + kk = fmax(i + iaz, k + inu); + fkk = kk; + p1 = 0.0; + // + // SCALE P2 AND SUM BY SCLE + // + p2 = scle; + fnf = fnu - ifnu; + tfnf = fnf + fnf; + bk = gamln(fkk + tfnf + 1.0) - gamln(fkk + 1.0) - gamln(tfnf + 1.0); + bk = exp(bk); + sum = 0.; + km = kk - inu; + for (i = 1; i < (km + 1); i++) { + pt = p2; + p2 = p1 + (fkk + fnf) * rz * p2; + p1 = pt; + ak = 1. - tfnf / (fkk + tfnf); + ack = bk * ak; + sum += (ack + bk) * p1; + bk = ack; + fkk -= 1.; + } + y[n - 1] = p2; + if (n != 1) { + for (i = 2; i < (n + 1); i++) { + pt = p2; + p2 = p1 + (fkk + fnf) * rz * p2; + p1 = pt; + ak = 1. - tfnf / (fkk + tfnf); + ack = bk * ak; + sum += (ack + bk) * p1; + bk = ack; + fkk -= 1.; + m = n - i + 1; + y[m - 1] = p2; + } + } + if (ifnu > 0) { + for (i = 1; i < (ifnu + 1); i++) { + pt = p2; + p2 = p1 + (fkk + fnf) * rz * p2; + p1 = pt; + ak = 1. - tfnf / (fkk + tfnf); + ack = bk * ak; + sum += (ack + bk) * p1; + bk = ack; + fkk -= 1.; + } + } + pt = z; + if (kode == 2) { + pt -= x; + } + p1 = -fnf * std::log(rz) + pt; + ap = gamln(1. + fnf); + pt = p1 - ap; + // + // THE DIVISION EXP(PT)/(SUM+P2) IS ALTERED TO AVOID OVERFLOW + // IN THE DENOMINATOR BY SQUARING LARGE QUANTITIES + // + p2 += sum; + ap = std::abs(p2); + p1 = 1. / ap; + ck = std::exp(pt) * p1; + pt = conj(p2) * p1; + cnorm = ck * pt; + for (int i = 0; i < n; i++) { + y[i] *= cnorm; + } return nz; } - nz += nw; - nn -= nw; - if (nn == 0) { return nz; } - dfnu = fnu + (nn -1); - /* GOTO 110s handled here */ - if ((dfnu > fnul) || (az > fnul)) { - // - // INCREMENT FNU+NN-1 UP TO FNUL, COMPUTE AND RECUR BACKWARD - // - nui = (int)(fnul-dfnu) + 1; - nui = (nui > 0 ? nui : 0); - nw = buni(z, fnu, kode, nn, cy, nui, &nlast, fnul, tol, elim, alim); - if (nw < 0) { - nz = -1; - if (nw == -2) { nz = -2; } + + inline int kscl( + std::complex zr, double fnu, int n, std::complex *y, std::complex rz, double *ascle, + double tol, double elim + ) { + + //***BEGIN PROLOGUE ZKSCL + //***REFER TO ZBESK + // + // SET K FUNCTIONS TO ZERO ON UNDERFLOW, CONTINUE RECURRENCE + // ON SCALED FUNCTIONS UNTIL TWO MEMBERS COME ON SCALE, THEN + // RETURN WITH MIN(NZ+2,N) VALUES SCALED BY 1/TOL. + // + //***ROUTINES CALLED ZUCHK,AZABS,AZLOG + //***END PROLOGUE ZKSCL + + std::complex cy[2] = {0.}; + double as, acs, alas, fn, zri, xx; + std::complex s1, s2, cs, ck, zd; + int nz = 0; + int ic = 0; + int nn = (n > 2 ? 2 : n); + int kk = 0; + int i; + double elm = exp(-elim); + xx = std::real(zr); + + for (i = 1; i < (nn + 1); i++) { + s1 = y[i - 1]; + cy[i - 1] = s1; + as = std::abs(s1); + acs = -std::real(zr) + log(as); + nz += 1; + y[i - 1] = 0.; + if (acs < -elim) { + continue; + } + cs = -zr + std::log(s1); + cs = (exp(std::real(cs)) / tol) * (cos(std::imag(cs)) + sin(std::imag(cs) * std::complex(0, 1))); + if (!uchk(cs, *ascle, tol)) { + y[i - 1] = cs; + nz -= 1; + ic = i; + } + } + if (n == 1) { return nz; } - nz += nw; - if (nlast == 0) { return nz; } - nn = nlast; - } - /* 60 */ - if (az <= rl) { - /* 70 */ - nw = mlri(z, fnu, kode, n, cy, tol); - if (nw < 0) { - nz = -1; - if (nw == -2) { nz = -2; } + if (ic <= 1) { + y[0] = 0.; + nz = 2; + } + if (n == 2) { return nz; } - return nz; - } - /* 80 */ - // - // MILLER ALGORITHM NORMALIZED BY THE WRONSKIAN - // - // - // OVERFLOW TEST ON K FUNCTIONS USED IN WRONSKIAN - // - nw = uoik(z, fnu, kode, 2, 2, cw, tol, elim, alim); - if (nw < 0) { - nz = nn; - /* 90 */ - for (int i=0; i < nn; i++) { cy[i] = 0.0; } - return nz; - } - /* 100 */ - if (nw > 0) { - return -1; - } - nw = wrsk(z, fnu, kode, nn, cy, cw, tol, elim, alim); - if (nw < 0) { - nz = -1; - if (nw == -2) { - nz = -2; + if (nz == 0) { + return nz; } - return nz; - } - return nz; -} - - -inline std::complex biry( - std::complex z, - int id, - int kode, - int *ierr -) { - - //***BEGIN PROLOGUE ZBIRY - //***DATE WRITTEN 830501 (YYMMDD) - //***REVISION DATE 890801 (YYMMDD) - //***CATEGORY NO. B5K - //***KEYWORDS AIRY FUNCTION,BESSEL FUNCTIONS OF ORDER ONE THIRD - //***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES - //***PURPOSE TO COMPUTE AIRY FUNCTIONS BI(Z) AND DBI(Z) FOR COMPLEX Z - //***DESCRIPTION - // - // ***A DOUBLE PRECISION ROUTINE*** - // ON KODE=1, CBIRY COMPUTES THE COMPLEX AIRY FUNCTION BI(Z) OR - // ITS DERIVATIVE DBI(Z)/DZ ON ID=0 OR ID=1 RESPECTIVELY. ON - // KODE=2, A SCALING OPTION CEXP(-AXZTA)*BI(Z) OR CEXP(-AXZTA)* - // DBI(Z)/DZ IS PROVIDED TO REMOVE THE EXPONENTIAL BEHAVIOR IN - // BOTH THE LEFT AND RIGHT HALF PLANES WHERE - // ZTA=(2/3)*Z*CSQRT(Z)=std::complex(XZTA,YZTA) AND AXZTA=ABS(XZTA). - // DEFINITIONS AND NOTATION ARE FOUND IN THE NBS HANDBOOK OF - // MATHEMATICAL FUNCTIONS (REF. 1). - // - // INPUT ZR,ZI ARE DOUBLE PRECISION - // ZR,ZI - Z=std::complex(ZR,ZI) - // ID - ORDER OF DERIVATIVE, ID=0 OR ID=1 - // KODE - A PARAMETER TO INDICATE THE SCALING OPTION - // KODE= 1 RETURNS - // BI=BI(Z) ON ID=0 OR - // BI=DBI(Z)/DZ ON ID=1 - // = 2 RETURNS - // BI=CEXP(-AXZTA)*BI(Z) ON ID=0 OR - // BI=CEXP(-AXZTA)*DBI(Z)/DZ ON ID=1 WHERE - // ZTA=(2/3)*Z*CSQRT(Z)=std::complex(XZTA,YZTA) - // AND AXZTA=ABS(XZTA) - // - // OUTPUT BIR,BII ARE DOUBLE PRECISION - // BIR,BII- COMPLEX ANSWER DEPENDING ON THE CHOICES FOR ID AND - // KODE - // IERR - ERROR FLAG - // IERR=0, NORMAL RETURN - COMPUTATION COMPLETED - // IERR=1, INPUT ERROR - NO COMPUTATION - // IERR=2, OVERFLOW - NO COMPUTATION, REAL(Z) - // TOO LARGE ON KODE=1 - // IERR=3, CABS(Z) LARGE - COMPUTATION COMPLETED - // LOSSES OF SIGNIFCANCE BY ARGUMENT REDUCTION - // PRODUCE LESS THAN HALF OF MACHINE ACCURACY - // IERR=4, CABS(Z) TOO LARGE - NO COMPUTATION - // COMPLETE LOSS OF ACCURACY BY ARGUMENT - // REDUCTION - // IERR=5, ERROR - NO COMPUTATION, - // ALGORITHM TERMINATION CONDITION NOT MET - // - //***LONG DESCRIPTION - // - // BI AND DBI ARE COMPUTED FOR CABS(Z).GT.1.0 FROM THE I BESSEL - // FUNCTIONS BY - // - // BI(Z)=C*SQRT(Z)*( I(-1/3,ZTA) + I(1/3,ZTA) ) - // DBI(Z)=C * Z * ( I(-2/3,ZTA) + I(2/3,ZTA) ) - // C=1.0/SQRT(3.0) - // ZTA=(2/3)*Z**(3/2) - // - // WITH THE POWER SERIES FOR CABS(Z).LE.1.0. - // - // IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- - // MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z IS LARGE, LOSSES - // OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. CONSEQUENTLY, IF - // THE MAGNITUDE OF ZETA=(2/3)*Z**1.5 EXCEEDS U1=SQRT(0.5/UR), - // THEN LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR - // FLAG IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS - // DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. - // ALSO, IF THE MAGNITUDE OF ZETA IS LARGER THAN U2=0.5/UR, THEN - // ALL SIGNIFICANCE IS LOST AND IERR=4. IN ORDER TO USE THE INT - // FUNCTION, ZETA MUST BE FURTHER RESTRICTED NOT TO EXCEED THE - // LARGEST INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF ZETA - // MUST BE RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, - // AND U3 ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE - // PRECISION ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE - // PRECISION ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMIT- - // ING IN THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT THE MAG- - // NITUDE OF Z CANNOT EXCEED 3.1E+4 IN SINGLE AND 2.1E+6 IN - // DOUBLE PRECISION ARITHMETIC. THIS ALSO MEANS THAT ONE CAN - // EXPECT TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, - // NO DIGITS IN SINGLE PRECISION AND ONLY 7 DIGITS IN DOUBLE - // PRECISION ARITHMETIC. SIMILAR CONSIDERATIONS HOLD FOR OTHER - // MACHINES. - // - // THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX - // BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT - // ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- - // SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE - // ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), - // ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF - // CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY - // HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN - // ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY - // SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER - // THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, - // 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS - // THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER - // COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY - // BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER - // COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE - // MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, - // THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, - // OR -PI/2+P. - // - //***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ - // AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF - // COMMERCE, 1955. - // - // COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT - // AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 - // - // A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX - // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- - // 1018, MAY, 1985 - // - // A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX - // ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS. - // MATH. SOFTWARE, 1986 - // - //***ROUTINES CALLED ZBINU,AZABS,ZDIV,AZSQRT,D1MACH,I1MACH - //***END PROLOGUE ZBIRY - - std::complex bi, csq, s1, s2, trm1, trm2, zta, z3; - double aa, ad, ak, alim, atrm, az, az3, bb, bk, ck, dig, dk, d1, d2,\ - elim, fid, fmr, fnu, fnul, rl, r1m5, sfac, tol, zi, zr; - int k, k1, k2, nz; - std::complex cy[2] = { 0.0 }; - double tth = 2. / 3.; - double c1 = 0.614926627446000735150922369; /* 1/( 3**(1/6) Gamma(2/3)) */ - double c2 = 0.448288357353826357914823710; /* 3**(1/6) / Gamma(1/3) */ - double coef = 0.577350269189625764509148780; /* sqrt( 1 / 3) */ - double pi = 3.141592653589793238462643383; - - *ierr = 0; - nz = 0; - if ((id < 0) || (id > 1)) { *ierr= 1; } - if ((kode < 1) || (kode > 2)) { *ierr= 1; } - if ( *ierr != 0) { return 0.0;} - az = std::abs(z); - tol = fmax(d1mach[3], 1e-18); - fid = id; - if (az <= 1.0) { - // - // POWER SERIES FOR ABS(Z) <= 1. - // - s1 = 1.0; - s2 = 1.0; - if (az < tol) { - aa = c1*(1.0 - fid) + fid*c2; - return aa; - } - aa = az*az; - if (aa >= tol/az) { - trm1 = 1.0; - trm2 = 1.0; - atrm = 1.0; - z3 = z*z*z; - az3 = az * aa; - ak = 2.0 + fid; - bk = 3.0 - fid - fid; - ck = 4.0 - fid; - dk = 3.0 + fid + fid; - d1 = ak * dk; - d2 = bk * ck; - ad = fmin(d1,d2); - ak = 24.0 + 9.0*fid; - bk = 30.0 - 9.0*fid; - for (k = 1; k < 26; k++) - { - trm1 *= z3/d1; - s1 += trm1; - trm2 *= z3/d2; - s2 += trm2; - atrm *= az3 / ad; - d1 += ak; - d2 += bk; - ad = fmin(d1, d2); - if (atrm < tol*ad) { break; } - ak += 18.0; - bk += 18.0; + + fn = fnu + 1.; + ck = fn * rz; + s1 = cy[0]; + s2 = cy[1]; + zri = std::imag(zr); + zd = zr; + for (i = 3; i < (n + 1); i++) { + kk = i; + cs = s2; + s2 *= ck; + s2 += s1; + s1 = cs; + ck += rz; + as = std::abs(s2); + alas = log(as); + acs = alas - xx; + nz += 1; + y[i - 1] = 0.; + if (acs >= -elim) { + cs = std::log(s2); + cs -= zd; + cs = (exp(std::real(cs)) / tol) * std::complex(cos(std::imag(cs)), sin(std::imag(cs))); + if (!uchk(cs, *ascle, tol)) { + y[i - 1] = cs; + nz -= 1; + if (ic == kk - 1) { + nz = kk - 2; + for (int i = 0; i < nz; i++) { + y[i] = 0.; + } + return nz; + } + ic = kk; + continue; + } + } + if (alas >= 0.5 * elim) { + xx -= elim; + zd = std::complex(xx, zri); + s1 *= elm; + s2 *= elm; } - /* 30 */ } - /* 40 */ - if (id != 1) { - bi = s1*c1 + z*s2*c2; - if (kode == 1) { return bi; } - zta = z*std::sqrt(z)*tth; - aa = -fabs(std::real(zta)); - bi *= exp(aa); - return bi; + nz = n; + if (ic == n) { + nz = n - 1; } - /* 50 */ - bi = s2*c2; - if (az > tol) { bi += z*z*s1*c1/(1.0 + fid ); } - if (kode == 1) { return bi; } - zta = z*std::sqrt(z)*tth; - aa = -fabs(std::real(zta)); - bi *= exp(aa); - return bi; - } - /* 70 */ - // - // CASE FOR ABS(Z) > 1.0 - // - fnu = (1.0 + fid) / 3.0; - // - // SET PARAMETERS RELATED TO MACHINE CONSTANTS. - // TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. - // ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. - // EXP(-ELIM) < EXP(-ALIM)=EXP(-ELIM)/TOL AND - // EXP(ELIM) > EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR - // UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. - // RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. - // DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). - // FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU. - // - k1 = i1mach[14]; - k2 = i1mach[15]; - r1m5 = d1mach[4]; - k = ( abs(k1) > abs(k2) ? abs(k2) : abs(k1) ); - elim = 2.303 * (k*r1m5 - 3.0); - k1 = i1mach[13] - 1; - aa = r1m5*k1; - dig = fmin(aa, 18.0); - aa *= 2.303; - alim = elim + fmax(-aa, -41.45); - rl = 1.2*dig + 3.0; - fnul = 10.0 + 6.0*(dig - 3.0); - // - // TEST FOR RANGE - // - aa = 0.5 / tol; - bb = i1mach[8] * 0.5; - aa = fmin(aa, bb); - aa = pow(aa, tth); - if (az > aa) { *ierr = 4; return 0.0; } - aa = sqrt(aa); - if (az > aa) { *ierr = 3; } - csq = std::sqrt(z); - zta = z*csq*tth; - // - // RE(ZTA) <= 0 WHEN RE(Z) < 0, ESPECIALLY WHEN IM(Z) IS SMALL - // - sfac = 1.0; - zi = std::imag(z); - zr = std::real(z); - ak = std::imag(zta); - if (zr < 0.0) { - bk = std::real(zta); - ck = -fabs(bk); - zta = std::complex(ck, ak); + + for (int i = 0; i < nz; i++) { + y[i] = 0.; + } + return nz; } - /* 80 */ - if ((zi == 0.0) && (zr <= 0.0)) { zta = std::complex(0.0, ak); } - /* 90 */ - aa = std::real(zta); - if (kode != 2) { + + inline void rati(std::complex z, double fnu, int n, std::complex *cy, double tol) { + + //***BEGIN PROLOGUE ZRATI + //***REFER TO ZBESI,ZBESK,ZBESH // - // OVERFLOW TEST + // ZRATI COMPUTES RATIOS OF I BESSEL FUNCTIONS BY BACKWARD + // RECURRENCE. THE STARTING INDEX IS DETERMINED BY FORWARD + // RECURRENCE AS DESCRIBED IN J. RES. OF NAT. BUR. OF STANDARDS-B, + // MATHEMATICAL SCIENCES, VOL 77B, P111-114, SEPTEMBER, 1973, + // BESSEL FUNCTIONS I AND J OF COMPLEX ARGUMENT AND INTEGER ORDER, + // BY D. J. SOOKNE. // - bb = fabs(aa); - if (bb >= alim) { - bb += 0.25*log(az); - sfac = tol; - if (bb > elim) { *ierr = 2; return 0.0; } + //***ROUTINES CALLED AZABS,ZDIV + //***END PROLOGUE ZRATI + + std::complex cdfnu, pt, p1, p2, rz, t1; + double ak, amagz, ap1, ap2, arg, az, dfnu, fdnu, flam, fnup, rap1, rho, test, test1; + int i, id, idnu, inu, itime, k, kk, magz; + + az = std::abs(z); + inu = (int)fnu; + idnu = inu + n - 1; + fdnu = idnu; + magz = az; + amagz = magz + 1; + fnup = fmax(amagz, fdnu); + id = idnu - magz - 1; + itime = 1; + k = 1; + rz = 2.0 / z; + t1 = fnup * rz; + p2 = -t1; + p1 = 1.0; + t1 += rz; + if (id > 0) { + id = 0; } - } - /* 100 */ - fmr = 0.0; - if ((aa < 0.0) || (zr <= 0.0)) { - fmr = pi; - if (zi < 0.0) { fmr = -pi; } - zta = -zta; - } - /* 110 */ - // - // AA=FACTOR FOR ANALYTIC CONTINUATION OF I(FNU,ZTA) - // KODE=2 RETURNS EXP(-ABS(XZTA))*I(FNU,ZTA) FROM CBINU - // - nz = binu(zta, fnu, kode, 1, cy, rl, fnul, tol, elim, alim); - if (nz < 0) { - if (nz == -1) { - *ierr = 2; - } else { - *ierr = 5; + ap2 = std::abs(p2); + ap1 = std::abs(p1); + + // + // THE OVERFLOW TEST ON K(FNU+I-1,Z) BEFORE THE CALL TO CBKNX + // GUARANTEES THAT P2 IS ON SCALE. SCALE TEST1 AND ALL SUBSEQUENT P2 + // VALUES BY AP1 TO ENSURE THAT AN OVERFLOW DOES NOT OCCUR PREMATURELY. + // + arg = (ap2 + ap2) / (ap1 * tol); + test1 = sqrt(arg); + test = test1; + rap1 = 1.0 / ap1; + p1 *= rap1; + p2 *= rap1; + ap2 *= rap1; + + while (1) { + k += 1; + ap1 = ap2; + pt = p2; + p2 = p1 - t1 * p2; + p1 = pt; + t1 += rz; + ap2 = std::abs(p2); + if (ap1 > test) { + break; + } + if (itime != 2) { + ak = std::abs(t1) * 0.5; + flam = ak + sqrt(ak * ak - 1.0); + rho = fmin(ap2 / ap1, flam); + test = test1 * sqrt(rho / (rho * rho - 1.0)); + itime = 2; + } } - return 0.0; - } - aa = fmr*fnu; - z3 = sfac; - s1 = cy[0] * std::complex(cos(aa), sin(aa)) * z3; - fnu = (2.0 - fid) / 3.0; - nz = binu(zta, fnu, kode, 2, cy, rl, fnul, tol, elim, alim); - cy[0] *= z3; - cy[1] *= z3; - // - // BACKWARD RECUR ONE STEP FOR ORDERS -1/3 OR -2/3 - // - s2 = cy[0] * (fnu+fnu) / zta + cy[1]; - aa = fmr * (fnu - 1.0); - s1 = (s1 + s2*std::complex(cos(aa), sin(aa)))*coef; - if (id != 1) { - s1 *= csq; - bi = s1 / sfac; - return bi; + kk = k + 1 - id; + ak = kk; + dfnu = fnu + n - 1; + cdfnu = dfnu; + t1 = ak; + p1 = 1.0 / ap2; + p2 = 0.0; + + for (i = 1; i < (kk + 1); i++) { + pt = p1; + p1 = rz * (cdfnu + t1) * p1 + p2; + p2 = pt; + t1 -= 1.0; + } + + if (p1 == 0.) { + p1 = std::complex(0, 0); + } + + cy[n - 1] = p2 / p1; + if (n == 1) { + return; + } + k = n - 1; + ak = k; + t1 = ak; + cdfnu = fnu * rz; + + for (i = 2; i < (n + 1); i++) { + pt = cdfnu + t1 * rz * cy[k]; + if (pt == 0.0) { + pt = std::complex(tol, tol); + } + cy[k - 1] = 1.0 / pt; + t1 -= 1.0; + k -= 1; + } + return; } - /* 120 */ - s1 *= z; - bi = s1 / sfac; - return bi; -} - - -inline int bknu( - std::complex z, - double fnu, - int kode, - int n, - std::complex *y, - double tol, - double elim, - double alim -) { - - //***BEGIN PROLOGUE ZBKNU - //***REFER TO ZBESI,ZBESK,ZAIRY,ZBESH - // - // ZBKNU COMPUTES THE K BESSEL FUNCTION IN THE RIGHT HALF Z PLANE. - // - //***ROUTINES CALLED DGAMLN,I1MACH,D1MACH,ZKSCL,ZSHCH,ZUCHK,AZABS,ZDIV, - // AZEXP,AZLOG,ZMLT,AZSQRT - //***END PROLOGUE ZBKNU - - std::complex cch, ck, coef, crsc, cs, cscl, csh, cz,\ - f, fmu, p, pt, p1, p2, q, rz, smu, st, s1, s2, zd; - double aa, ak, ascle, a1, a2, bb, bk, caz, dnu, dnu2, etest, fc, fhs,\ - fk, fks, g1, g2, p2i, p2m, p2r, rk, s, tm, t1, t2, xx, yy,\ - elm, xd, yd, alas, as; - int iflag, inu, k, kflag, kk, koded, j, ic, inub, i = 1; - std::complex cy[2]; - - int kmax =30; - double r1 = 2.; - double pi = 3.14159265358979324; - double rthpi = 1.25331413731550025; - double spi = 1.90985931710274403; - double hpi = 1.57079632679489662; - double fpi = 1.89769999331517738; - double tth = 2. / 3.; - double cc[8] = { - 5.77215664901532861e-01, -4.20026350340952355e-02, - -4.21977345555443367e-02, 7.21894324666309954e-03, - -2.15241674114950973e-04, -2.01348547807882387e-05, - 1.13302723198169588e-06, 6.11609510448141582e-09 - }; - xx = std::real(z); - yy = std::imag(z); - caz = std::abs(z); - cscl = 1. / tol; - crsc = tol; - std::complex css[3] = {cscl, 1., crsc}; - std::complex csr[3] = {crsc, 1., cscl}; - double bry[3] = {1e3*d1mach[0]/tol, tol/(1e3*d1mach[0]), d1mach[1]}; - int nz = 0; - iflag = 0; - koded = kode; - rz = 2. / z; - inu = (int)(fnu + 0.5); - dnu = fnu - inu; - // Definitions for silencing initialization warnings. - s1 = 0.0; - s2 = 0.0; - ck = 0.0; - dnu2 = 0.0; - if (fabs(dnu) != 0.5) { - if (fabs(dnu) > tol) { dnu2 = dnu * dnu; } - if (caz <= r1) { + + inline int seri( + std::complex z, double fnu, int kode, int n, std::complex *y, double tol, double elim, + double alim + ) { + + //***BEGIN PROLOGUE ZSERI + //***REFER TO ZBESI,ZBESK + // + // ZSERI COMPUTES THE I BESSEL FUNCTION FOR REAL(Z).GE.0.0 BY + // MEANS OF THE POWER SERIES FOR LARGE CABS(Z) IN THE + // REGION CABS(Z).LE.2*SQRT(FNU+1). NZ=0 IS A NORMAL RETURN. + // NZ.GT.0 MEANS THAT THE LAST NZ COMPONENTS WERE SET TO ZERO + // DUE TO UNDERFLOW. NZ.LT.0 MEANS UNDERFLOW OCCURRED, BUT THE + // CONDITION CABS(Z).LE.2*SQRT(FNU+1) WAS VIOLATED AND THE + // COMPUTATION MUST BE COMPLETED IN ANOTHER ROUTINE WITH N=N-ABS(NZ). + // + //***ROUTINES CALLED DGAMLN,D1MACH,ZUCHK,AZABS,ZDIV,AZLOG,ZMLT + //***END PROLOGUE ZSERI + + std::complex ak1, ck, coef, crsc, cz, half_z, rz, s1, s2, w[2]; + double aa, acz, ak, arm, ascle, atol, az, dfnu, fnup, rak1, rs, rtr1, s, ss, x; + int ib, iflag, il, k, l, m, nn; + + int nz = 0; + az = std::abs(z); + if (az == 0.0) { + y[0] = 0.0; + if (fnu == 0.) { + y[0] = 1.0; + } + if (n == 1) { + return nz; + } + for (int i = 1; i < n; i++) { + y[i] = 0.0; + } + return nz; + } + x = std::real(z); + arm = 1e3 * d1mach[0]; + rtr1 = sqrt(arm); + crsc = 1.0; + iflag = 0; + if (az >= arm) { + half_z = 0.5 * z; + cz = 0.0; + if (az > rtr1) { + cz = half_z * half_z; + } + acz = std::abs(cz); + nn = n; + ck = std::log(half_z); + L10: + dfnu = fnu + (nn - 1); + fnup = dfnu + 1.0; // - // SERIES FOR ABS(Z) <= R1 + // UNDERFLOW TEST // - fc = 1.; - smu = std::log(rz); - fmu = smu * dnu; - csh = std::sinh(fmu); - cch = std::cosh(fmu); - if (dnu != 0.0) { - fc = dnu * pi; - fc *= 1. / sin(fc); - smu = csh / dnu; - } - a2 = 1. + dnu; + ak1 = ck * dfnu; + ak = gamln(fnup); + ak1 -= ak; + if (kode == 2) { + ak1 -= x; + } + rak1 = std::real(ak1); + if (rak1 > -elim) { + goto L30; + } + L20: + nz += 1; + y[nn - 1] = 0.0; // - // GAM(1-Z)*GAM(1+Z)=PI*Z/SIN(PI*Z), T1=1/GAM(1-DNU), T2=1/GAM(1+DNU) + // RETURN WITH NZ < 0 IF ABS(Z*Z/4) > FNU+N-NZ-1 COMPLETE + // THE CALCULATION IN CBINU WITH N=N-ABS(NZ) // - t2 = exp(-gamln(a2)); - t1 = 1. / (t2*fc); - if (fabs(dnu) <= 0.1) { - // - // SERIES FOR F0 TO RESOLVE INDETERMINACY FOR SMALL ABS(DNU) - // - ak = 1.; - s = cc[0]; - for (int k = 2; k < 9; k++) - { - ak *= dnu2; - tm = cc[k-1] * ak; - s += tm; - if (fabs(tm) < tol) { break; } + if (acz > dfnu) { + return -nz; + } + nn -= 1; + if (nn == 0) { + return nz; + } + goto L10; + L30: + if (rak1 <= -alim) { + iflag = 1; + ss = 1.0 / tol; + crsc = tol; + ascle = arm * ss; + } + ak = std::imag(ak1); + aa = exp(rak1); + if (iflag == 1) { + aa *= ss; + } + coef = aa * std::complex(cos(ak), sin(ak)); + atol = tol * acz / fnup; + il = (nn > 2 ? 2 : nn); + for (int i = 1; i < (il + 1); i++) { + dfnu = fnu + (nn - i); + fnup = dfnu + 1.0; + s1 = 1.0; + if (acz >= tol * fnup) { + ak1 = 1.0; + ak = fnup + 2.0; + s = fnup; + aa = 2.0; + while (1) { + rs = 1.0 / s; + ak1 *= cz; + ak1 *= rs; + s1 += ak1; + s += ak; + ak += 2.0; + aa *= acz; + aa *= rs; + if (aa <= atol) { + break; + } + } } - g1 = -s; - } else { - g1 = (t1-t2) / (dnu+dnu); - } - g2 = 0.5 * (t1+t2); - f = fc*(g1*cch + smu*g2); - pt = std::exp(fmu); - p = (0.5 / t2) * pt; - q = (0.5 / t1) / pt; - s1 = f; - s2 = p; - ak = 1.0; - a1 = 1.0; - ck = 1.0; - bk = 1.0 - dnu2; - if ((inu <= 0) && (n <= 1)) { - // - // GENERATE K(FNU,Z), 0.0D0 <= FNU < 0.5D0 AND N=1 - // - if (caz >= tol) { - cz = z * z * 0.25; - t1 = 0.25 * caz * caz; - do { - f = (f*ak + p + q) / bk; - p = p / (ak-dnu); - q = q / (ak+dnu); - rk = 1.0 / ak; - ck *= cz * rk; - s1 += ck * f; - a1 *= t1 * rk; - bk += ak + ak + 1.0; - ak += 1.0; - } while (a1 > tol); + s2 = s1 * coef; + w[i - 1] = s2; + if (iflag != 0) { + if (uchk(s2, ascle, tol)) { + goto L20; + } } - y[0] = s1; - if (koded == 1) { return nz; } - y[0] = s1 * std::exp(z); + m = nn - i + 1; + y[m - 1] = s2 * crsc; + if (i != il) { + coef *= dfnu / half_z; + } + } + if (nn <= 2) { return nz; } + k = nn - 2; + ak = k; + rz = 2.0 / z; + if (iflag == 1) { + goto L80; + } + ib = 3; + L60: + for (int i = ib; i < (nn + 1); i++) { + y[k - 1] = (ak + fnu) * rz * y[k] + y[k + 1]; + ak -= 1.0; + k -= 1; + } + return nz; + L80: + // + // RECUR BACKWARD WITH SCALED VALUES // - // GENERATE K(DNU,Z) AND K(DNU+1,Z) FOR FORWARD RECURRENCE // - if (caz >= tol) { - cz = z * z * 0.25; - t1 = 0.25 * caz * caz; - do { - f = (f*ak + p + q) / bk; - p *= 1.0 / (ak - dnu); - q *= 1.0 / (ak + dnu); - rk = 1. / ak; - ck *= cz * rk; - s1 += ck * f; - s2 += ck * (p - f*ak); - a1 *= t1 * rk; - bk += ak + ak + 1.0; - ak += 1.0; - } while (a1 > tol); - } - kflag = 2; - bk = std::real(smu); - a1 = fnu + 1.; - ak = a1 * fabs(bk); - if (ak > alim) { kflag = 3; } - p2 = s2 * css[kflag-1]; - s2 = p2 * rz; - s1 *= css[kflag-1]; - if (koded != 1) { - f = std::exp(z); - s1 *= f; - s2 *= f; + // EXP(-ALIM)=EXP(-ELIM)/TOL=APPROX. ONE PRECISION ABOVE THE + // UNDERFLOW LIMIT = ASCLE = D1MACH(1)*SS*1000 + // + s1 = w[0]; + s2 = w[1]; + l = 3; + for (int l = 3; l < (nn + 1); l++) { + ck = s2; + s2 = s1 + (ak + fnu) * rz * s2; + s1 = ck; + ck = s2 * crsc; + y[k - 1] = ck; + ak -= 1.0; + k -= 1; + if (std::abs(ck) > ascle) { + goto L100; + } } - goto L100; + return nz; + L100: + ib = l + 1; + if (ib > nn) { + return nz; + } + goto L60; } - } - // - // IFLAG=0 MEANS NO UNDERFLOW OCCURRED - // IFLAG=1 MEANS AN UNDERFLOW OCCURRED- COMPUTATION PROCEEDS WITH - // KODED=2 AND A TEST FOR ON SCALE VALUES IS MADE DURING FORWARD - // RECURSION - // - coef = rthpi / std::sqrt(z); - kflag = 2; - if (koded != 2) { - if (xx > alim) { - koded = 2; - iflag = 1; - kflag = 2; - } else { - a1 = exp(-xx)*std::real(css[kflag-1]); - pt = a1*std::complex(cos(yy), -sin(yy)); - coef *= pt; + nz = n; + if (fnu == 0.0) { + nz -= 1; + } + y[0] = 0.0; + if (fnu == 0.) { + y[0] = 1.0; + } + if (n == 1) { + return nz; } + for (int i = 1; i < n; i++) { + y[i] = 0.0; + } + return nz; } - if (fabs(dnu) == 0.5) { - s1 = coef; - s2 = coef; - goto L100; - } -// -// MILLER ALGORITHM FOR ABS(Z) > R1 -// - ak = fabs(cos(pi*dnu)); - if (ak == 0.) { - s1 = coef; - s2 = coef; - goto L100; - } - fhs = fabs(0.25 - dnu2); - if (fhs == 0.) { - s1 = coef; - s2 = coef; - goto L100; - } -// -// COMPUTE R2=F(E). IF ABS(Z) >= R2, USE FORWARD RECURRENCE TO -// DETERMINE THE BACKWARD INDEX K. R2=F(E) IS A STRAIGHT LINE ON -// 12 <= E <= 60. E IS COMPUTED FROM 2**(-E)=B**(1-DIGITS(0.0_dp))= -// TOL WHERE B IS THE BASE OF THE ARITHMETIC. -// - t1 = (i1mach[13] - 1)*d1mach[4]*(log(10)/log(2)); - t1 = fmin(fmax(t1, 12.0), 60.0); - t2 = tth * t1 - 6.0; - if (xx == 0.) { - t1 = hpi; - } else { - t1 = fabs(atan(yy/xx)); - } - if (t2 <= caz) { - // - // FORWARD RECURRENCE LOOP WHEN ABS(Z) >= R2 - // - etest = ak / (pi*caz*tol); - fk = 1.0; - if (etest < 1.0) { goto L80; } - fks = 2.0; - rk = caz + caz + 2.0; - a1 = 0.0; - a2 = 1.0; - for (i = 1; i < (kmax+1); i++) - { - ak = fhs / fks; - bk = rk / (fk + 1.0); - tm = a2; - a2 = bk * a2 - ak * a1; - a1 = tm; - rk += 2.; - fks += fk + fk + 2.0; - fhs += fk + fk; - fk += 1.0; - tm = fabs(a2)*fk; - if (etest < tm) { - /* goto 160 */ - break; - } - if (i == kmax) { - /* Didn't break so goes to 310 */ - return -2; - } - } + inline int s1s2( + std::complex zr, std::complex *s1, std::complex *s2, double ascle, double alim, int *iuf + ) { - /* 160 */ - fk += spi * t1 * sqrt(t2/caz); - fhs = fabs(0.25 - dnu2); - } else { + //***BEGIN PROLOGUE ZS1S2 + //***REFER TO ZBESK,ZAIRY // - // COMPUTE BACKWARD INDEX K FOR ABS(Z) < R2 + // ZS1S2 TESTS FOR A POSSIBLE UNDERFLOW RESULTING FROM THE + // ADDITION OF THE I AND K FUNCTIONS IN THE ANALYTIC CON- + // TINUATION FORMULA WHERE S1=K FUNCTION AND S2=I FUNCTION. + // ON KODE=1 THE I AND K FUNCTIONS ARE DIFFERENT ORDERS OF + // MAGNITUDE, BUT FOR KODE=2 THEY CAN BE OF THE SAME ORDER + // OF MAGNITUDE AND THE MAXIMUM MUST BE AT LEAST ONE + // PRECISION ABOVE THE UNDERFLOW LIMIT. // - a2 = sqrt(caz); - ak *= fpi / (tol*sqrt(a2)); - aa = 3.0 * t1 / (1.0 + caz); - bb = 14.7 * t1 / (28.0 + caz); - ak = (log(ak) + caz*cos(aa)/(1.0 + 0.008*caz)) / cos(bb); - fk = 0.12125 * ak * ak / caz + 1.5; - } -L80: - // - // BACKWARD RECURRENCE LOOP FOR MILLER ALGORITHM - // - k = (int)fk; - fk = (double)k; - fks = fk * fk; - p1 = 0.0; - p2 = tol; - cs = p2; - for (i=1; i < (k+1); i++) - { - a1 = fks - fk; - a2 = (fks+fk) / (a1+fhs); - rk = 2.0 / (fk + 1.); - t1 = (fk + xx) * rk; - t2 = yy * rk; - pt = p2; - p2 = (p2 * std::complex(t1, t2) - p1) * a2; - p1 = pt; - cs += p2; - fks = a1 - fk + 1.0; - fk -= 1.0; - } - - // - // COMPUTE (P2/CS)=(P2/ABS(CS))*(CONJG(CS)/ABS(CS)) FOR BETTER SCALING - // - tm = std::abs(cs); - pt = 1.0 / tm; - s1 = pt * p2; - cs = conj(cs) * pt; - s1 *= coef * cs; - if ((inu <= 0) && (n <= 1)) { - zd = z; - if (iflag == 1) { goto L190; } - goto L130; - } - // - // COMPUTE P1/P2=(P1/ABS(P2)*CONJG(P2)/ABS(P2) FOR SCALING - // - tm = std::abs(p2); - pt = 1.0 / tm; - p1 = pt * p1; - p2 = conj(p2) * pt; - pt = p1 * p2; - s2 = s1 * (1. + (dnu+0.5 - pt)/z); - // - // FORWARD RECURSION ON THE THREE TERM RECURSION RELATION WITH - // SCALING NEAR EXPONENT EXTREMES ON KFLAG=1 OR KFLAG=3 - // -L100: - ck = (dnu + 1.)*rz; - if (n == 1) { inu -= 1; } - if (inu <= 0) { - if (n <= 1) { s1 = s2; } - zd = z; - if (iflag == 1) { goto L190; } - goto L130; - } - inub = 1; - if (iflag == 1) { goto L160; } -L110: - p1 = csr[kflag-1]; - ascle = bry[kflag-1]; - for (i = inub; i < inu+1; i++) - { - st = s2; - s2 = ck*s2 + s1; - s1 = st; - ck += rz; - if (kflag < 3) { - p2 = s2*p1; - p2m = fmax(fabs(std::real(p2)), fabs(std::imag(p2))); - if (p2m > ascle) { - kflag += 1; - ascle = bry[kflag-1]; - s1 *= p1; - s2 = p2; - s1 *= css[kflag-1]; - s2 *= css[kflag-1]; - p1 = csr[kflag-1]; - } - } - } - if (n == 1) { s1 = s2; } - -L130: - y[0] = s1 * csr[kflag-1]; - if (n == 1) { return nz; } - y[1] = s2 * csr[kflag-1]; - if (n == 2) { return nz; } - kk = 2; -L140: - kk += 1; - if (kk > n) { return nz; } - p1 = csr[kflag-1]; - ascle = bry[kflag-1]; - for (i = kk; i < (n+1); i++) - { - p2 = s2; - s2 = ck*s2 + s1; - s1 = p2; - ck += rz; - p2 = s2*p1; - y[i-1] = p2; - if (kflag < 3) { - p2m = fmax(fabs(std::real(p2)), fabs(std::imag(p2))); - if (p2m > ascle) { - kflag += 1; - ascle = bry[kflag-1]; - s1 *= p1; - s2 = p2; - s1 *= css[kflag-1]; - s2 *= css[kflag-1]; - p1 = csr[kflag-1]; - } - } - } - return nz; -// -// IFLAG=1 CASES, FORWARD RECURRENCE ON SCALED VALUES ON UNDERFLOW -// -L160: - elm = exp(-elim); - ascle = bry[0]; - zd = z; - xd = xx; - yd = yy; - ic = -1; - j = 2; - for (i = 1; i < (inu+1); i++) - { - st = s2; - s2 = ck*s2 + s1; - s1 = st; - ck += rz; - as = std::abs(s2); - alas = log(as); - p2r = alas - xd; - if (p2r >= -elim) { - p2 = -zd + std::log(s2); - p2r = std::real(p2); - p2i = std::imag(p2); - p2m = exp(p2r) / tol; - p1 = p2m * std::complex(cos(p2i), sin(p2i)); - if (!(uchk(p1, ascle, tol))) { - j = 3 - j; - cy[j-1] = p1; - if (ic == i-1) { goto L180; } - ic = i; - continue; + //***ROUTINES CALLED AZABS,AZEXP,AZLOG + //***END PROLOGUE ZS1S2 + + std::complex c1, s1d; + double aa, aln, as1, as2, xx; + int nz = 0; + as1 = std::abs(*s1); + as2 = std::abs(*s2); + aa = std::real(*s1); + aln = std::imag(*s1); + + if ((aa != 0.) || (aln != 0.)) { + if (as1 != 0.) { + xx = std::real(zr); + aln = -xx - xx + log(as1); + s1d = *s1; + *s1 = 0.; + as1 = 0.; + if (aln >= -alim) { + c1 = std::log(s1d) - zr - zr; + *s1 = std::exp(c1); + as1 = std::abs(*s1); + *iuf += 1; + } } } - if (alas >= 0.5 * elim) { - xd -= elim; - s1 *= elm; - s2 *= elm; - zd = std::complex(xd, yd); - } - } - if (n == 1) { s1 = s2; } - goto L190; -L180: - kflag = 1; - inub = i + 1; - s2 = cy[j-1]; - j = 3 - j; - s1 = cy[j-1]; - if (inub <= inu) { goto L110; } - if (n == 1) { s1 = s2; } - goto L130; -L190: - y[0] = s1; - if (n != 1) { y[1] = s2; } - ascle = bry[0]; - nz = kscl(zd, fnu, n, &y[0], rz, &ascle, tol, elim); - inu = n - nz; - if (inu <= 0) { return nz; } - kk = nz + 1; - s1 = y[kk-1]; - y[kk-1] = s1 * csr[0]; - if (inu == 1) { return nz; } - kk = nz + 2; - s2 = y[kk-1]; - y[kk-1] = s2 * csr[0]; - if (inu == 2) { return nz; } - t2 = fnu + (kk-1); - ck = t2 * rz; - kflag = 1; - goto L140; -} - - -inline int buni( - std::complex z, - double fnu, - int kode, - int n, - std::complex *y, - int nui, - int *nlast, - double fnul, - double tol, - double elim, - double alim -) { - - //***BEGIN PROLOGUE ZBUNI - //***REFER TO ZBESI,ZBESK - // - // ZBUNI COMPUTES THE I BESSEL FUNCTION FOR LARGE CABS(Z).GT. - // FNUL AND FNU+N-1.LT.FNUL. THE ORDER IS INCREASED FROM - // FNU+N-1 GREATER THAN FNUL BY ADDING NUI AND COMPUTING - // ACCORDING TO THE UNIFORM ASYMPTOTIC EXPANSION FOR I(FNU,Z) - // ON IFORM=1 AND THE EXPANSION FOR J(FNU,Z) ON IFORM=2 - // - //***ROUTINES CALLED ZUNI1,ZUNI2,AZABS,D1MACH - //***END PROLOGUE ZBUNI - - std::complex cscl, cscr, rz, st, s1, s2; - double ax, ay, dfnu, fnui, gnu, xx, yy, ascle, str, sti, stm; - int i, iflag, iform, k, nl, nw, nz; - std::complex cy[2] = { 0.0 }; - double bry[3] = { 0.0 }; - - nz = 0; - xx = std::real(z); - yy = std::imag(z); - ax = fabs(xx) + sqrt(3.); - ay = fabs(yy); - iform = 1; - if (ay > ax) { iform = 2; } - if (nui == 0) { - if (iform != 2) { - uni1(z, fnu, kode, n, y, &nw, nlast, fnul, tol, elim, alim); - } else { - uni2(z, fnu, kode, n, y, &nw, nlast, fnul, tol, elim, alim); - } - if (nw < 0) { - nz = -1; - if (nw == -2) { nz = -2; } + aa = fmax(as1, as2); + if (aa > ascle) { return nz; } - return nw; + *s1 = 0.; + *s2 = 0.; + *iuf = 0; + return 1; } - fnui = nui; - dfnu = fnu + (n - 1); - gnu = dfnu + fnui; - if (iform != 2) { + inline int uchk(std::complex y, double ascle, double tol) { + + //***BEGIN PROLOGUE ZUCHK + //***REFER TO ZSERI,ZUOIK,ZUNK1,ZUNK2,ZUNI1,ZUNI2,ZKSCL // - // ASYMPTOTIC EXPANSION FOR I(FNU,Z) FOR LARGE FNU APPLIED IN - // -PI/3 <= ARG(Z) <= PI/3 + // Y ENTERS AS A SCALED QUANTITY WHOSE MAGNITUDE IS GREATER THAN + // EXP(-ALIM)=ASCLE=1.0E+3*D1MACH(1)/TOL. THE TEST IS MADE TO SEE + // IF THE MAGNITUDE OF THE REAL OR IMAGINARY PART WOULD UNDERFLOW + // WHEN Y IS SCALED (BY TOL) TO ITS PROPER VALUE. Y IS ACCEPTED + // IF THE UNDERFLOW IS AT LEAST ONE PRECISION BELOW THE MAGNITUDE + // OF THE LARGEST COMPONENT; OTHERWISE THE PHASE ANGLE DOES NOT HAVE + // ABSOLUTE ACCURACY AND AN UNDERFLOW IS ASSUMED. // - uni1(z, gnu, kode, 2, cy, &nw, nlast, fnul, tol, elim, alim); - } else { - uni2(z, gnu, kode, 2, cy, &nw, nlast, fnul, tol, elim, alim); - } - if (nw >= 0) { - if (nw != 0) { *nlast = n; return nz; } - ay = std::abs(cy[0]); - // - // SCALE BACKWARD RECURRENCE, BRY(3) IS DEFINED BUT NEVER USED - // - bry[0] = 1e3*d1mach[0] / tol; - bry[1] = tol / 1e3*d1mach[0]; - bry[2] = bry[1]; - iflag = 2; - ascle = bry[1]; - ax = 1.0; - cscl = ax; - if (ay <= bry[0]) { - iflag = 1; - ascle = bry[0]; - ax = 1.0 / tol; - cscl = ax; + //***ROUTINES CALLED (NONE) + //***END PROLOGUE ZUCHK + + double yr = fabs(std::real(y)); + double yi = fabs(std::imag(y)); + double ss = fmax(yr, yi); + double st = fmin(yr, yi); + if (st > ascle) { + return 0; } else { - if (ay >= bry[1]) { - iflag = 3; - ascle = bry[2]; - ax = tol; - cscl = ax; - - } - } - ay = 1.0 / ax; - cscr = ay; - s1 = cy[1] * cscl; - s2 = cy[0] * cscl; - rz = 2.0 / z; - for (i = 1; i < (nui+1); i++) - { - st = s2; - s2 = (dfnu +fnui)*rz*st + s1; - s1 = st; - fnui -= 1.0; - if (iflag < 3) { - st = s2 * cscr; - str = fabs(std::real(st)); - sti = fabs(std::imag(st)); - stm = fmax(str, sti); - if (stm > ascle) { - iflag += 1; - ascle = bry[iflag-1]; - s1 *= cscr; - s2 = st; - ax *= tol; - ay = 1.0 / ax; - cscl = ax; - cscr = ay; - s1 *= cscl; - s2 *= cscl; - } - } - } - y[n-1] = s2*cscr; - if (n == 1) { return nz; } - nl = n-1; - fnui = nl; - k = nl; - for (i = 0; i < (nl+1); i++) - { - st = s2; - s2 = (fnu + fnui)*rz*s2 + s1; - s1 = st; - st = s2 * cscr; - y[k-1] = st; - fnui -= 1.0; - k -= 1; - if (iflag < 3) { - st = s2 * cscr; - str = fabs(std::real(st)); - sti = fabs(std::imag(st)); - stm = fmax(str, sti); - if (stm > ascle) { - iflag += 1; - ascle = bry[iflag-1]; - s1 *= cscr; - s2 = st; - ax *= tol; - ay = 1.0 / ax; - cscl = ax; - cscr = ay; - s1 *= cscl; - s2 *= cscl; - } + st /= tol; + if (ss < st) { + return 1; + } else { + return 0; } } - return nz; } - nz = -1; - if (nw == -2) { nz = -2; } - return nz; -} - - -inline int bunk( - std::complex z, - double fnu, - int kode, - int mr, - int n, - std::complex *y, - double tol, - double elim, - double alim -) { - - //***BEGIN PROLOGUE ZBUNK - //***REFER TO ZBESK,ZBESH - // - // ZBUNK COMPUTES THE K BESSEL FUNCTION FOR FNU.GT.FNUL. - // ACCORDING TO THE UNIFORM ASYMPTOTIC EXPANSION FOR K(FNU,Z) - // IN ZUNK1 AND THE EXPANSION FOR H(2,FNU,Z) IN ZUNK2 - // - //***ROUTINES CALLED ZUNK1,ZUNK2 - //***END PROLOGUE ZBUNK - - double ax, ay; - int nz = 0; - ax = fabs(std::real(z)) * 1.7321; - ay = fabs(std::imag(z)); + inline void unhj( + std::complex z, double fnu, int ipmtr, double tol, std::complex *phi, std::complex *arg, + std::complex *zeta1, std::complex *zeta2, std::complex *asum, std::complex *bsum + ) { - if (ay <= ax) { + //***BEGIN PROLOGUE ZUNHJ + //***REFER TO ZBESI,ZBESK // - // Asymptotic expansion for K(FNU,Z) for large FNU applied in - // -PI/3 <= ARG(Z) <= PI/3 + // REFERENCES + // HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ AND I.A. + // STEGUN, AMS55, NATIONAL BUREAU OF STANDARDS, 1965, CHAPTER 9. // - nz = unk1(z, fnu, kode, mr, n, y, tol, elim, alim); - } else { + // ASYMPTOTICS AND SPECIAL FUNCTIONS BY F.W.J. OLVER, ACADEMIC + // PRESS, N.Y., 1974, PAGE 420 // - // Asymptotic expansion for H(2, FNU, Z*EXP(M*HPI)) for large FNU - // applied in PI/3 < ABS(ARG(Z)) <= PI/2 where M = +I or -I and HPI = PI/2 + // ABSTRACT + // ZUNHJ COMPUTES PARAMETERS FOR BESSEL FUNCTIONS C(FNU,Z) = + // J(FNU,Z), Y(FNU,Z) OR H(I,FNU,Z) I=1,2 FOR LARGE ORDERS FNU + // BY MEANS OF THE UNIFORM ASYMPTOTIC EXPANSION // - nz = unk2(z, fnu, kode, mr, n, y, tol, elim, alim); - } - return nz; -} - - -inline double gamln(double z) { + // C(FNU,Z)=C1*PHI*( ASUM*AIRY(ARG) + C2*BSUM*DAIRY(ARG) ) + // + // FOR PROPER CHOICES OF C1, C2, AIRY AND DAIRY WHERE AIRY IS + // AN AIRY FUNCTION AND DAIRY IS ITS DERIVATIVE. + // + // (2/3)*FNU*ZETA**1.5 = ZETA1-ZETA2, + // + // ZETA1=0.5*FNU*CLOG((1+W)/(1-W)), ZETA2=FNU*W FOR SCALING + // PURPOSES IN AIRY FUNCTIONS FROM CAIRY OR CBIRY. + // + // MCONJ=SIGN OF AIMAG(Z), BUT IS AMBIGUOUS WHEN Z IS REAL AND + // MUST BE SPECIFIED. IPMTR=0 RETURNS ALL PARAMETERS. IPMTR= + // 1 COMPUTES ALL EXCEPT ASUM AND BSUM. + // + //***ROUTINES CALLED AZABS,ZDIV,AZLOG,AZSQRT,D1MACH + //***END PROLOGUE ZUNHJ + + std::complex cfnu, przth, ptfn, rtzta, rzth, suma, sumb; + std::complex tfn, t2, w, w2, za, zb, zc, zeta, zth; + double ang, atol, aw2, azth, btol, fn13, fn23, pp, rfn13; + double rfnu, rfnu2, wi, wr, zci, zcr, zetai, zetar, zthi; + double zthr, asumr, asumi, bsumr, bsumi, test, ac; + double ex1 = 1. / 3.; + double ex2 = 2. / 3.; + double hpi = 1.57079632679489662; + double pi = 3.14159265358979324; + double thpi = 4.71238898038468986; + int ias, ibs, j, ju, k, kmax, kp1, ks, l, lrp1, l1, l2, m; + /* array vars */ + std::complex cr[14] = {0.}; + std::complex dr[14] = {0.}; + std::complex up[14] = {0.}; + std::complex p[30] = {0.}; + double ap[30] = {0.}; + + rfnu = 1. / fnu; + // + // OVERFLOW TEST (Z/FNU TOO SMALL) + // + test = d1mach[0] * 1e3; + ac = fnu * test; + if ((fabs(std::real(z)) <= ac) && (fabs(std::imag(z)) <= ac)) { + *zeta1 = 2.0 * fabs(log(test)) + fnu; + *zeta2 = fnu; + *phi = 1.; + *arg = 1.; + return; + } + zb = z * rfnu; + rfnu2 = rfnu * rfnu; + // + // COMPUTE IN THE FOURTH QUADRANT + // + fn13 = pow(fnu, ex1); + fn23 = fn13 * fn13; + rfn13 = 1.0 / fn13; + w2 = 1.0 - zb * zb; + /* AMOS AZSQRT and C CSQRT differs when imaginary 0.0 swaps sign */ + w2 = 1.0 - zb * zb; + if (std::imag(w2) == -0.0) { + w2 = std::real(w2); + } + aw2 = std::abs(w2); + if (aw2 <= 0.25) { + // + // POWER SERIES FOR ABS(W2) <= 0.25 + // + k = 1; + p[0] = 1.; + suma = zunhj_gama[0]; + ap[0] = 1.; + if (aw2 >= tol) { + for (k = 2; k < 31; k++) { + p[k - 1] = p[k - 2] * w2; + suma += p[k - 1] * zunhj_gama[k - 1]; + ap[k - 1] = ap[k - 2] * aw2; + if (ap[k - 1] < tol) { + break; + } + } + } + /* Check for exhausted loop */ + if (k == 31) { + k = 30; + } - //***BEGIN PROLOGUE DGAMLN - //***DATE WRITTEN 830501 (YYMMDD) - //***REVISION DATE 830501 (YYMMDD) - //***CATEGORY NO. B5F - //***KEYWORDS GAMMA FUNCTION,LOGARITHM OF GAMMA FUNCTION - //***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES - //***PURPOSE TO COMPUTE THE LOGARITHM OF THE GAMMA FUNCTION - //***DESCRIPTION - // - // **** A DOUBLE PRECISION ROUTINE **** - // DGAMLN COMPUTES THE NATURAL LOG OF THE GAMMA FUNCTION FOR - // Z.GT.0. THE ASYMPTOTIC EXPANSION IS USED TO GENERATE VALUES - // GREATER THAN ZMIN WHICH ARE ADJUSTED BY THE RECURSION - // G(Z+1)=Z*G(Z) FOR Z.LE.ZMIN. THE FUNCTION WAS MADE AS - // PORTABLE AS POSSIBLE BY COMPUTIMG ZMIN FROM THE NUMBER OF BASE - // 10 DIGITS IN A WORD, RLN=AMAX1(-ALOG10(R1MACH(4)),0.5E-18) - // LIMITED TO 18 DIGITS OF (RELATIVE) ACCURACY. - // - // SINCE INTEGER ARGUMENTS ARE COMMON, A TABLE LOOK UP ON 100 - // VALUES IS USED FOR SPEED OF EXECUTION. - // - // DESCRIPTION OF ARGUMENTS - // - // INPUT Z IS D0UBLE PRECISION - // Z - ARGUMENT, Z.GT.0.0D0 - // - // OUTPUT DGAMLN IS DOUBLE PRECISION - // DGAMLN - NATURAL LOG OF THE GAMMA FUNCTION AT Z.NE.0.0D0 - // IERR - ERROR FLAG - // IERR=0, NORMAL RETURN, COMPUTATION COMPLETED - // IERR=1, Z.LE.0.0D0, NO COMPUTATION - // - // - //***REFERENCES COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT - // BY D. E. AMOS, SAND83-0083, MAY, 1983. - //***ROUTINES CALLED I1MACH,D1MACH - //***END PROLOGUE DGAMLN - - int i1m, mz; - double fln, fz, rln, s, tlg, trm, tst, t1, wdtol, zdmy, zinc, zm, zmin, zp, zsq; - const double con = 1.83787706640934548; /* LN(2*PI) */ - int nz = 0; - if (z > 0.0) { - if (z <= 101.0) { - nz = (int)z; - fz = z - nz; - if (fz <= 0.0) { - if (nz <= 100) { - return dgamln_gln[nz-1]; + kmax = k; + zeta = w2 * suma; + *arg = zeta * fn23; + za = std::sqrt(suma); + *zeta2 = std::sqrt(w2) * fnu; + *zeta1 = (*zeta2) * (1. + zeta * za * ex2); + za = za + za; + *phi = std::sqrt(za) * rfn13; + if (ipmtr == 1) { + return; + } + // + // SUM SERIES FOR ASUM AND BSUM + // + sumb = 0.0; + for (k = 1; k < (kmax + 1); k++) { + sumb += p[k - 1] * zunhj_beta[k - 1]; + } + *asum = 0.0; + *bsum = sumb; + l1 = 0; + l2 = 30; + btol = tol * (fabs(std::real(*bsum)) + fabs(std::imag(*bsum))); + atol = tol; + pp = 1.0; + ias = 0; + ibs = 0; + if (rfnu2 < tol) { + /* 110 */ + *asum += 1.; + *bsum *= rfnu * rfn13; + /* 120 */ + return; + } + for (int is = 2; is < 8; is++) { + atol /= rfnu2; + pp *= rfnu2; + if (ias != 1) { + suma = 0.0; + for (k = 1; k < (kmax + 1); k++) { + m = l1 + k; + suma += p[k - 1] * zunhj_alfa[m - 1]; + if (ap[k - 1] < atol) { + break; + } + } + *asum += suma * pp; + if (pp < tol) { + ias = 1; + } } + if (ibs != 1) { + sumb = 0.0; + for (k = 1; k < (kmax + 1); k++) { + m = l2 + k; + sumb += p[k - 1] * zunhj_beta[m - 1]; + if (ap[k - 1] < atol) { + break; + } + } + *bsum += sumb * pp; + if (pp < btol) { + ibs = 1; + } + } + if ((ias == 1) && (ibs == 1)) { + break; + } + l1 += 30; + l2 += 30; } - } - wdtol = fmax(d1mach[3], 1e-18); - i1m = i1mach[13]; - rln = d1mach[4]*i1m; - fln = fmax(fmin(rln, 20.), 3.0) - 3.0; - zm = 1.8 + 0.3875*fln; - mz = ((int)zm) + 1; - zmin = mz; - zdmy = z; - zinc = 0.0; - if (z < zmin){ - zinc = zmin - nz; - zdmy = z + zinc; - } - zp = 1. / zdmy; - t1 = dgamln_cf[0]*zp; - s = t1; - if (zp >= wdtol) { - zsq = zp*zp; - tst = t1*wdtol; - for (int i = 2; i < 23; i++) - { - zp *= zsq; - trm = dgamln_cf[i-1] * zp; - if (fabs(trm) < tst) { break; } - s += trm; - } - } - - if (zinc == 0.) { - tlg = log(z); - return z*(tlg-1.0) + 0.5*(con - tlg) + s; - } - zp = 1.0; - nz = (int)zinc; - for (int i = 0; i < nz; i++) - { - zp *= (z + i); - } - tlg = log(zdmy); - return zdmy*(tlg-1.0) - log(zp) + 0.5*(con-tlg) + s; - } - // Zero or negative argument - return NAN; -} - - -inline int mlri( - std::complex z, - double fnu, - int kode, - int n, - std::complex *y, - double tol -) { - - //***BEGIN PROLOGUE ZMLRI - //***REFER TO ZBESI,ZBESK - // - // ZMLRI COMPUTES THE I BESSEL FUNCTION FOR RE(Z).GE.0.0 BY THE - // MILLER ALGORITHM NORMALIZED BY A NEUMANN SERIES. - // - //***ROUTINES CALLED DGAMLN,D1MACH,AZABS,AZEXP,AZLOG,ZMLT - //***END PROLOGUE ZMLRI - - std::complex ck, cnorm, pt, p1, p2, rz, sum; - double ack, ak, ap, at, az, bk, fkap, fkk, flam, fnf, rho,\ - rho2, scle, tfnf, tst, x; - int i, iaz, ifnu, inu, itime, k, kk, km, m, nz; - scle = d1mach[0] / tol; - nz = 0; - az = std::abs(z); - x = std::real(z); - iaz = (int)az; - ifnu = (int)fnu; - inu = ifnu + n - 1; - at = iaz + 1; - ck = at / z; - rz = 2. / z; - p1 = 0.; - p2 = 1.; - ack = (at + 1.0) / az; - rho = ack + sqrt(ack*ack - 1.); - rho2 = rho * rho; - tst = (rho2 + rho2) / ((rho2 - 1.0)*(rho - 1.0)); - tst /= tol; - // - // COMPUTE RELATIVE TRUNCATION ERROR INDEX FOR SERIES - // - ak = at; - i = 1; - for (i = 1; i < 81; i++ ) - { - pt = p2; - p2 = p1 - ck * p2; - p1 = pt; - ck += rz; - ap = std::abs(p2); - if (ap > tst*ak*ak) { break; } - ak += 1.0; - if (i == 80) { - /* Exhausted loop without break */ - return -2; - } - } - i += 1; - k = 0; - if (inu >= iaz) { - // - // COMPUTE RELATIVE TRUNCATION ERROR FOR RATIOS - // - p1 = 0.0; - p2 = 1.0; - at = inu + 1; - ck = at / z; - ack = at / az; - tst = sqrt(ack / tol); - itime = 1; - k = 1; - for (k = 1; k < 81; k++ ) - { - pt = p2; - p2 = p1 - ck * p2; - p1 = pt; - ck += rz; - ap = std::abs(p2); - if (ap >= tst) { - if (itime == 2) { break; } - ack = std::abs(ck); - flam = ack + sqrt(ack*ack - 1.0); - fkap = ap / std::abs(p1); - rho = fmin(flam, fkap); - tst *= sqrt(rho / (rho*rho - 1.0)); - itime = 2; + *asum += 1.; + *bsum *= rfnu * rfn13; + return; + } else { + // + // ABS(W2) > 0.25 + w = std::sqrt(w2); + wr = std::real(w); + wi = std::imag(w); + if (wr < 0) { + wr = 0.; } - if (k == 80) { - /* Exhausted loop without break */ - return -2; + if (wi < 0) { + wi = 0.; + } + za = (1. + w) / zb; + zc = std::log(za); + zcr = std::real(zc); + zci = std::imag(zc); + if (zci < 0) { + zci = 0.; + } + if (zci > hpi) { + zci = hpi; + } + if (zcr < 0) { + zcr = 0.; + } + zc = std::complex(zcr, zci); + zth = (zc - w) * 1.5; + cfnu = fnu; + *zeta1 = zc * cfnu; + *zeta2 = w * cfnu; + azth = std::abs(zth); + zthr = std::real(zth); + zthi = std::imag(zth); + ang = thpi; + if ((zthr < 0.) || (zthi >= 0.)) { + ang = hpi; + if (zthr != 0.) { + ang = atan(zthi / zthr); + if (zthr < 0.) { + ang += pi; + } + } + } + pp = pow(azth, ex2); + ang *= ex2; + zetar = pp * cos(ang); + zetai = pp * sin(ang); + if (zetai < 0.) { + zetai = 0.; + } + zeta = std::complex(zetar, zetai); + *arg = zeta * fn23; + rtzta = zth / zeta; + za = rtzta / w; + *phi = std::sqrt(za + za) * rfn13; + if (ipmtr == 1) { + return; + } + tfn = rfnu / w; + rzth = rfnu / zth; + zc = rzth * zunhj_ar[1]; + t2 = 1. / w2; + up[1] = (t2 * zunhj_c[1] + zunhj_c[2]) * tfn; + *bsum = up[1] + zc; + *asum = 0.; + + if (rfnu < tol) { + *asum += 1.; + *bsum *= -rfn13 / rtzta; + return; } - } - } - // - // BACKWARD RECURRENCE AND SUM NORMALIZING RELATION - // - k += 1; - kk = fmax(i+iaz, k+inu); - fkk = kk; - p1 = 0.0; - // - // SCALE P2 AND SUM BY SCLE - // - p2 = scle; - fnf = fnu - ifnu; - tfnf = fnf + fnf; - bk = gamln(fkk + tfnf + 1.0) - gamln(fkk + 1.0) - gamln(tfnf + 1.0); - bk = exp(bk); - sum = 0.; - km = kk - inu; - for (i = 1; i < (km+1); i++) - { - pt = p2; - p2 = p1 + (fkk + fnf)*rz*p2; - p1 = pt; - ak = 1. - tfnf / (fkk+tfnf); - ack = bk*ak; - sum += (ack + bk)*p1; - bk = ack; - fkk -= 1.; - } - y[n-1] = p2; - if (n != 1) { - for (i = 2; i < (n+1); i++) - { - pt = p2; - p2 = p1 + (fkk + fnf)*rz*p2; - p1 = pt; - ak = 1. - tfnf / (fkk+tfnf); - ack = bk*ak; - sum += (ack + bk)*p1; - bk = ack; - fkk -= 1.; - m = n - i + 1; - y[m-1] = p2; - } - } - if (ifnu > 0) { - for (i = 1; i < (ifnu+1); i++) - { - pt = p2; - p2 = p1 + (fkk + fnf)*rz*p2; - p1 = pt; - ak = 1. - tfnf / (fkk+tfnf); - ack = bk*ak; - sum += (ack + bk)*p1; - bk = ack; - fkk -= 1.; - } - } - pt = z; - if (kode == 2) { pt -= x; } - p1 = -fnf * std::log(rz) + pt; - ap = gamln(1. + fnf); - pt = p1 - ap; - // - // THE DIVISION EXP(PT)/(SUM+P2) IS ALTERED TO AVOID OVERFLOW - // IN THE DENOMINATOR BY SQUARING LARGE QUANTITIES - // - p2 += sum; - ap = std::abs(p2); - p1 = 1. / ap; - ck = std::exp(pt) * p1; - pt = conj(p2)*p1; - cnorm = ck * pt; - for (int i = 0; i < n; i++) { y[i] *= cnorm; } - return nz; -} - - -inline int kscl( - std::complex zr, - double fnu, - int n, - std::complex *y, - std::complex rz, - double *ascle, - double tol, - double elim -) { - - //***BEGIN PROLOGUE ZKSCL - //***REFER TO ZBESK - // - // SET K FUNCTIONS TO ZERO ON UNDERFLOW, CONTINUE RECURRENCE - // ON SCALED FUNCTIONS UNTIL TWO MEMBERS COME ON SCALE, THEN - // RETURN WITH MIN(NZ+2,N) VALUES SCALED BY 1/TOL. - // - //***ROUTINES CALLED ZUCHK,AZABS,AZLOG - //***END PROLOGUE ZKSCL - - std::complex cy[2] = { 0. }; - double as, acs, alas, fn, zri, xx; - std::complex s1, s2, cs, ck, zd; - int nz = 0; - int ic = 0; - int nn = ( n > 2 ? 2 : n ); - int kk = 0; - int i; - double elm = exp(-elim); - xx = std::real(zr); - - for (i = 1; i < (nn + 1); i++) - { - s1 = y[i-1]; - cy[i-1] = s1; - as = std::abs(s1); - acs = -std::real(zr) + log(as); - nz += 1; - y[i-1] = 0.; - if (acs < -elim) { - continue; - } - cs = -zr + std::log(s1); - cs = (exp(std::real(cs))/tol)*(cos(std::imag(cs)) + sin(std::imag(cs)*std::complex(0, 1))); - if (!uchk(cs, *ascle, tol)) { - y[i-1] = cs; - nz -= 1; - ic = i; - } - } - if (n == 1) { - return nz; - } - if (ic <= 1) { - y[0] = 0.; - nz = 2; - } - if (n == 2) { - return nz; - } - if (nz == 0) { - return nz; - } - fn = fnu + 1.; - ck = fn*rz; - s1 = cy[0]; - s2 = cy[1]; - zri = std::imag(zr); - zd = zr; - for (i = 3; i < (n+1); i++) - { - kk = i; - cs = s2; - s2 *= ck; - s2 += s1; - s1 = cs; - ck += rz; - as = std::abs(s2); - alas = log(as); - acs = alas - xx; - nz += 1; - y[i-1] = 0.; - if (acs >= -elim) { - cs = std::log(s2); - cs -= zd; - cs = (exp(std::real(cs))/tol)*std::complex(cos(std::imag(cs)), sin(std::imag(cs))); - if (!uchk(cs, *ascle, tol)) { - y[i-1] = cs; - nz -= 1; - if (ic == kk-1) { - nz = kk - 2; - for (int i = 0; i < nz; i++) { y[i] = 0.; } - return nz; + przth = rzth; + ptfn = tfn; + up[0] = 1.0; + pp = 1.0; + bsumr = std::real(*bsum); + bsumi = std::imag(*bsum); + btol = tol * (fabs(bsumr) + fabs(bsumi)); + ks = 0; + kp1 = 2; + l = 3; + ias = 0; + ibs = 0; + + for (int lr = 2; lr < 13; lr += 2) { + lrp1 = lr + 1; + // + // COMPUTE TWO ADDITIONAL CR, DR, AND UP FOR TWO MORE TERMS IN + // NEXT SUMA AND SUMB + // + for (k = lr; k < (lrp1 + 1); k++) { + ks += 1; + kp1 += 1; + l += 1; + za = zunhj_c[l - 1]; + for (j = 2; j < (kp1 + 1); j++) { + l += 1; + za = za * t2 + zunhj_c[l - 1]; + } + ptfn *= tfn; + up[kp1 - 1] = ptfn * za; + cr[ks - 1] = przth * zunhj_br[ks]; + przth *= rzth; + dr[ks - 1] = przth * zunhj_ar[ks + 1]; + } + pp *= rfnu2; + if (ias != 1) { + suma = up[lr]; + ju = lrp1; + for (int jr = 1; jr < lrp1; jr++) { + ju -= 1; + suma += cr[jr - 1] * up[ju - 1]; + } + *asum += suma; + asumr = std::real(*asum); + asumi = std::imag(*asum); + test = fabs(asumr) + fabs(asumi); + if ((pp < tol) && (test < tol)) { + ias = 1; + } + } + if (ibs != 1) { + sumb = up[lr + 1] + up[lr] * zc; + ju = lrp1; + for (int jr = 1; jr < lrp1; jr++) { + ju -= 1; + sumb += dr[jr - 1] * up[ju - 1]; + } + *bsum += sumb; + bsumr = std::real(*bsum); + bsumi = std::imag(*bsum); + test = fabs(bsumr) + fabs(bsumi); + if ((pp < tol) && (test < tol)) { + ibs = 1; + } + } + if ((ias == 1) && (ibs == 1)) { + break; } - ic = kk; - continue; } + *asum += 1.; + *bsum *= -rfn13 / rtzta; + return; } - if (alas >= 0.5*elim){ - xx -= elim; - zd = std::complex(xx, zri); - s1 *= elm; - s2 *= elm; - } - } - nz = n; - if (ic == n) { - nz = n-1; - } - - for (int i = 0; i < nz; i++) { y[i] = 0.; } - return nz; -} - - -inline void rati( - std::complex z, - double fnu, - int n, - std::complex *cy, - double tol -) { - - //***BEGIN PROLOGUE ZRATI - //***REFER TO ZBESI,ZBESK,ZBESH - // - // ZRATI COMPUTES RATIOS OF I BESSEL FUNCTIONS BY BACKWARD - // RECURRENCE. THE STARTING INDEX IS DETERMINED BY FORWARD - // RECURRENCE AS DESCRIBED IN J. RES. OF NAT. BUR. OF STANDARDS-B, - // MATHEMATICAL SCIENCES, VOL 77B, P111-114, SEPTEMBER, 1973, - // BESSEL FUNCTIONS I AND J OF COMPLEX ARGUMENT AND INTEGER ORDER, - // BY D. J. SOOKNE. - // - //***ROUTINES CALLED AZABS,ZDIV - //***END PROLOGUE ZRATI - - std::complex cdfnu, pt, p1, p2, rz, t1; - double ak, amagz, ap1, ap2, arg, az, dfnu, fdnu, flam, fnup, rap1, rho, test, test1; - int i, id, idnu, inu, itime, k, kk, magz; - - az = std::abs(z); - inu = (int)fnu; - idnu = inu + n - 1; - fdnu = idnu; - magz = az; - amagz = magz + 1; - fnup = fmax(amagz, fdnu); - id = idnu - magz - 1; - itime = 1; - k = 1; - rz = 2.0 / z; - t1 = fnup * rz; - p2 = -t1; - p1 = 1.0; - t1 += rz; - if (id > 0) { - id = 0; - } - ap2 = std::abs(p2); - ap1 = std::abs(p1); - - // - // THE OVERFLOW TEST ON K(FNU+I-1,Z) BEFORE THE CALL TO CBKNX - // GUARANTEES THAT P2 IS ON SCALE. SCALE TEST1 AND ALL SUBSEQUENT P2 - // VALUES BY AP1 TO ENSURE THAT AN OVERFLOW DOES NOT OCCUR PREMATURELY. - // - arg = (ap2 + ap2) / (ap1 * tol); - test1 = sqrt(arg); - test = test1; - rap1 = 1.0 / ap1; - p1 *= rap1; - p2 *= rap1; - ap2 *= rap1; - - while (1) { - k += 1; - ap1 = ap2; - pt = p2; - p2 = p1 - t1*p2; - p1 = pt; - t1 += rz; - ap2 = std::abs(p2); - if (ap1 > test) { break; } - if (itime != 2) { - ak = std::abs(t1)*0.5; - flam = ak + sqrt(ak*ak - 1.0); - rho = fmin(ap2/ap1, flam); - test = test1*sqrt(rho / (rho*rho - 1.0)); - itime = 2; - } - } - kk = k + 1 - id; - ak = kk; - dfnu = fnu + n - 1; - cdfnu = dfnu; - t1 = ak; - p1 = 1.0 / ap2; - p2 = 0.0; - - for (i = 1; i < (kk+1); i++) { - pt = p1; - p1 = rz*(cdfnu+t1)*p1 + p2; - p2 = pt; - t1 -= 1.0; } - if (p1 == 0.) { - p1 = std::complex(0, 0); - } - - cy[n-1] = p2 / p1; - if (n == 1) { return; } - k = n - 1; - ak = k; - t1 = ak; - cdfnu = fnu*rz; - - for (i = 2; i < (n+1); i++) { - pt = cdfnu + t1*rz*cy[k]; - if (pt == 0.0) { - pt = std::complex(tol, tol); - } - cy[k-1] = 1.0 / pt; - t1 -= 1.0; - k -= 1; - } - return; -} - - -inline int seri( - std::complex z, - double fnu, - int kode, - int n, - std::complex *y, - double tol, - double elim, - double alim -) { - - //***BEGIN PROLOGUE ZSERI - //***REFER TO ZBESI,ZBESK - // - // ZSERI COMPUTES THE I BESSEL FUNCTION FOR REAL(Z).GE.0.0 BY - // MEANS OF THE POWER SERIES FOR LARGE CABS(Z) IN THE - // REGION CABS(Z).LE.2*SQRT(FNU+1). NZ=0 IS A NORMAL RETURN. - // NZ.GT.0 MEANS THAT THE LAST NZ COMPONENTS WERE SET TO ZERO - // DUE TO UNDERFLOW. NZ.LT.0 MEANS UNDERFLOW OCCURRED, BUT THE - // CONDITION CABS(Z).LE.2*SQRT(FNU+1) WAS VIOLATED AND THE - // COMPUTATION MUST BE COMPLETED IN ANOTHER ROUTINE WITH N=N-ABS(NZ). - // - //***ROUTINES CALLED DGAMLN,D1MACH,ZUCHK,AZABS,ZDIV,AZLOG,ZMLT - //***END PROLOGUE ZSERI - - std::complex ak1, ck, coef, crsc, cz, half_z, rz, s1, s2, w[2]; - double aa, acz, ak, arm, ascle, atol, az, dfnu, fnup, rak1,\ - rs, rtr1, s, ss, x; - int ib, iflag, il, k, l, m, nn; + inline void uni1( + std::complex z, double fnu, int kode, int n, std::complex *y, int *nz, int *nlast, double fnul, + double tol, double elim, double alim + ) { - int nz = 0; - az = std::abs(z); - if (az == 0.0) { - y[0] = 0.0; - if (fnu == 0.) { y[0] = 1.0; } - if (n == 1) { return nz; } - for (int i = 1; i < n; i++) { y[i] = 0.0; } - return nz; - } - x = std::real(z); - arm = 1e3*d1mach[0]; - rtr1 = sqrt(arm); - crsc = 1.0; - iflag = 0; - if (az >= arm) { - half_z = 0.5*z; - cz = 0.0; - if (az > rtr1) { cz = half_z*half_z; } - acz = std::abs(cz); - nn = n; - ck = std::log(half_z); -L10: - dfnu = fnu + (nn-1); - fnup = dfnu + 1.0; - // - // UNDERFLOW TEST - // - ak1 = ck * dfnu; - ak = gamln(fnup); - ak1 -= ak; - if (kode == 2) { ak1 -= x; } - rak1 = std::real(ak1); - if (rak1 > -elim) { goto L30; } -L20: - nz += 1; - y[nn - 1] = 0.0; - // - // RETURN WITH NZ < 0 IF ABS(Z*Z/4) > FNU+N-NZ-1 COMPLETE - // THE CALCULATION IN CBINU WITH N=N-ABS(NZ) - // - if (acz > dfnu) { return -nz; } - nn -= 1; - if (nn == 0) { return nz; } - goto L10; -L30: - if (rak1 <= -alim) { - iflag = 1; - ss = 1.0 / tol; - crsc = tol; - ascle = arm * ss; - } - ak = std::imag(ak1); - aa = exp(rak1); - if (iflag == 1) { aa *= ss; } - coef = aa * std::complex(cos(ak), sin(ak)); - atol = tol * acz / fnup; - il = (nn > 2 ? 2 : nn); - for (int i = 1; i < (il +1); i++) - { - dfnu = fnu + (nn-i); - fnup = dfnu + 1.0; - s1 = 1.0; - if (acz >= tol*fnup) { - ak1 = 1.0; - ak = fnup + 2.0; - s = fnup; - aa = 2.0; - while (1) { - rs = 1.0 / s; - ak1 *= cz; - ak1 *= rs; - s1 += ak1; - s += ak; - ak += 2.0; - aa *= acz; - aa *= rs; - if (aa <= atol) { break; } - } - } - s2 = s1 * coef; - w[i-1] = s2; - if (iflag != 0) { - if (uchk(s2, ascle, tol)) { goto L20; } - } - m = nn - i + 1; - y[m-1] = s2 * crsc; - if (i != il) { coef *= dfnu / half_z; } - } - if (nn <= 2) { return nz; } - k = nn - 2; - ak = k; - rz = 2.0 / z; - if (iflag == 1) { goto L80; } - ib = 3; -L60: - for (int i = ib; i < (nn+1); i++) - { - y[k-1] = (ak+fnu)*rz*y[k] + y[k+1]; - ak -= 1.0; - k -= 1; - } - return nz; -L80: + //***BEGIN PROLOGUE ZUNI1 + //***REFER TO ZBESI,ZBESK // - // RECUR BACKWARD WITH SCALED VALUES + // ZUNI1 COMPUTES I(FNU,Z) BY MEANS OF THE UNIFORM ASYMPTOTIC + // EXPANSION FOR I(FNU,Z) IN -PI/3.LE.ARG Z.LE.PI/3. // + // FNUL IS THE SMALLEST ORDER PERMITTED FOR THE ASYMPTOTIC + // EXPANSION. NLAST=0 MEANS ALL OF THE Y VALUES WERE SET. + // NLAST.NE.0 IS THE NUMBER LEFT TO BE COMPUTED BY ANOTHER + // FORMULA FOR ORDERS FNU TO FNU+NLAST-1 BECAUSE FNU+NLAST-1.LT.FNUL. + // Y(I)=CZERO FOR I=NLAST+1,N // - // EXP(-ALIM)=EXP(-ELIM)/TOL=APPROX. ONE PRECISION ABOVE THE - // UNDERFLOW LIMIT = ASCLE = D1MACH(1)*SS*1000 + //***ROUTINES CALLED ZUCHK,ZUNIK,ZUOIK,D1MACH,AZABS + //***END PROLOGUE ZUNI1 + + std::complex c2, phi, rz, sum, s1, s2, zeta1 = 0, zeta2 = 0; + double aphi, ascle, c1r, crsc, cscl, fn, rs1; + int i, iflag, init, k, m, nd, nn, nuf; + std::complex cwrk[16] = {0.}; + std::complex cy[2] = {0.}; + *nz = 0; + nd = n; + *nlast = 0; // - s1 = w[0]; - s2 = w[1]; - l = 3; - for (int l = 3; l < (nn+1); l++) - { - ck = s2; - s2 = s1 + (ak+fnu)*rz*s2; - s1= ck; - ck = s2*crsc; - y[k-1] = ck; - ak -= 1.0; - k -= 1; - if (std::abs(ck) > ascle) { goto L100; } - } - return nz; -L100: - ib = l+1; - if (ib > nn) { return nz; } - goto L60; - } - nz = n; - if (fnu == 0.0) { nz -= 1; } - y[0] = 0.0; - if (fnu == 0.) { y[0] = 1.0; } - if (n == 1) { return nz; } - for (int i = 1; i < n; i++) { y[i] = 0.0; } - return nz; -} - - -inline int s1s2( - std::complex zr, - std::complex *s1, - std::complex *s2, - double ascle, - double alim, - int *iuf -) { - - //***BEGIN PROLOGUE ZS1S2 - //***REFER TO ZBESK,ZAIRY - // - // ZS1S2 TESTS FOR A POSSIBLE UNDERFLOW RESULTING FROM THE - // ADDITION OF THE I AND K FUNCTIONS IN THE ANALYTIC CON- - // TINUATION FORMULA WHERE S1=K FUNCTION AND S2=I FUNCTION. - // ON KODE=1 THE I AND K FUNCTIONS ARE DIFFERENT ORDERS OF - // MAGNITUDE, BUT FOR KODE=2 THEY CAN BE OF THE SAME ORDER - // OF MAGNITUDE AND THE MAXIMUM MUST BE AT LEAST ONE - // PRECISION ABOVE THE UNDERFLOW LIMIT. - // - //***ROUTINES CALLED AZABS,AZEXP,AZLOG - //***END PROLOGUE ZS1S2 - - std::complex c1, s1d; - double aa, aln, as1, as2, xx; - int nz = 0; - as1 = std::abs(*s1); - as2 = std::abs(*s2); - aa = std::real(*s1); - aln = std::imag(*s1); - - if ((aa != 0.) || (aln != 0.)) { - if (as1 != 0.){ - xx = std::real(zr); - aln = -xx - xx + log(as1); - s1d = *s1; - *s1 = 0.; - as1 = 0.; - if (aln >= -alim) { - c1 = std::log(s1d) - zr - zr; - *s1 = std::exp(c1); - as1 = std::abs(*s1); - *iuf += 1; - } - } - } - aa = fmax(as1, as2); - if (aa > ascle) { - return nz; - } - *s1 = 0.; - *s2 = 0.; - *iuf = 0; - return 1; -} - - -inline int uchk( - std::complex y, - double ascle, - double tol -) { - - //***BEGIN PROLOGUE ZUCHK - //***REFER TO ZSERI,ZUOIK,ZUNK1,ZUNK2,ZUNI1,ZUNI2,ZKSCL - // - // Y ENTERS AS A SCALED QUANTITY WHOSE MAGNITUDE IS GREATER THAN - // EXP(-ALIM)=ASCLE=1.0E+3*D1MACH(1)/TOL. THE TEST IS MADE TO SEE - // IF THE MAGNITUDE OF THE REAL OR IMAGINARY PART WOULD UNDERFLOW - // WHEN Y IS SCALED (BY TOL) TO ITS PROPER VALUE. Y IS ACCEPTED - // IF THE UNDERFLOW IS AT LEAST ONE PRECISION BELOW THE MAGNITUDE - // OF THE LARGEST COMPONENT; OTHERWISE THE PHASE ANGLE DOES NOT HAVE - // ABSOLUTE ACCURACY AND AN UNDERFLOW IS ASSUMED. - // - //***ROUTINES CALLED (NONE) - //***END PROLOGUE ZUCHK - - double yr = fabs(std::real(y)); - double yi = fabs(std::imag(y)); - double ss = fmax(yr, yi); - double st = fmin(yr, yi); - if (st > ascle) { - return 0; - } else { - st /= tol; - if (ss < st) { - return 1; + // COMPUTED VALUES WITH EXPONENTS BETWEEN ALIM AND ELIM IN + // MAGNITUDE ARE SCALED TO KEEP INTERMEDIATE ARITHMETIC ON SCALE, + // EXP(ALIM)=EXP(ELIM)*TOL + // + cscl = 1.0 / tol; + crsc = tol; + double css[3] = {cscl, 1., crsc}; + double csr[3] = {crsc, 1., cscl}; + double bry[3] = {1e3 * d1mach[0] / tol, 0., 0.}; + bry[1] = 1.0 / bry[0]; + bry[2] = d1mach[1]; + // + // CHECK FOR UNDERFLOW AND OVERFLOW ON FIRST MEMBER + // + fn = fmax(fnu, 1.0); + init = 0; + unik(z, fn, 1, 1, tol, &init, &phi, &zeta1, &zeta2, &sum, &cwrk[0]); + if (kode != 1) { + s1 = -zeta1 + fn * (fn / (z + zeta2)); } else { - return 0; + s1 = -zeta1 + zeta2; } - } -} - - -inline void unhj( - std::complex z, - double fnu, - int ipmtr, - double tol, - std::complex *phi, - std::complex *arg, - std::complex *zeta1, - std::complex *zeta2, - std::complex *asum, - std::complex *bsum -) { - - //***BEGIN PROLOGUE ZUNHJ - //***REFER TO ZBESI,ZBESK - // - // REFERENCES - // HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ AND I.A. - // STEGUN, AMS55, NATIONAL BUREAU OF STANDARDS, 1965, CHAPTER 9. - // - // ASYMPTOTICS AND SPECIAL FUNCTIONS BY F.W.J. OLVER, ACADEMIC - // PRESS, N.Y., 1974, PAGE 420 - // - // ABSTRACT - // ZUNHJ COMPUTES PARAMETERS FOR BESSEL FUNCTIONS C(FNU,Z) = - // J(FNU,Z), Y(FNU,Z) OR H(I,FNU,Z) I=1,2 FOR LARGE ORDERS FNU - // BY MEANS OF THE UNIFORM ASYMPTOTIC EXPANSION - // - // C(FNU,Z)=C1*PHI*( ASUM*AIRY(ARG) + C2*BSUM*DAIRY(ARG) ) - // - // FOR PROPER CHOICES OF C1, C2, AIRY AND DAIRY WHERE AIRY IS - // AN AIRY FUNCTION AND DAIRY IS ITS DERIVATIVE. - // - // (2/3)*FNU*ZETA**1.5 = ZETA1-ZETA2, - // - // ZETA1=0.5*FNU*CLOG((1+W)/(1-W)), ZETA2=FNU*W FOR SCALING - // PURPOSES IN AIRY FUNCTIONS FROM CAIRY OR CBIRY. - // - // MCONJ=SIGN OF AIMAG(Z), BUT IS AMBIGUOUS WHEN Z IS REAL AND - // MUST BE SPECIFIED. IPMTR=0 RETURNS ALL PARAMETERS. IPMTR= - // 1 COMPUTES ALL EXCEPT ASUM AND BSUM. - // - //***ROUTINES CALLED AZABS,ZDIV,AZLOG,AZSQRT,D1MACH - //***END PROLOGUE ZUNHJ - - std::complex cfnu, przth, ptfn, rtzta, rzth, suma, sumb; - std::complex tfn, t2, w, w2, za, zb, zc, zeta, zth; - double ang, atol, aw2, azth, btol, fn13, fn23, pp, rfn13; - double rfnu, rfnu2, wi, wr, zci, zcr, zetai, zetar, zthi; - double zthr, asumr, asumi, bsumr, bsumi, test, ac; - double ex1 = 1./3.; - double ex2 = 2./3.; - double hpi = 1.57079632679489662; - double pi = 3.14159265358979324; - double thpi = 4.71238898038468986; - int ias, ibs, j, ju, k, kmax, kp1, ks, l, lrp1, l1, l2, m; - /* array vars */ - std::complex cr[14] = { 0. }; - std::complex dr[14] = { 0. }; - std::complex up[14] = { 0. }; - std::complex p[30] = { 0. }; - double ap[30] = { 0. }; - - rfnu = 1. / fnu; - // - // OVERFLOW TEST (Z/FNU TOO SMALL) - // - test = d1mach[0] * 1e3; - ac = fnu*test; - if ((fabs(std::real(z)) <= ac) && (fabs(std::imag(z)) <= ac)) { - *zeta1 = 2.0*fabs(log(test)) + fnu; - *zeta2 = fnu; - *phi = 1.; - *arg = 1.; - return; - } - zb = z*rfnu; - rfnu2 = rfnu*rfnu; - // - // COMPUTE IN THE FOURTH QUADRANT - // - fn13 = pow(fnu, ex1); - fn23 = fn13 * fn13; - rfn13 = 1.0/fn13; - w2 = 1.0 - zb*zb; - /* AMOS AZSQRT and C CSQRT differs when imaginary 0.0 swaps sign */ - w2 = 1.0 - zb*zb; - if (std::imag(w2) == -0.0) { w2 = std::real(w2); } - aw2 = std::abs(w2); - if (aw2 <= 0.25) { - // - // POWER SERIES FOR ABS(W2) <= 0.25 - // - k = 1; - p[0] = 1.; - suma = zunhj_gama[0]; - ap[0] = 1.; - if (aw2 >= tol) { - for (k = 2; k < 31; k++) - { - p[k-1] = p[k-2]*w2; - suma += p[k-1]*zunhj_gama[k-1]; - ap[k-1] = ap[k-2]*aw2; - if (ap[k-1] < tol) { break; } + + rs1 = std::real(s1); + if (fabs(rs1) > elim) { + if (rs1 > 0) { + *nz = -1; + return; + } + *nz = n; + for (i = 0; i < n; i++) { + y[i] = 0.0; } } - /* Check for exhausted loop */ - if (k == 31) { k = 30; } - - kmax = k; - zeta = w2*suma; - *arg = zeta*fn23; - za = std::sqrt(suma); - *zeta2 = std::sqrt(w2)*fnu; - *zeta1 = (*zeta2) * (1. + zeta*za*ex2); - za = za + za; - *phi = std::sqrt(za)*rfn13; - if (ipmtr == 1) { return; } - // - // SUM SERIES FOR ASUM AND BSUM - // - sumb = 0.0; - for (k = 1; k < (kmax+1); k++) { - sumb += p[k-1]*zunhj_beta[k-1]; - } - *asum = 0.0; - *bsum = sumb; - l1 = 0; - l2 = 30; - btol = tol * (fabs(std::real(*bsum)) + fabs(std::imag(*bsum))); - atol = tol; - pp = 1.0; - ias = 0; - ibs = 0; - if (rfnu2 < tol) { - /* 110 */ - *asum += 1.; - *bsum *= rfnu*rfn13; - /* 120 */ - return; - } - for (int is = 2; is < 8; is++) - { - atol /= rfnu2; - pp *= rfnu2; - if (ias != 1) { - suma = 0.0; - for (k = 1; k < (kmax+1); k++) - { - m = l1 + k; - suma += p[k-1]*zunhj_alfa[m-1]; - if (ap[k-1] < atol) { break; } + L30: + nn = (nd > 2 ? 2 : nd); + for (i = 1; i < (nn + 1); i++) { + fn = fnu + nd - i; + init = 0; + unik(z, fn, 1, 0, tol, &init, &phi, &zeta1, &zeta2, &sum, &cwrk[0]); + if (kode != 1) { + s1 = -zeta1 + fn * (fn / (z + zeta2)) + std::complex(0.0, std::imag(z)); + } else { + s1 = -zeta1 + zeta2; + } + // + // TEST FOR UNDERFLOW AND OVERFLOW + // + rs1 = std::real(s1); + if (fabs(rs1) > elim) { + goto L110; + } + if (i == 1) { + iflag = 2; + } + if (fabs(rs1) >= alim) { + // + // REFINE TEST AND SCALE + // + aphi = std::abs(phi); + rs1 += log(aphi); + if (fabs(rs1) > elim) { + goto L110; } - *asum += suma*pp; - if (pp < tol) { ias = 1; } - } - if (ibs != 1) { - sumb = 0.0; - for (k = 1; k < (kmax+1); k++) - { - m = l2 + k; - sumb += p[k-1]*zunhj_beta[m-1]; - if (ap[k-1] < atol) { break; } + if (i == 1) { + iflag = 1; + } + if (rs1 >= 0.0) { + if (i == 1) { + iflag = 3; + } } - *bsum += sumb*pp; - if (pp < btol) { ibs = 1; } } - if ((ias == 1) && (ibs == 1)) { break; } - l1 += 30; - l2 += 30; - } - *asum += 1.; - *bsum *= rfnu*rfn13; - return; - } else { - // - // ABS(W2) > 0.25 - w = std::sqrt(w2); - wr = std::real(w); - wi = std::imag(w); - if (wr < 0) { wr = 0.;} - if (wi < 0) { wi = 0.;} - za = (1. + w) / zb; - zc = std::log(za); - zcr = std::real(zc); - zci = std::imag(zc); - if (zci < 0) { zci = 0.;} - if (zci > hpi) { zci = hpi;} - if (zcr < 0) { zcr = 0.;} - zc = std::complex(zcr, zci); - zth = (zc-w)*1.5; - cfnu = fnu; - *zeta1 = zc*cfnu; - *zeta2 = w*cfnu; - azth = std::abs(zth); - zthr = std::real(zth); - zthi = std::imag(zth); - ang = thpi; - if ((zthr < 0.) || (zthi >= 0.)) { - ang = hpi; - if (zthr != 0.) { - ang = atan(zthi/zthr); - if (zthr < 0.) { ang += pi; } - } - } - pp = pow(azth, ex2); - ang *= ex2; - zetar = pp * cos(ang); - zetai = pp * sin(ang); - if (zetai < 0.) { zetai = 0.; } - zeta = std::complex(zetar, zetai); - *arg = zeta*fn23; - rtzta = zth / zeta; - za = rtzta / w; - *phi = std::sqrt(za + za) * rfn13; - if (ipmtr == 1) { return; } - tfn = rfnu / w; - rzth = rfnu / zth; - zc = rzth * zunhj_ar[1]; - t2 = 1. / w2; - up[1] = (t2*zunhj_c[1] + zunhj_c[2])*tfn; - *bsum = up[1] + zc; - *asum = 0.; - - if (rfnu < tol) { - *asum += 1.; - *bsum *= -rfn13 / rtzta; - return; - } - - przth = rzth; - ptfn = tfn; - up[0] = 1.0; - pp = 1.0; - bsumr = std::real(*bsum); - bsumi = std::imag(*bsum); - btol = tol * (fabs(bsumr) + fabs(bsumi)); - ks = 0; - kp1 = 2; - l = 3; - ias = 0; - ibs = 0; - - for (int lr = 2; lr < 13; lr += 2) - { - lrp1 = lr + 1; + /* 60 */ // - // COMPUTE TWO ADDITIONAL CR, DR, AND UP FOR TWO MORE TERMS IN - // NEXT SUMA AND SUMB + // SCALE S1 IF CABS(S1) < ASCLE // - for (k = lr; k < (lrp1+1); k++) - { - ks += 1; - kp1 += 1; - l += 1; - za = zunhj_c[l-1]; - for (j = 2; j < (kp1+1); j++) - { - l += 1; - za = za*t2 + zunhj_c[l-1]; + s2 = phi * sum; + s1 = exp(std::real(s1)) * css[iflag - 1] * std::complex(cos(std::imag(s1)), sin(std::imag(s1))); + s2 *= s1; + if (iflag == 1) { + if (uchk(s2, bry[0], tol)) { + goto L110; } - ptfn *= tfn; - up[kp1-1] = ptfn*za; - cr[ks-1] = przth*zunhj_br[ks]; - przth *= rzth; - dr[ks-1] = przth*zunhj_ar[ks+1]; - } - pp *= rfnu2; - if (ias != 1) { - suma = up[lr]; - ju = lrp1; - for (int jr = 1; jr < lrp1; jr++) - { - ju -= 1; - suma += cr[jr-1] * up[ju-1]; + } + /* 70 */ + cy[i - 1] = s2; + m = nd - i + 1; + y[m - 1] = s2 * csr[iflag - 1]; + } + /* 80 */ + if (nd > 2) { + rz = 1.0 / z; + s1 = cy[0]; + s2 = cy[1]; + c1r = csr[iflag - 1]; + ascle = bry[iflag - 1]; + k = nd - 2; + fn = k; + for (i = 3; i < (nd + 1); i++) { + c2 = s2; + s2 = s1 + (fnu + fn) * rz * c2; + s1 = c2; + c2 = s2 * c1r; + y[k - 1] = c2; + k -= 1; + fn -= 1.0; + if (iflag >= 3) { + continue; } - *asum += suma; - asumr = std::real(*asum); - asumi = std::imag(*asum); - test = fabs(asumr) + fabs(asumi); - if ((pp < tol) && (test < tol)) { ias = 1; } - } - if (ibs != 1) { - sumb = up[lr+1] + up[lr]*zc; - ju = lrp1; - for (int jr = 1; jr < lrp1; jr++) - { - ju -= 1; - sumb += dr[jr-1] * up[ju-1]; + if (fmax(fabs(std::real(c2)), fabs(std::imag(c2))) <= ascle) { + continue; } - *bsum += sumb; - bsumr = std::real(*bsum); - bsumi = std::imag(*bsum); - test = fabs(bsumr) + fabs(bsumi); - if ((pp < tol) && (test < tol)) { ibs = 1; } + iflag += 1; + ascle = bry[iflag - 1]; + s1 *= c1r; + s2 = c2; + s1 *= css[iflag - 1]; + s2 *= css[iflag - 1]; + c1r = csr[iflag - 1]; } - if ((ias == 1) && (ibs == 1)) { break; } + /* 90 */ } - *asum += 1.; - *bsum *= -rfn13 / rtzta; + /* 100 */ return; - } -} - - -inline void uni1( - std::complex z, - double fnu, - int kode, - int n, - std::complex *y, - int *nz, - int *nlast, - double fnul, - double tol, - double elim, - double alim -) { - - //***BEGIN PROLOGUE ZUNI1 - //***REFER TO ZBESI,ZBESK - // - // ZUNI1 COMPUTES I(FNU,Z) BY MEANS OF THE UNIFORM ASYMPTOTIC - // EXPANSION FOR I(FNU,Z) IN -PI/3.LE.ARG Z.LE.PI/3. - // - // FNUL IS THE SMALLEST ORDER PERMITTED FOR THE ASYMPTOTIC - // EXPANSION. NLAST=0 MEANS ALL OF THE Y VALUES WERE SET. - // NLAST.NE.0 IS THE NUMBER LEFT TO BE COMPUTED BY ANOTHER - // FORMULA FOR ORDERS FNU TO FNU+NLAST-1 BECAUSE FNU+NLAST-1.LT.FNUL. - // Y(I)=CZERO FOR I=NLAST+1,N - // - //***ROUTINES CALLED ZUCHK,ZUNIK,ZUOIK,D1MACH,AZABS - //***END PROLOGUE ZUNI1 - - std::complex c2, phi, rz, sum, s1, s2, zeta1 = 0, zeta2 = 0; - double aphi, ascle, c1r, crsc, cscl, fn, rs1; - int i, iflag, init, k, m, nd, nn, nuf; - std::complex cwrk[16] = { 0. }; - std::complex cy[2] = { 0. }; - *nz = 0; - nd = n; - *nlast = 0; - // - // COMPUTED VALUES WITH EXPONENTS BETWEEN ALIM AND ELIM IN - // MAGNITUDE ARE SCALED TO KEEP INTERMEDIATE ARITHMETIC ON SCALE, - // EXP(ALIM)=EXP(ELIM)*TOL - // - cscl = 1.0 / tol; - crsc = tol; - double css[3] = {cscl, 1., crsc}; - double csr[3] = {crsc, 1., cscl}; - double bry[3] = {1e3*d1mach[0]/tol, 0., 0.}; - bry[1] = 1.0 / bry[0]; - bry[2] = d1mach[1]; - // - // CHECK FOR UNDERFLOW AND OVERFLOW ON FIRST MEMBER - // - fn = fmax(fnu, 1.0); - init = 0; - unik(z, fn, 1, 1, tol, &init, &phi, &zeta1, &zeta2, &sum, &cwrk[0]); - if (kode != 1) { - s1 = -zeta1 + fn*(fn / (z + zeta2)); - } else { - s1 = -zeta1 + zeta2 ; - } - - rs1 = std::real(s1); - if (fabs(rs1) > elim) { - if (rs1 > 0) { + L110: + if (rs1 > 0.0) { *nz = -1; return; } - *nz = n; - for (i = 0; i < n; i++) { y[i] = 0.0; } - } -L30: - nn = ( nd > 2 ? 2 : nd); - for (i = 1; i < (nn+1); i++) - { - fn = fnu + nd - i; - init = 0; - unik(z, fn, 1, 0, tol, &init, &phi, &zeta1, &zeta2, &sum, &cwrk[0]); - if (kode != 1) { - s1 = -zeta1 + fn*(fn / (z + zeta2)) + std::complex(0.0, std::imag(z)); - } else { - s1 = -zeta1 + zeta2; + y[nd - 1] = 0.0; + *nz += 1; + nd -= 1; + if (nd == 0) { + return; } - // - // TEST FOR UNDERFLOW AND OVERFLOW - // - rs1 = std::real(s1); - if (fabs(rs1) > elim) { goto L110; } - if (i == 1) { iflag = 2; } - if (fabs(rs1) >= alim) { - // - // REFINE TEST AND SCALE - // - aphi = std::abs(phi); - rs1 += log(aphi); - if (fabs(rs1) > elim) { goto L110; } - if (i == 1) { iflag = 1; } - if (rs1 >= 0.0) { if (i == 1) { iflag = 3; } } - } - /* 60 */ - // - // SCALE S1 IF CABS(S1) < ASCLE - // - s2 = phi*sum; - s1 = exp(std::real(s1))*css[iflag-1]*std::complex(cos(std::imag(s1)), sin(std::imag(s1))); - s2 *= s1; - if (iflag == 1) { if (uchk(s2, bry[0], tol)) { goto L110; } } - /* 70 */ - cy[i-1] = s2; - m = nd - i + 1; - y[m-1] = s2*csr[iflag-1]; - } - /* 80 */ - if (nd > 2) { - rz = 1.0 / z; - s1 = cy[0]; - s2 = cy[1]; - c1r = csr[iflag-1]; - ascle = bry[iflag-1]; - k = nd - 2; - fn = k; - for (i = 3; i < (nd+1); i++) - { - c2 = s2; - s2 = s1 + (fnu + fn)*rz*c2; - s1 = c2; - c2 = s2*c1r; - y[k-1] = c2; - k -= 1; - fn -= 1.0; - if (iflag >= 3) { continue; } - if (fmax(fabs(std::real(c2)), fabs(std::imag(c2))) <= ascle) { continue; } - iflag += 1; - ascle = bry[iflag-1]; - s1 *= c1r; - s2 = c2; - s1 *= css[iflag-1]; - s2 *= css[iflag-1]; - c1r = csr[iflag-1]; - } - /* 90 */ - } - /* 100 */ - return; -L110: - if (rs1 > 0.0) { *nz = -1; return; } - y[nd - 1] = 0.0; - *nz += 1; - nd -= 1; - if (nd == 0) { return; } - nuf = uoik(z, fnu, kode, 1, nd, y, tol, elim, alim); - if (nuf < 0) { *nz = -1; return; } - nd -= nuf; - *nz += nuf; - if (nd == 0) { return; } - fn = fnu + nd - 1; - if (fn >= fnul) { goto L30; } - *nlast = nd; - return; -} - - -inline void uni2( - std::complex z, - double fnu, - int kode, - int n, - std::complex *y, - int *nz, - int *nlast, - double fnul, - double tol, - double elim, - double alim -) { - - //***BEGIN PROLOGUE ZUNI2 - //***REFER TO ZBESI,ZBESK - // - // ZUNI2 COMPUTES I(FNU,Z) IN THE RIGHT HALF PLANE BY MEANS OF - // UNIFORM ASYMPTOTIC EXPANSION FOR J(FNU,ZN) WHERE ZN IS Z*I - // OR -Z*I AND ZN IS IN THE RIGHT HALF PLANE ALSO. - // - // FNUL IS THE SMALLEST ORDER PERMITTED FOR THE ASYMPTOTIC - // EXPANSION. NLAST=0 MEANS ALL OF THE Y VALUES WERE SET. - // NLAST.NE.0 IS THE NUMBER LEFT TO BE COMPUTED BY ANOTHER - // FORMULA FOR ORDERS FNU TO FNU+NLAST-1 BECAUSE FNU+NLAST-1.LT.FNUL. - // Y(I)=CZERO FOR I=NLAST+1,N - // - //***ROUTINES CALLED ZAIRY,ZUCHK,ZUNHJ,ZUOIK,D1MACH,AZABS - //***END PROLOGUE ZUNI2 - - std::complex ai, arg, asum, bsum, cfn, cid, crsc, cscl, c1, c2, dai, phi, rz,\ - s1, s2, zb, zeta1, zeta2, zn, zar; - double aarg, ang, aphi, ascle, ay, c2i, c2m, c2r, fn, rs1, yy; - int i, iflag, in, inu, j, k, nai, nd, ndai, nn, nuf, idum; - double hpi = 1.57079632679489662; /* 0.5 pi */ - double aic = 1.265512123484645396; /* log(2 sqrt(pi)) */ - std::complex cip[4] = { 1.0, std::complex(0, 1), -1.0, -std::complex(0, 1) }; - std::complex ci = std::complex(0, 1); - // - // COMPUTED VALUES WITH EXPONENTS BETWEEN ALIM AND ELIM IN MAGNITUDE - // ARE SCALED TO KEEP INTERMEDIATE ARITHMETIC ON SCALE, - // EXP(ALIM) = EXP(ELIM)*TOL - // - cscl = 1.0 / tol; - crsc = tol; - std::complex csr[3] = { crsc, 1.0, cscl }; - std::complex css[3] = { cscl, 1.0, crsc }; - double bry[3] = { 1e3*d1mach[0]/tol, 0.0, 0.0 }; - std::complex cy[2] = { 0.0 }; - yy = std::imag(z); - *nz = 0; - nd = n; - *nlast = 0; - // - // ZN IS IN THE RIGHT HALF PLANE AFTER ROTATION BY CI OR -CI - // - zn = -z * ci; - zb = z; - cid = -ci; - inu = (int)fnu; - ang = hpi * (fnu - inu); - c2 = std::complex(cos(ang), sin(ang)); - zar = c2; - in = inu + n - 1; - in = in % 4; - c2 *= cip[in]; - if (yy <= 0.0) { - zn = conj(-zn); - zb = conj(zb); - cid = -cid; - c2 = conj(c2); - } - // - // CHECK FOR UNDERFLOW AND OVERFLOW ON FIRST MEMBER - // - fn = fmax(fnu, 1.0); - unhj(zn, fn, 0, tol, &phi, &arg, &zeta1, &zeta2, &asum, &bsum); - if (kode != 1) { - cfn = fnu; - s1 = -zeta1 + cfn*(cfn/(zb + zeta2)); - } else { - s1 = -zeta1 + zeta2; - } - rs1 = std::real(s1); - if (fabs(rs1) > elim) { - if (rs1 > 0.) { + nuf = uoik(z, fnu, kode, 1, nd, y, tol, elim, alim); + if (nuf < 0) { *nz = -1; return; } - for (i = 0; i < n; i++) { - y[i] = 0.0; + nd -= nuf; + *nz += nuf; + if (nd == 0) { + return; + } + fn = fnu + nd - 1; + if (fn >= fnul) { + goto L30; } + *nlast = nd; return; } -L10: - nn = (nd > 2 ? 2 : nd); - i = 1; - for (i = 1; i < (nn+1); i++) - { - fn = fnu + (nd-i); + + inline void uni2( + std::complex z, double fnu, int kode, int n, std::complex *y, int *nz, int *nlast, double fnul, + double tol, double elim, double alim + ) { + + //***BEGIN PROLOGUE ZUNI2 + //***REFER TO ZBESI,ZBESK + // + // ZUNI2 COMPUTES I(FNU,Z) IN THE RIGHT HALF PLANE BY MEANS OF + // UNIFORM ASYMPTOTIC EXPANSION FOR J(FNU,ZN) WHERE ZN IS Z*I + // OR -Z*I AND ZN IS IN THE RIGHT HALF PLANE ALSO. + // + // FNUL IS THE SMALLEST ORDER PERMITTED FOR THE ASYMPTOTIC + // EXPANSION. NLAST=0 MEANS ALL OF THE Y VALUES WERE SET. + // NLAST.NE.0 IS THE NUMBER LEFT TO BE COMPUTED BY ANOTHER + // FORMULA FOR ORDERS FNU TO FNU+NLAST-1 BECAUSE FNU+NLAST-1.LT.FNUL. + // Y(I)=CZERO FOR I=NLAST+1,N + // + //***ROUTINES CALLED ZAIRY,ZUCHK,ZUNHJ,ZUOIK,D1MACH,AZABS + //***END PROLOGUE ZUNI2 + + std::complex ai, arg, asum, bsum, cfn, cid, crsc, cscl, c1, c2, dai, phi, rz, s1, s2, zb, zeta1, zeta2, + zn, zar; + double aarg, ang, aphi, ascle, ay, c2i, c2m, c2r, fn, rs1, yy; + int i, iflag, in, inu, j, k, nai, nd, ndai, nn, nuf, idum; + double hpi = 1.57079632679489662; /* 0.5 pi */ + double aic = 1.265512123484645396; /* log(2 sqrt(pi)) */ + std::complex cip[4] = {1.0, std::complex(0, 1), -1.0, -std::complex(0, 1)}; + std::complex ci = std::complex(0, 1); + // + // COMPUTED VALUES WITH EXPONENTS BETWEEN ALIM AND ELIM IN MAGNITUDE + // ARE SCALED TO KEEP INTERMEDIATE ARITHMETIC ON SCALE, + // EXP(ALIM) = EXP(ELIM)*TOL + // + cscl = 1.0 / tol; + crsc = tol; + std::complex csr[3] = {crsc, 1.0, cscl}; + std::complex css[3] = {cscl, 1.0, crsc}; + double bry[3] = {1e3 * d1mach[0] / tol, 0.0, 0.0}; + std::complex cy[2] = {0.0}; + yy = std::imag(z); + *nz = 0; + nd = n; + *nlast = 0; + // + // ZN IS IN THE RIGHT HALF PLANE AFTER ROTATION BY CI OR -CI + // + zn = -z * ci; + zb = z; + cid = -ci; + inu = (int)fnu; + ang = hpi * (fnu - inu); + c2 = std::complex(cos(ang), sin(ang)); + zar = c2; + in = inu + n - 1; + in = in % 4; + c2 *= cip[in]; + if (yy <= 0.0) { + zn = conj(-zn); + zb = conj(zb); + cid = -cid; + c2 = conj(c2); + } + // + // CHECK FOR UNDERFLOW AND OVERFLOW ON FIRST MEMBER + // + fn = fmax(fnu, 1.0); unhj(zn, fn, 0, tol, &phi, &arg, &zeta1, &zeta2, &asum, &bsum); if (kode != 1) { - cfn = fn; - ay = fabs(yy); - s1 = -zeta1 + cfn*(cfn/(zb + zeta2)) + ay*std::complex(0, 1); + cfn = fnu; + s1 = -zeta1 + cfn * (cfn / (zb + zeta2)); } else { s1 = -zeta1 + zeta2; } - // - // TEST FOR UNDERFLOW AND OVERFLOW - // rs1 = std::real(s1); - if (fabs(rs1) > elim) { goto L50; } - if (i == 1) { iflag = 2; } - if (fabs(rs1) >= alim) { + if (fabs(rs1) > elim) { + if (rs1 > 0.) { + *nz = -1; + return; + } + for (i = 0; i < n; i++) { + y[i] = 0.0; + } + return; + } + L10: + nn = (nd > 2 ? 2 : nd); + i = 1; + for (i = 1; i < (nn + 1); i++) { + fn = fnu + (nd - i); + unhj(zn, fn, 0, tol, &phi, &arg, &zeta1, &zeta2, &asum, &bsum); + if (kode != 1) { + cfn = fn; + ay = fabs(yy); + s1 = -zeta1 + cfn * (cfn / (zb + zeta2)) + ay * std::complex(0, 1); + } else { + s1 = -zeta1 + zeta2; + } // - // REFINE TEST AND SCALE + // TEST FOR UNDERFLOW AND OVERFLOW // - aphi = std::abs(phi); - aarg = std::abs(arg); - rs1 += log(aphi) - 0.25*log(aarg) - aic; - if (fabs(rs1) > elim) { goto L50; } - if (i == 1) { iflag = 1; } - if (rs1 >= 0.0){ if (i== 1) { iflag = 3; }} - } - // - // SCALE S1 TO KEEP INTERMEDIATE ARITHMETIC ON SCALE NEAR - // EXPONENT EXTREMES - // - ai = airy(arg, 0, 2, &nai, &idum); - dai = airy(arg, 1, 2, &ndai, &idum); - s2 = phi * (ai*asum + dai*bsum); - c2r = std::exp(std::real(s1))*std::real(css[iflag-1]); - c2i = std::imag(s1); - s1 = c2r*std::complex(cos(c2i), sin(c2i)); - s2 *= s1; - if (iflag == 1) { if (uchk(s2, bry[0], tol)) { goto L50; } } - if (yy <= 0.0) { s2 = conj(s2); } - j = nd - i + 1; - s2 *= c2; - cy[i-1] = s2; - y[j-1] = s2*csr[iflag-1]; - c2 *= cid; - } - if (nd > 2) { - rz = 2.0 / z; - bry[1] = 1.0 / bry[0]; - bry[2] = d1mach[1]; - s1 = cy[0]; - s2 = cy[1]; - c1 = csr[iflag-1]; - ascle = bry[iflag-1]; - k = nd - 2; - fn = k; - for (i = 3; i < (nd+1); i++) { - c2 = s2; - s2 = s1 + (fnu+fn)*rz*s2; - s1 = c2; - c2 = s2*c1; - y[k-1] = c2; - k -= 1; - fn -= 1.0; - if (iflag < 3) { - c2r = fabs(std::real(c2)); - c2i = fabs(std::imag(c2)); - c2m = fmax(c2r, c2i); - if (c2m > ascle) { - iflag += 1; - ascle = bry[iflag-1]; - s1 *= c1; - s2 = c2; - s1 *= css[iflag-1]; - s2 *= css[iflag-1]; - c1 = csr[iflag-1]; + rs1 = std::real(s1); + if (fabs(rs1) > elim) { + goto L50; + } + if (i == 1) { + iflag = 2; + } + if (fabs(rs1) >= alim) { + // + // REFINE TEST AND SCALE + // + aphi = std::abs(phi); + aarg = std::abs(arg); + rs1 += log(aphi) - 0.25 * log(aarg) - aic; + if (fabs(rs1) > elim) { + goto L50; + } + if (i == 1) { + iflag = 1; + } + if (rs1 >= 0.0) { + if (i == 1) { + iflag = 3; + } + } + } + // + // SCALE S1 TO KEEP INTERMEDIATE ARITHMETIC ON SCALE NEAR + // EXPONENT EXTREMES + // + ai = airy(arg, 0, 2, &nai, &idum); + dai = airy(arg, 1, 2, &ndai, &idum); + s2 = phi * (ai * asum + dai * bsum); + c2r = std::exp(std::real(s1)) * std::real(css[iflag - 1]); + c2i = std::imag(s1); + s1 = c2r * std::complex(cos(c2i), sin(c2i)); + s2 *= s1; + if (iflag == 1) { + if (uchk(s2, bry[0], tol)) { + goto L50; + } + } + if (yy <= 0.0) { + s2 = conj(s2); + } + j = nd - i + 1; + s2 *= c2; + cy[i - 1] = s2; + y[j - 1] = s2 * csr[iflag - 1]; + c2 *= cid; + } + if (nd > 2) { + rz = 2.0 / z; + bry[1] = 1.0 / bry[0]; + bry[2] = d1mach[1]; + s1 = cy[0]; + s2 = cy[1]; + c1 = csr[iflag - 1]; + ascle = bry[iflag - 1]; + k = nd - 2; + fn = k; + for (i = 3; i < (nd + 1); i++) { + c2 = s2; + s2 = s1 + (fnu + fn) * rz * s2; + s1 = c2; + c2 = s2 * c1; + y[k - 1] = c2; + k -= 1; + fn -= 1.0; + if (iflag < 3) { + c2r = fabs(std::real(c2)); + c2i = fabs(std::imag(c2)); + c2m = fmax(c2r, c2i); + if (c2m > ascle) { + iflag += 1; + ascle = bry[iflag - 1]; + s1 *= c1; + s2 = c2; + s1 *= css[iflag - 1]; + s2 *= css[iflag - 1]; + c1 = csr[iflag - 1]; + } + } + } + } + return; + L50: + if (rs1 <= 0.0) { + // + // SET UNDERFLOW AND UPDATE PARAMETERS + // + y[nd - 1] = 0.0; + nz += 1; + nd -= 1; + if (nd == 0) { + return; + } + nuf = uoik(z, fnu, kode, 1, nd, y, tol, elim, alim); + if (nuf >= 0) { + nd -= nuf; + nz += nuf; + if (nd == 0) { + return; + } + fn = fnu + nd - 1; + if (fn >= fnul) { + // The following was commented out in the original F77 code + // C FN = CIDI + // C J = NUF + 1 + // C K = MOD(J,4) + 1 + // C S1R = CIPR(K) + // C S1I = CIPI(K) + // C IF (FN.LT.0.0D0) S1I = -S1I + // C STR = C2R*S1R - C2I*S1I + // C C2I = C2R*S1I + C2I*S1R + // C C2R = STR + in = (inu + nd - 1) % 4; + c2 = zar * cip[in]; + if (yy <= 0.0) { + c2 = conj(c2); + } + goto L10; } + *nlast = nd; + return; } } + *nz = -1; + return; } - return; -L50: - if (rs1 <= 0.0) { + + inline void unik( + std::complex zr, double fnu, int ikflg, int ipmtr, double tol, int *init, std::complex *phi, + std::complex *zeta1, std::complex *zeta2, std::complex *total, + std::complex *cwrk + ) { + + //***BEGIN PROLOGUE ZUNIK + //***REFER TO ZBESI,ZBESK // - // SET UNDERFLOW AND UPDATE PARAMETERS + // ZUNIK COMPUTES PARAMETERS FOR THE UNIFORM ASYMPTOTIC + // EXPANSIONS OF THE I AND K FUNCTIONS ON IKFLG= 1 OR 2 + // RESPECTIVELY BY // - y[nd-1] = 0.0; - nz += 1; - nd -= 1; - if (nd == 0) { return; } - nuf = uoik(z, fnu, kode, 1, nd, y, tol, elim, alim); - if (nuf >= 0) { - nd -= nuf; - nz += nuf; - if (nd == 0) { return; } - fn = fnu + nd - 1; - if (fn >= fnul) { - // The following was commented out in the original F77 code - // C FN = CIDI - // C J = NUF + 1 - // C K = MOD(J,4) + 1 - // C S1R = CIPR(K) - // C S1I = CIPI(K) - // C IF (FN.LT.0.0D0) S1I = -S1I - // C STR = C2R*S1R - C2I*S1I - // C C2I = C2R*S1I + C2I*S1R - // C C2R = STR - in = (inu + nd - 1) % 4; - c2 = zar*cip[in]; - if (yy <= 0.0) { c2 = conj(c2); } - goto L10; - } - *nlast = nd; - return; + // W(FNU,ZR) = PHI*EXP(ZETA)*SUM + // + // WHERE ZETA=-ZETA1 + ZETA2 OR + // ZETA1 - ZETA2 + // + // THE FIRST CALL MUST HAVE INIT=0. SUBSEQUENT CALLS WITH THE + // SAME ZR AND FNU WILL RETURN THE I OR K FUNCTION ON IKFLG= + // 1 OR 2 WITH NO CHANGE IN INIT. CWRK IS A COMPLEX WORK + // ARRAY. IPMTR=0 COMPUTES ALL PARAMETERS. IPMTR=1 COMPUTES PHI, + // ZETA1,ZETA2. + // + //***ROUTINES CALLED ZDIV,AZLOG,AZSQRT,D1MACH + //***END PROLOGUE ZUNIK + + std::complex cfn, crfn, s, sr, t, t2, zn; + double ac, rfn, test, tstr, tsti; + int i, j, k, l; + /* ( 1/sqrt(2 PI), sqrt(PI/2) ) */ + double con[2] = {3.98942280401432678e-01, 1.25331413731550025}; + + if (*init == 0) { + rfn = 1. / fnu; + crfn = rfn; + + tstr = std::real(zr); + tsti = std::imag(zr); + test = d1mach[0] * 1e3; + ac = fnu * test; + if ((fabs(tstr) <= ac) && (fabs(tsti) <= ac)) { + ac = 2.0 * fabs(log(test)) + fnu; + *zeta1 = ac; + *zeta2 = fnu; + *phi = 1.0; + } + t = zr * crfn; + s = 1.0 + t * t; + sr = std::sqrt(s); + cfn = fnu; + zn = (1. + sr) / t; + *zeta1 = cfn * std::log(zn); + *zeta2 = cfn * sr; + t = 1.0 / sr; + sr = t * crfn; + cwrk[15] = std::sqrt(sr); + *phi = cwrk[15] * con[ikflg - 1]; + if (ipmtr != 0) { + return; + } + t2 = 1. / s; + cwrk[0] = 1.; + crfn = 1.; + ac = 1.; + l = 1; + k = 2; + for (k = 2; k < 16; k++) { + s = 0.0; + for (j = 1; j < (k + 1); j++) { + l += 1; + s = s * t2 + zunik_c[l - 1]; + } + crfn *= sr; + cwrk[k - 1] = crfn * s; + ac *= rfn; + tstr = std::real(cwrk[k - 1]); + tsti = std::imag(cwrk[k - 1]); + test = fabs(tstr) + fabs(tsti); + if ((ac < tol) && (test < tol)) { + break; + } + } + /* Guard against exhausted loop */ + if (k == 16) { + k -= 1; + } + *init = k; } - } - *nz = -1; - return; -} - - -inline void unik( - std::complex zr, - double fnu, - int ikflg, - int ipmtr, - double tol, - int *init, - std::complex *phi, - std::complex *zeta1, - std::complex *zeta2, - std::complex *total, - std::complex *cwrk -) { - - //***BEGIN PROLOGUE ZUNIK - //***REFER TO ZBESI,ZBESK - // - // ZUNIK COMPUTES PARAMETERS FOR THE UNIFORM ASYMPTOTIC - // EXPANSIONS OF THE I AND K FUNCTIONS ON IKFLG= 1 OR 2 - // RESPECTIVELY BY - // - // W(FNU,ZR) = PHI*EXP(ZETA)*SUM - // - // WHERE ZETA=-ZETA1 + ZETA2 OR - // ZETA1 - ZETA2 - // - // THE FIRST CALL MUST HAVE INIT=0. SUBSEQUENT CALLS WITH THE - // SAME ZR AND FNU WILL RETURN THE I OR K FUNCTION ON IKFLG= - // 1 OR 2 WITH NO CHANGE IN INIT. CWRK IS A COMPLEX WORK - // ARRAY. IPMTR=0 COMPUTES ALL PARAMETERS. IPMTR=1 COMPUTES PHI, - // ZETA1,ZETA2. - // - //***ROUTINES CALLED ZDIV,AZLOG,AZSQRT,D1MACH - //***END PROLOGUE ZUNIK - std::complex cfn, crfn, s, sr, t, t2, zn; - double ac, rfn, test, tstr, tsti; - int i, j, k, l; - /* ( 1/sqrt(2 PI), sqrt(PI/2) ) */ - double con[2] = { 3.98942280401432678e-01, 1.25331413731550025 }; + *total = 0.0; + t = 1.0; + if (ikflg != 2) { - if (*init == 0) { - rfn = 1. / fnu; - crfn = rfn; + for (i = 0; i < (*init); i++) { + *total += cwrk[i]; + } + *phi = cwrk[15] * con[0]; - tstr = std::real(zr); - tsti = std::imag(zr); - test = d1mach[0] * 1e3; - ac = fnu * test; - if ((fabs(tstr) <= ac) && (fabs(tsti) <= ac)) { - ac = 2.0 * fabs(log(test)) + fnu; - *zeta1 = ac; - *zeta2 = fnu; - *phi = 1.0; - } - t = zr * crfn; - s = 1.0 + t*t; - sr = std::sqrt(s); - cfn = fnu; - zn = (1. + sr) / t; - *zeta1 = cfn * std::log(zn); - *zeta2 = cfn * sr; - t = 1.0 / sr; - sr = t*crfn; - cwrk[15] = std::sqrt(sr); - *phi = cwrk[15]*con[ikflg-1]; - if (ipmtr != 0) { return; } - t2 = 1. / s; - cwrk[0] = 1.; - crfn = 1.; - ac = 1.; - l = 1; - k = 2; - for (k = 2; k < 16; k++) - { - s = 0.0; - for (j = 1; j < (k+1); j++) - { - l += 1; - s = s*t2 + zunik_c[l-1]; - } - crfn *= sr; - cwrk[k-1] = crfn*s; - ac *= rfn; - tstr = std::real(cwrk[k-1]); - tsti = std::imag(cwrk[k-1]); - test = fabs(tstr) + fabs(tsti); - if ((ac < tol) && (test < tol)) { - break; + } else { + + for (i = 1; i < (*init + 1); i++) { + *total += t * cwrk[i - 1]; + t = -t; } + *phi = cwrk[15] * con[1]; } - /* Guard against exhausted loop */ - if (k == 16) { k-=1; } - *init = k; + return; } - *total = 0.0; - t = 1.0; - if (ikflg != 2) { + inline int unk1( + std::complex z, double fnu, int kode, int mr, int n, std::complex *y, double tol, double elim, + double alim + ) { - for (i = 0; i < (*init); i++) { - *total += cwrk[i]; - } - *phi = cwrk[15] * con[0]; + //***BEGIN PROLOGUE ZUNK1 + //***REFER TO ZBESK + // + // ZUNK1 COMPUTES K(FNU,Z) AND ITS ANALYTIC CONTINUATION FROM THE + // RIGHT HALF PLANE TO THE LEFT HALF PLANE BY MEANS OF THE + // UNIFORM ASYMPTOTIC EXPANSION. + // MR INDICATES THE DIRECTION OF ROTATION FOR ANALYTIC CONTINUATION. + // NZ=-1 MEANS AN OVERFLOW WILL OCCUR + // + //***ROUTINES CALLED ZKSCL,ZS1S2,ZUCHK,ZUNIK,D1MACH,AZABS + //***END PROLOGUE ZUNK1 - } else { + std::complex cfn, ck, crsc, cs, cscl, csgn, cspn, c1, c2, rz, s1, s2, zr, phid, zeta1d = 0.0, + zeta2d = 0.0, sumd; + double ang, aphi, asc, ascle, c2i, c2m, c2r, fmr, fn, fnf, rs1, sgn, x; + int i, ib, iflag = 0, ifn, il, inu, iuf, k, kdflg, kflag, kk, m, nw, nz, j, jc, ipard, initd, ic; + + cscl = 1.0 / tol; + crsc = tol; + std::complex css[3] = {cscl, 1.0, crsc}; + std::complex csr[3] = {crsc, 1.0, cscl}; + std::complex cwrk[3][16] = {{0.0}}; + std::complex phi[2] = {0.0}; + std::complex sum[2] = {0.0}; + std::complex zeta1[2] = {0.0}; + std::complex zeta2[2] = {0.0}; + std::complex cy[2] = {0.0}; + double bry[3] = {1e3 * d1mach[0] / tol, tol / 1e3 * d1mach[0], d1mach[1]}; + int init[2] = {0}; + double pi = 3.14159265358979324; - for (i = 1; i < (*init + 1); i++) { - *total += t * cwrk[i-1]; - t = -t; + kdflg = 1; + kflag = 1; + fn = fnu; + nz = 0; + x = std::real(z); + zr = z; + if (x < 0.0) { + zr = -z; } - *phi = cwrk[15] * con[1]; + j = 2; + for (i = 1; i < (n + 1); i++) { + j = 3 - j; /* j flip flops between 1, 2 */ + jc = j - 1; /* dummy index for 0-indexing */ + fn = fnu + (i - 1); + init[jc] = 0; + unik(zr, fn, 2, 0, tol, &init[jc], &phi[jc], &zeta1[jc], &zeta2[jc], &sum[jc], &cwrk[jc][0]); + if (kode != 1) { + cfn = fn; + s1 = zeta1[jc] - cfn * (cfn / (zr + zeta2[jc])); + } else { + s1 = zeta1[jc] - zeta2[jc]; + } + // + // TEST FOR UNDERFLOW AND OVERFLOW + // + rs1 = std::real(s1); + if (fabs(rs1) <= elim) { + if (kdflg == 1) { + kflag = 2; + } + if (fabs(rs1) >= alim) { + // + // REFINE TEST AND SCALE + // + aphi = std::abs(phi[jc]); + rs1 += log(aphi); + if (fabs(rs1) > elim) { + goto L10; + } + if (kdflg == 1) { + kflag = 1; + } + if (rs1 >= 0.0) { + if (kdflg == 1) { + kflag = 3; + } + } + } - } - return; -} - - -inline int unk1( - std::complex z, - double fnu, - int kode, - int mr, - int n, - std::complex *y, - double tol, - double elim, - double alim -) { - - //***BEGIN PROLOGUE ZUNK1 - //***REFER TO ZBESK - // - // ZUNK1 COMPUTES K(FNU,Z) AND ITS ANALYTIC CONTINUATION FROM THE - // RIGHT HALF PLANE TO THE LEFT HALF PLANE BY MEANS OF THE - // UNIFORM ASYMPTOTIC EXPANSION. - // MR INDICATES THE DIRECTION OF ROTATION FOR ANALYTIC CONTINUATION. - // NZ=-1 MEANS AN OVERFLOW WILL OCCUR - // - //***ROUTINES CALLED ZKSCL,ZS1S2,ZUCHK,ZUNIK,D1MACH,AZABS - //***END PROLOGUE ZUNK1 - - std::complex cfn, ck, crsc, cs, cscl, csgn, cspn, c1, c2, rz, s1, s2, zr,\ - phid, zeta1d = 0.0, zeta2d = 0.0, sumd; - double ang, aphi, asc, ascle, c2i, c2m, c2r, fmr, fn, fnf, rs1, sgn, x; - int i, ib, iflag = 0, ifn, il, inu, iuf, k, kdflg, kflag, kk, m, nw, nz, j,\ - jc, ipard, initd, ic; - - cscl = 1.0 / tol; - crsc = tol; - std::complex css[3] = {cscl, 1.0, crsc }; - std::complex csr[3] = {crsc, 1.0, cscl }; - std::complex cwrk[3][16] = {{ 0.0 }}; - std::complex phi[2] = { 0.0 }; - std::complex sum[2] = { 0.0 }; - std::complex zeta1[2] = { 0.0 }; - std::complex zeta2[2] = { 0.0 }; - std::complex cy[2] = { 0.0 }; - double bry[3] = { 1e3*d1mach[0] / tol, tol / 1e3*d1mach[0], d1mach[1]}; - int init[2] = { 0 }; - double pi = 3.14159265358979324; - - kdflg = 1; - kflag = 1; - fn = fnu; - nz = 0; - x = std::real(z); - zr = z; - if (x < 0.0) { zr = -z; } - j = 2; - for (i = 1; i < (n+1); i++) - { - j = 3 - j; /* j flip flops between 1, 2 */ - jc = j - 1; /* dummy index for 0-indexing */ - fn = fnu + (i - 1); - init[jc] = 0; - unik(zr, fn, 2, 0, tol, &init[jc], &phi[jc], &zeta1[jc], &zeta2[jc], &sum[jc], &cwrk[jc][0]); - if (kode != 1) { - cfn = fn; - s1 = zeta1[jc] - cfn*(cfn / (zr + zeta2[jc])); - } else { - s1 = zeta1[jc] - zeta2[jc]; + // + // SCALE S1 TO KEEP INTERMEDIATE ARITHMETIC ON SCALE NEAR + // EXPONENT EXTREMES + // + s2 = phi[jc] * sum[jc]; + c2r = std::real(s1); + c2i = std::imag(s1); + c2m = exp(c2r) * std::real(css[kflag - 1]); + s1 = c2m * std::complex(cos(c2i), sin(c2i)); + s2 *= s1; + if (!((kflag == 1) && (uchk(s2, bry[0], tol)))) { + cy[kdflg - 1] = s2; + y[i - 1] = s2 * csr[kflag - 1]; + if (kdflg == 2) { + break; + } + kdflg = 2; + continue; + } + } + L10: + if (rs1 > 0.0) { + return -1; + } + if (x < 0.0) { + return -1; + } + kdflg = 1; + y[i - 1] = 0.0; + nz += 1; + if (i > 1) { + if (y[i - 2] != 0.0) { + y[i - 2] = 0.0; + nz += 1; + } + } + } + /* Check for exhausted loop */ + if (i == (n + 1)) { + i = n; + } + + rz = 2.0 / zr; + ck = fn * rz; + ib = i + 1; + if (n >= ib) { + // + // TEST LAST MEMBER FOR UNDERFLOW AND OVERFLOW, SET SEQUENCE TO ZERO + // ON UNDERFLOW + // + fn = fnu + (n - 1); + ipard = 1; + if (mr != 0) { + ipard = 0; + } + initd = 0; + unik(zr, fn, 2, ipard, tol, &initd, &phid, &zeta1d, &zeta2d, &sumd, &cwrk[2][0]); + if (kode != 1) { + cfn = fn; + s1 = zeta1d - cfn * (cfn / (zr + zeta2d)); + } else { + s1 = zeta1d - zeta2d; + } + rs1 = std::real(s1); + if (fabs(rs1) <= elim) { + if (fabs(rs1) < alim) { + goto L50; + } + // + // REFINE ESTIMATE AND TEST + // + aphi = std::abs(phid); + rs1 += log(aphi); + if (fabs(rs1) < elim) { + goto L50; + } + } + if (rs1 > 0.0) { + return -1; + } + // + // FOR X < 0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW + // + if (x < 0.0) { + return -1; + } + nz = n; + for (i = 0; i < (n + 1); i++) { + y[i] = 0.0; + } + return nz; + L50: + // + // RECUR FORWARD FOR REMAINDER OF THE SEQUENCE + // + s1 = cy[0]; + s2 = cy[1]; + c1 = csr[kflag - 1]; + ascle = bry[kflag - 1]; + for (i = ib; i < (n + 1); i++) { + c2 = s2; + s2 = ck * s2 + s1; + s1 = c2; + ck += rz; + c2 = s2 * c1; + y[i - 1] = c2; + if (kflag < 3) { + c2m = fmax(fabs(std::real(c2)), fabs(std::imag(c2))); + if (c2m > ascle) { + kflag += 1; + ascle = bry[kflag - 1]; + s1 *= c1; + s2 = c2; + s1 *= css[kflag - 1]; + s2 *= css[kflag - 1]; + c1 = csr[kflag - 1]; + } + } + } + } + if (mr == 0) { + return nz; } // - // TEST FOR UNDERFLOW AND OVERFLOW + // ANALYTIC CONTINUATION FOR RE(Z) < 0.0 // - rs1 = std::real(s1); - if (fabs(rs1) <= elim) { - if (kdflg == 1) { kflag = 2; } + nz = 0; + fmr = mr; + sgn = (fmr < 0.0 ? pi : -pi); + // + // CSPN AND CSGN ARE COEFF OF K AND I FUNCIONS RESP. + // + csgn = std::complex(0.0, sgn); + inu = (int)fnu; + fnf = fnu - inu; + ifn = inu + n - 1; + ang = fnf * sgn; + cspn = std::complex(cos(ang), sin(ang)); + if (ifn % 2 == 1) { + cspn = -cspn; + } + asc = bry[0]; + kk = n; + iuf = 0; + kdflg = 1; + ib -= 1; + ic = ib - 1; + k = 1; + for (k = 1; k < (n + 1); k++) { + fn = fnu + (kk - 1); + // + // LOGIC TO SORT OUT CASES WHOSE PARAMETERS WERE SET FOR THE K + // FUNCTION ABOVE + // + m = 3; + if (n > 2) { + goto L80; + } + L70: + initd = init[j - 1]; + phid = phi[j - 1]; + zeta1d = zeta1[j - 1]; + zeta2d = zeta2[j - 1]; + sumd = sum[j - 1]; + m = j; + j = 3 - j; + goto L90; + L80: + if (!((kk == n) && (ib < n))) { + if ((kk == ib) || (kk == ic)) { + goto L70; + } + initd = 0; + } + L90: + unik(zr, fn, 1, 0, tol, &initd, &phid, &zeta1d, &zeta2d, &sumd, &cwrk[m - 1][0]); + if (kode != 1) { + cfn = fn; + s1 = -zeta1d + cfn * (cfn / (zr + zeta2d)); + } else { + s1 = -zeta1d + zeta2d; + } + // + // TEST FOR UNDERFLOW AND OVERFLOW + // + rs1 = std::real(s1); + if (fabs(rs1) > elim) { + goto L110; + } + if (kdflg == 1) { + iflag = 2; + } if (fabs(rs1) >= alim) { // // REFINE TEST AND SCALE // - aphi = std::abs(phi[jc]); + aphi = std::abs(phid); rs1 += log(aphi); - if (fabs(rs1) > elim) { goto L10; } - if (kdflg == 1) { kflag = 1; } - if (rs1 >= 0.0) { if (kdflg == 1) { kflag = 3; } } + if (fabs(rs1) > elim) { + goto L110; + } + if (kdflg == 1) { + iflag = 1; + } + if (rs1 >= 0.0) { + if (kdflg == 1) { + iflag = 3; + } + } } - // - // SCALE S1 TO KEEP INTERMEDIATE ARITHMETIC ON SCALE NEAR - // EXPONENT EXTREMES - // - s2 = phi[jc]*sum[jc]; + s2 = csgn * phid * sumd; c2r = std::real(s1); c2i = std::imag(s1); - c2m = exp(c2r)*std::real(css[kflag-1]); + c2m = exp(c2r) * std::real(css[iflag - 1]); s1 = c2m * std::complex(cos(c2i), sin(c2i)); s2 *= s1; - if (!((kflag == 1) && (uchk(s2, bry[0], tol)))) { - cy[kdflg-1] = s2; - y[i-1] = s2*csr[kflag-1]; - if (kdflg == 2) { break; } - kdflg = 2; + if (iflag == 1) { + if (uchk(s2, bry[0], tol)) { + s2 = 0.0; + } + } + L100: + cy[kdflg - 1] = s2; + c2 = s2; + s2 *= csr[iflag - 1]; + // + // ADD I AND K FUNCTIONS, K SEQUENCE IN Y(I), I=1,N + // + s1 = y[kk - 1]; + if (kode != 1) { + nw = s1s2(zr, &s1, &s2, asc, alim, &iuf); + nz += nw; + } + y[kk - 1] = s1 * cspn + s2; + kk -= 1; + cspn = -cspn; + if (c2 == 0.0) { + kdflg = 1; continue; } - } -L10: - if (rs1 > 0.0 ) { return -1; } - if (x < 0.0) { return -1; } - kdflg = 1; - y[i-1] = 0.0; - nz += 1; - if (i > 1) { - if (y[i-2] != 0.0) { - y[i-2] = 0.0; - nz += 1; + if (kdflg == 2) { + goto L130; } + kdflg = 2; + continue; + L110: + if (rs1 > 0.0) { + return -1; + } + s2 = 0.0; + goto L100; } - } - /* Check for exhausted loop */ - if (i == (n+1)) { i = n; } - - rz = 2.0 / zr; - ck = fn * rz; - ib = i + 1; - if (n >= ib) { - // - // TEST LAST MEMBER FOR UNDERFLOW AND OVERFLOW, SET SEQUENCE TO ZERO - // ON UNDERFLOW - // - fn = fnu + (n-1); - ipard = 1; - if (mr != 0) { ipard = 0; } - initd = 0; - unik(zr, fn, 2, ipard, tol, &initd, &phid, &zeta1d, &zeta2d, &sumd, &cwrk[2][0]); - if (kode != 1) { - cfn = fn; - s1 = zeta1d - cfn*(cfn / (zr + zeta2d)); - } else { - s1 = zeta1d - zeta2d; - } - rs1 = std::real(s1); - if (fabs(rs1) <= elim) { - if (fabs(rs1) < alim) { goto L50; } - // - // REFINE ESTIMATE AND TEST - // - aphi = std::abs(phid); - rs1 += log(aphi); - if (fabs(rs1) < elim) { goto L50; } + /* If loop is exhausted */ + if (k == n + 1) { + k -= 1; } - if (rs1 > 0.0) { return -1; } - // - // FOR X < 0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW - // - if (x < 0.0) { return -1; } - nz = n; - for (i = 0; i < (n+1); i++) { y[i] = 0.0; } - return nz; -L50: - // - // RECUR FORWARD FOR REMAINDER OF THE SEQUENCE - // + L130: + il = n - k; + if (il == 0) { + return nz; + }; s1 = cy[0]; s2 = cy[1]; - c1 = csr[kflag-1]; - ascle = bry[kflag-1]; - for (i = ib; i < (n+1); i++) - { + cs = csr[iflag - 1]; + ascle = bry[iflag - 1]; + fn = inu + il; + for (i = 1; i < (il + 1); i++) { c2 = s2; - s2 = ck*s2 + s1; + s2 = s1 + (fn + fnf) * rz * s2; s1 = c2; - ck += rz; - c2 = s2*c1; - y[i-1] = c2; - if (kflag < 3) { + fn -= 1.0; + c2 = s2 * cs; + ck = c2; + c1 = y[kk - 1]; + if (kode != 1) { + nw = s1s2(zr, &c1, &c2, asc, alim, &iuf); + nz = nz + nw; + } + y[kk - 1] = c1 * cspn + c2; + kk -= 1; + cspn = -cspn; + if (iflag < 3) { c2m = fmax(fabs(std::real(c2)), fabs(std::imag(c2))); if (c2m > ascle) { - kflag += 1; - ascle = bry[kflag-1]; - s1 *= c1; - s2 = c2; - s1 *= css[kflag-1]; - s2 *= css[kflag-1]; - c1 = csr[kflag-1]; + iflag += 1; + ascle = bry[iflag - 1]; + s1 *= cs; + s2 = ck; + s1 *= css[iflag - 1]; + s2 *= css[iflag - 1]; + cs = csr[iflag - 1]; } } } + return nz; } - if (mr == 0) { return nz; } - // - // ANALYTIC CONTINUATION FOR RE(Z) < 0.0 - // - nz = 0; - fmr = mr; - sgn = (fmr < 0.0 ? pi : -pi ); - // - // CSPN AND CSGN ARE COEFF OF K AND I FUNCIONS RESP. - // - csgn = std::complex(0.0, sgn); - inu = (int)fnu; - fnf = fnu - inu; - ifn = inu + n - 1; - ang = fnf * sgn; - cspn = std::complex(cos(ang), sin(ang)); - if (ifn % 2 == 1) { cspn = -cspn; } - asc = bry[0]; - kk = n; - iuf = 0; - kdflg = 1; - ib -= 1; - ic = ib - 1; - k = 1; - for (k = 1; k < (n+1); k++) - { - fn = fnu + (kk-1); - // - // LOGIC TO SORT OUT CASES WHOSE PARAMETERS WERE SET FOR THE K - // FUNCTION ABOVE - // - m = 3; - if (n > 2) { goto L80; } -L70: - initd = init[j-1]; - phid = phi[j -1]; - zeta1d = zeta1[j-1]; - zeta2d = zeta2[j-1]; - sumd = sum[j-1]; - m = j; - j = 3 - j; - goto L90; -L80: - if (!((kk == n) && (ib < n))) { - if ((kk == ib) || (kk == ic)){ goto L70; } - initd = 0; + + inline int unk2( + std::complex z, double fnu, int kode, int mr, int n, std::complex *y, double tol, double elim, + double alim + ) { + + //***BEGIN PROLOGUE ZUNK2 + //***REFER TO ZBESK + // + // ZUNK2 COMPUTES K(FNU,Z) AND ITS ANALYTIC CONTINUATION FROM THE + // RIGHT HALF PLANE TO THE LEFT HALF PLANE BY MEANS OF THE + // UNIFORM ASYMPTOTIC EXPANSIONS FOR H(KIND,FNU,ZN) AND J(FNU,ZN) + // WHERE ZN IS IN THE RIGHT HALF PLANE, KIND=(3-MR)/2, MR=+1 OR + // -1. HERE ZN=ZR*I OR -ZR*I WHERE ZR=Z IF Z IS IN THE RIGHT + // HALF PLANE OR ZR=-Z IF Z IS IN THE LEFT HALF PLANE. MR INDIC- + // ATES THE DIRECTION OF ROTATION FOR ANALYTIC CONTINUATION. + // NZ=-1 MEANS AN OVERFLOW WILL OCCUR + // + //***ROUTINES CALLED ZAIRY,ZKSCL,ZS1S2,ZUCHK,ZUNHJ,D1MACH,AZABS + //***END PROLOGUE ZUNK2 + + std::complex ai, cfn, ck, cs, csgn, cspn, c1, c2, dai, rz, s1, s2, zb, zn, zr, phid, argd, zeta1d, + zeta2d, asumd, bsumd; + double aarg, ang, aphi, asc, ascle, car, cpn, c2i, c2m, c2r, crsc, cscl, fmr, fn, fnf, rs1, sar, sgn, spn, x, + yy; + int i, ib, iflag = 0, ifn, il, in, inu, iuf, k, kdflg, kflag, kk, nai, ndai, nw, nz, idum, j, ipard, ic; + + std::complex cr1 = std::complex(1.0, 1.73205080756887729); /* 1 + sqrt(3)i */ + std::complex cr2 = std::complex(-0.5, -8.66025403784438647e-1); /* 0.5 cr1 */ + double hpi = 1.57079632679489662; /* 0.5 pi */ + double pi = 3.14159265358979324; + double aic = 1.26551212348464539; /* log(2 sqrt(pi)) */ + std::complex cip[4] = {1.0, -std::complex(0, 1), -1.0, std::complex(0, 1)}; + cscl = 1.0 / tol; + crsc = tol; + std::complex css[3] = {cscl, 1.0, crsc}; + std::complex csr[3] = {crsc, 1.0, cscl}; + std::complex phi[2] = {0.0}; + std::complex arg[2] = {0.0}; + std::complex zeta1[2] = {0.0}; + std::complex zeta2[2] = {0.0}; + std::complex asum[2] = {0.0}; + std::complex bsum[2] = {0.0}; + std::complex cy[2] = {0.0}; + double bry[3] = {(1.0 + 1e3 * d1mach[0] / tol), 1.0 / (1.0 + 1e3 * d1mach[0] / tol), d1mach[1]}; + + kdflg = 1; + kflag = 1; + fn = fnu; + nz = 0; + // + // EXP(-ALIM)=EXP(-ELIM)/TOL=APPROX. ONE PRECISION GREATER THAN + // THE UNDERFLOW LIMIT + // + x = std::real(z); + zr = z; + if (x < 0.0) { + zr = -z; } -L90: - unik(zr, fn, 1, 0, tol, &initd, &phid, &zeta1d, &zeta2d, &sumd, &cwrk[m-1][0]); - if (kode != 1) { - cfn = fn; - s1 = -zeta1d + cfn * (cfn/(zr + zeta2d)); - } else { - s1 = -zeta1d + zeta2d; + yy = std::imag(zr); + zn = -zr * std::complex(0, 1); + zb = zr; + inu = (int)fnu; + fnf = fnu - inu; + ang = -hpi * fnf; + car = cos(ang); + sar = sin(ang); + cpn = hpi * car; + spn = hpi * sar; + c2 = std::complex(spn, -cpn); + kk = (inu % 4) + 1; + cs = cr1 * c2 * cip[kk - 1]; + if (yy <= 0.0) { + zn = conj(-zn); + zb = conj(zb); } // - // TEST FOR UNDERFLOW AND OVERFLOW + // K(FNU,Z) IS COMPUTED FROM H(2,FNU,-I*Z) WHERE Z IS IN THE FIRST + // QUADRANT. FOURTH QUADRANT VALUES (YY <= 0.0_dp) ARE COMPUTED BY + // CONJUGATION SINCE THE K FUNCTION IS REAL ON THE POSITIVE REAL AXIS // - rs1 = std::real(s1); - if (fabs(rs1) > elim) { goto L110; } - if (kdflg == 1) { iflag = 2; } - if (fabs(rs1) >= alim) { + j = 2; + for (i = 1; i < (n + 1); i++) { + j = 3 - j; + fn = fnu + (i - 1); + unhj(zn, fn, 0, tol, &phi[j - 1], &arg[j - 1], &zeta1[j - 1], &zeta2[j - 1], &asum[j - 1], &bsum[j - 1]); + if (kode != 1) { + cfn = fn; + s1 = zeta1[j - 1] - cfn * (cfn / (zb + zeta2[j - 1])); + } else { + s1 = zeta1[j - 1] - zeta2[j - 1]; + } + // + // TEST FOR UNDERFLOW AND OVERFLOW + // + rs1 = std::real(s1); + if (fabs(rs1) <= elim) { + if (kdflg == 1) { + kflag = 2; + } + if (fabs(rs1) >= alim) { + // + // REFINE TEST AND SCALE + // + aphi = std::abs(phi[j - 1]); + aarg = std::abs(arg[j - 1]); + rs1 += log(aphi) - 0.25 * log(aarg) - aic; + if (fabs(rs1) > elim) { + /* GO TO 70 */ + if (rs1 > 0.0) { + return -1; + } + /* FOR X < 0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW */ + if (x < 0.0) { + return -1; + } + kdflg = 1; + y[i - 1] = 0.0; + cs *= -std::complex(0, 1); + nz += 1; + if (i != 1) { + if (y[i - 2] != 0.0) { + y[i - 2] = 0.0; + nz += 1; + } + } + continue; + } + if (kdflg == 1) { + kflag = 1; + } + if (rs1 >= 0.0) { + if (kdflg == 1) { + kflag = 3; + } + } + } + // + // SCALE S1 TO KEEP INTERMEDIATE ARITHMETIC ON SCALE NEAR + // EXPONENT EXTREMES + // + c2 = arg[j - 1] * cr2; + ai = airy(c2, 0, 2, &nai, &idum); + dai = airy(c2, 1, 2, &ndai, &idum); + s2 = cs * phi[j - 1] * (ai * asum[j - 1] + cr2 * dai * bsum[j - 1]); + c2r = std::real(s1); + c2i = std::imag(s1); + c2m = exp(c2r) * std::real(css[kflag - 1]); + s1 = c2m * std::complex(cos(c2i), sin(c2i)); + s2 *= s1; + if (kflag == 1) { + if (uchk(s2, bry[0], tol)) { + /* GO TO 70 */ + if (rs1 > 0.0) { + return -1; + } + /* FOR X < 0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW */ + if (x < 0.0) { + return -1; + } + kdflg = 1; + y[i - 1] = 0.0; + cs *= -std::complex(0, 1); + nz += 1; + if (i != 1) { + if (y[i - 2] != 0.0) { + y[i - 2] = 0.0; + nz += 1; + } + } + continue; + } + } + if (yy <= 0.0) { + s2 = conj(s2); + } + cy[kdflg - 1] = s2; + y[i - 1] = s2 * csr[kflag - 1]; + cs *= -std::complex(0, 1); + if (kdflg == 2) { + break; + } + kdflg = 2; + continue; + } + /* GO TO 70 */ + if (rs1 > 0.0) { + return -1; + } + /* FOR X < 0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW */ + if (x < 0.0) { + return -1; + } + kdflg = 1; + y[i - 1] = 0.0; + cs *= -std::complex(0, 1); + nz += 1; + if (i != 1) { + if (y[i - 2] != 0.0) { + y[i - 2] = 0.0; + nz += 1; + } + } + continue; + } + /* Check for exhausted loop */ + if (i == n + 1) { + i = n; + } + + rz = 2.0 / zr; + ck = fn * rz; + ib = i + 1; + if (n >= ib) { + fn = fnu + (n - 1); + ipard = 1; + if (mr != 0) { + ipard = 0; + } + unhj(zn, fn, ipard, tol, &phid, &argd, &zeta1d, &zeta2d, &asumd, &bsumd); + if (kode != 1) { + cfn = fn; + s1 = zeta1d - cfn * (cfn / (zb + zeta2d)); + } else { + s1 = zeta1d - zeta2d; + } + rs1 = std::real(s1); + if (fabs(rs1) <= elim) { + if (fabs(rs1) < alim) { + goto L120; + } + // + // REFINE ESTIMATE AND TEST + // + aphi = std::abs(phid); + aarg = std::abs(argd); + rs1 += log(aphi) - 0.25 * log(aarg) - aic; + if (fabs(rs1) < elim) { + goto L120; + } + } + if (rs1 > 0.0) { + return -1; + } + // + // FOR X < 0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW + // + if (x < 0.0) { + return -1; + } + nz = n; + for (i = 0; i < n; i++) { + y[i] = 0.0; + } + return nz; + L120: // - // REFINE TEST AND SCALE + // SCALED FORWARD RECURRENCE FOR REMAINDER OF THE SEQUENCE // - aphi = std::abs(phid); - rs1 += log(aphi); - if (fabs(rs1) > elim) { goto L110; } - if (kdflg == 1) { iflag = 1; } - if (rs1 >= 0.0) { if (kdflg == 1) { iflag = 3; } } - } - - s2 = csgn * phid * sumd; - c2r = std::real(s1); - c2i = std::imag(s1); - c2m = exp(c2r) * std::real(css[iflag-1]); - s1 = c2m * std::complex(cos(c2i), sin(c2i)); - s2 *= s1; - if (iflag == 1) { if (uchk(s2, bry[0], tol)) { s2 = 0.0; } } -L100: - cy[kdflg -1] = s2; - c2 = s2; - s2 *= csr[iflag-1]; - // - // ADD I AND K FUNCTIONS, K SEQUENCE IN Y(I), I=1,N - // - s1 = y[kk-1]; - if (kode != 1) { - nw = s1s2(zr, &s1, &s2, asc, alim, &iuf); - nz += nw; + s1 = cy[0]; + s2 = cy[1]; + c1 = csr[kflag - 1]; + ascle = bry[kflag - 1]; + for (i = ib; i < (n + 1); i++) { + c2 = s2; + s2 = ck * s2 + s1; + s1 = c2; + ck += rz; + c2 = s2 * c1; + y[i - 1] = c2; + if (kflag < 3) { + c2m = fmax(fabs(std::real(c2)), fabs(std::imag(c2))); + if (c2m > ascle) { + kflag += 1; + ascle = bry[kflag - 1]; + s1 *= c1; + s2 = c2; + s1 *= css[kflag - 1]; + s2 *= css[kflag - 1]; + c1 = csr[kflag - 1]; + } + } + } } - y[kk-1] = s1*cspn + s2; - kk -= 1; - cspn = -cspn; - if (c2 == 0.0) { - kdflg = 1; - continue; + if (mr == 0) { + return nz; } - if (kdflg == 2) { goto L130; } - kdflg = 2; - continue; -L110: - if (rs1 > 0.0) { return -1; } - s2 = 0.0; - goto L100; - } - /* If loop is exhausted */ - if (k == n+1) { k -= 1; } -L130: - il = n-k; - if (il == 0) { return nz; }; - s1 = cy[0]; - s2 = cy[1]; - cs = csr[iflag-1]; - ascle = bry[iflag-1]; - fn = inu + il; - for (i = 1; i < (il+1); i++) - { - c2 = s2; - s2 = s1 + (fn + fnf) * rz * s2; - s1 = c2; - fn -= 1.0; - c2 = s2 * cs; - ck = c2; - c1 = y[kk-1]; - if (kode != 1) { - nw = s1s2(zr, &c1, &c2, asc, alim, &iuf); - nz = nz + nw; - } - y[kk-1] = c1 * cspn + c2; - kk -= 1; - cspn = -cspn; - if (iflag < 3) { - c2m = fmax(fabs(std::real(c2)), fabs(std::imag(c2))); - if (c2m > ascle) { - iflag += 1; - ascle = bry[iflag-1]; - s1 *= cs; - s2 = ck; - s1 *= css[iflag-1]; - s2 *= css[iflag-1]; - cs = csr[iflag-1]; - } + // + // ANALYTIC CONTINUATION FOR RE(Z) < 0.0 + // + nz = 0; + fmr = mr; + sgn = (fmr < 0.0 ? pi : -pi); + // + // CSPN AND CSGN ARE COEFF OF K AND I FUNCTIONS RESP. + // + csgn = std::complex(0.0, sgn); + if (yy <= 0.0) { + csgn = -csgn; } - } - return nz; -} - - -inline int unk2( - std::complex z, - double fnu, - int kode, - int mr, - int n, - std::complex *y, - double tol, - double elim, - double alim -) { - - //***BEGIN PROLOGUE ZUNK2 - //***REFER TO ZBESK - // - // ZUNK2 COMPUTES K(FNU,Z) AND ITS ANALYTIC CONTINUATION FROM THE - // RIGHT HALF PLANE TO THE LEFT HALF PLANE BY MEANS OF THE - // UNIFORM ASYMPTOTIC EXPANSIONS FOR H(KIND,FNU,ZN) AND J(FNU,ZN) - // WHERE ZN IS IN THE RIGHT HALF PLANE, KIND=(3-MR)/2, MR=+1 OR - // -1. HERE ZN=ZR*I OR -ZR*I WHERE ZR=Z IF Z IS IN THE RIGHT - // HALF PLANE OR ZR=-Z IF Z IS IN THE LEFT HALF PLANE. MR INDIC- - // ATES THE DIRECTION OF ROTATION FOR ANALYTIC CONTINUATION. - // NZ=-1 MEANS AN OVERFLOW WILL OCCUR - // - //***ROUTINES CALLED ZAIRY,ZKSCL,ZS1S2,ZUCHK,ZUNHJ,D1MACH,AZABS - //***END PROLOGUE ZUNK2 - - std::complex ai, cfn, ck, cs, csgn, cspn, c1, c2, dai, rz, s1, s2,\ - zb, zn, zr, phid, argd, zeta1d, zeta2d, asumd, bsumd; - double aarg, ang, aphi, asc, ascle, car, cpn, c2i, c2m, c2r, crsc, cscl,\ - fmr, fn, fnf, rs1, sar, sgn, spn, x, yy; - int i, ib, iflag = 0, ifn, il, in, inu, iuf, k, kdflg, kflag, kk, nai, ndai,\ - nw, nz, idum, j, ipard, ic; - - std::complex cr1 = std::complex(1.0, 1.73205080756887729); /* 1 + sqrt(3)i */ - std::complex cr2 = std::complex(-0.5, -8.66025403784438647e-1); /* 0.5 cr1 */ - double hpi = 1.57079632679489662; /* 0.5 pi */ - double pi = 3.14159265358979324; - double aic = 1.26551212348464539; /* log(2 sqrt(pi)) */ - std::complex cip[4] = {1.0, -std::complex(0, 1), -1.0, std::complex(0, 1)}; - cscl = 1.0 / tol; - crsc = tol; - std::complex css[3] = {cscl, 1.0, crsc }; - std::complex csr[3] = {crsc, 1.0, cscl }; - std::complex phi[2] = { 0.0 }; - std::complex arg[2] = { 0.0 }; - std::complex zeta1[2] = { 0.0 }; - std::complex zeta2[2] = { 0.0 }; - std::complex asum[2] = { 0.0 }; - std::complex bsum[2] = { 0.0 }; - std::complex cy[2] = { 0.0 }; - double bry[3] = { (1.0 + 1e3*d1mach[0] / tol), 1.0/(1.0 + 1e3*d1mach[0] / tol), d1mach[1]}; - - kdflg = 1; - kflag = 1; - fn = fnu; - nz = 0; - // - // EXP(-ALIM)=EXP(-ELIM)/TOL=APPROX. ONE PRECISION GREATER THAN - // THE UNDERFLOW LIMIT - // - x = std::real(z); - zr = z; - if (x < 0.0) { zr = -z; } - yy = std::imag(zr); - zn = -zr*std::complex(0, 1); - zb = zr; - inu = (int)fnu; - fnf = fnu - inu; - ang = -hpi * fnf; - car = cos(ang); - sar = sin(ang); - cpn = hpi * car; - spn = hpi * sar; - c2 = std::complex(spn, -cpn); - kk = (inu % 4) + 1; - cs = cr1 * c2 * cip[kk - 1]; - if (yy <= 0.0) { - zn = conj(-zn); - zb = conj(zb); - } - // - // K(FNU,Z) IS COMPUTED FROM H(2,FNU,-I*Z) WHERE Z IS IN THE FIRST - // QUADRANT. FOURTH QUADRANT VALUES (YY <= 0.0_dp) ARE COMPUTED BY - // CONJUGATION SINCE THE K FUNCTION IS REAL ON THE POSITIVE REAL AXIS - // - j = 2; - for (i = 1; i < (n+1); i++) - { - j = 3 - j; - fn = fnu + (i-1); - unhj(zn, fn, 0, tol, &phi[j-1], &arg[j-1], &zeta1[j-1], &zeta2[j-1], &asum[j-1], &bsum[j-1]); - if (kode != 1) { - cfn = fn; - s1 = zeta1[j-1] - cfn*(cfn/(zb + zeta2[j-1])); - } else { - s1 = zeta1[j-1] - zeta2[j-1]; + ifn = inu + n - 1; + ang = fnf * sgn; + cspn = std::complex(cos(ang), sin(ang)); + if (ifn % 2 == 1) { + cspn = -cspn; } // - // TEST FOR UNDERFLOW AND OVERFLOW + // CS=COEFF OF THE J FUNCTION TO GET THE I FUNCTION. I(FNU,Z) IS + // COMPUTED FROM EXP(I*FNU*HPI)*J(FNU,-I*Z) WHERE Z IS IN THE FIRST + // QUADRANT. FOURTH QUADRANT VALUES (YY <= 0.0_dp) ARE COMPUTED BY + // CONJUGATION SINCE THE I FUNCTION IS REAL ON THE POSITIVE REAL AXIS // - rs1 = std::real(s1); - if (fabs(rs1) <= elim) { - if (kdflg == 1) { kflag = 2; } + cs = std::complex(car, -sar) * csgn; + in = (ifn % 4) + 1; + c2 = cip[in - 1]; + cs *= conj(c2); + asc = bry[0]; + iuf = 0; + kk = n; + kdflg = 1; + ib -= 1; + ic = ib - 1; + for (k = 1; k < (n + 1); k++) { + fn = fnu + (kk - 1); + if (n > 2) { + goto L175; + } + L172: + phid = phi[j - 1]; + argd = arg[j - 1]; + zeta1d = zeta1[j - 1]; + zeta2d = zeta2[j - 1]; + asumd = asum[j - 1]; + bsumd = bsum[j - 1]; + j = 3 - j; + goto L210; + L175: + if (!((kk == n) && (ib < n))) { + if ((kk == ib) || (kk == ic)) { + goto L172; + } + unhj(zn, fn, 0, tol, &phid, &argd, &zeta1d, &zeta2d, &asumd, &bsumd); + } + L210: + if (kode != 1) { + cfn = fn; + s1 = -zeta1d + cfn * (cfn / (zb + zeta2d)); + } else { + s1 = -zeta1d + zeta2d; + } + // + // TEST FOR UNDERFLOW AND OVERFLOW + // + rs1 = std::real(s1); + if (fabs(rs1) > elim) { + if (rs1 > 0.0) { + return -1; + } + s2 = 0.0; + goto L250; + } + if (kdflg == 1) { + iflag = 2; + } if (fabs(rs1) >= alim) { // - // REFINE TEST AND SCALE + // REFINE TEST AND SCALE // - aphi = std::abs(phi[j-1]); - aarg = std::abs(arg[j-1]); - rs1 += log(aphi) - 0.25 * log(aarg) - aic; + aphi = std::abs(phid); + aarg = std::abs(argd); + rs1 += log(aphi) - 0.25f * log(aarg) - aic; if (fabs(rs1) > elim) { - /* GO TO 70 */ - if (rs1 > 0.0) { return -1; } - /* FOR X < 0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW */ - if (x < 0.0) { return -1; } - kdflg = 1; - y[i-1] = 0.0; - cs *= -std::complex(0, 1); - nz += 1; - if (i != 1) { if (y[i-2] != 0.0) { y[i-2] = 0.0;nz += 1; } } - continue; + if (rs1 > 0.0) { + return -1; + } + s2 = 0.0; + goto L250; + } + if (kdflg == 1) { + iflag = 1; + } + if (rs1 >= 0.0) { + if (kdflg == 1) { + iflag = 3; + } } - if (kdflg == 1) { kflag = 1; } - if (rs1 >= 0.0) { if (kdflg == 1) { kflag = 3; } } } - // - // SCALE S1 TO KEEP INTERMEDIATE ARITHMETIC ON SCALE NEAR - // EXPONENT EXTREMES - // - c2 = arg[j-1] * cr2; - ai = airy(c2, 0, 2, &nai, &idum); - dai = airy(c2, 1, 2, &ndai, &idum); - s2 = cs * phi[j-1] * (ai*asum[j-1] + cr2*dai*bsum[j-1]); + + ai = airy(argd, 0, 2, &nai, &idum); + dai = airy(argd, 1, 2, &ndai, &idum); + s2 = cs * phid * (ai * asumd + dai * bsumd); c2r = std::real(s1); c2i = std::imag(s1); - c2m = exp(c2r) * std::real(css[kflag-1]); + c2m = exp(c2r) * std::real(css[iflag - 1]); s1 = c2m * std::complex(cos(c2i), sin(c2i)); s2 *= s1; - if (kflag == 1) { + if (iflag == 1) { if (uchk(s2, bry[0], tol)) { - /* GO TO 70 */ - if (rs1 > 0.0) { return -1; } - /* FOR X < 0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW */ - if (x < 0.0) { return -1; } - kdflg = 1; - y[i-1] = 0.0; - cs *= -std::complex(0, 1); - nz += 1; - if (i != 1) { if (y[i-2] != 0.0) { y[i-2] = 0.0;nz += 1; } } - continue; + s2 = 0.0; } } - if (yy <= 0.0) { s2 = conj(s2); } - cy[kdflg-1] = s2; - y[i-1] = s2 * csr[kflag-1]; + L250: + if (yy <= 0.0) { + s2 = conj(s2); + } + cy[kdflg - 1] = s2; + c2 = s2; + s2 *= csr[iflag - 1]; + // + // ADD I AND K FUNCTIONS, K SEQUENCE IN Y(I), I=1,N + // + s1 = y[kk - 1]; + if (kode != 1) { + nw = s1s2(zr, &s1, &s2, asc, alim, &iuf); + nz += nw; + } + y[kk - 1] = s1 * cspn + s2; + kk -= 1; + cspn = -cspn; cs *= -std::complex(0, 1); - if (kdflg == 2) { break; } + if (c2 == 0.0) { + kdflg = 1; + continue; + } + if (kdflg == 2) { + break; + } kdflg = 2; continue; } - /* GO TO 70 */ - if (rs1 > 0.0) { return -1; } - /* FOR X < 0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW */ - if (x < 0.0) { return -1; } - kdflg = 1; - y[i-1] = 0.0; - cs *= -std::complex(0, 1); - nz += 1; - if (i != 1) { if (y[i-2] != 0.0) { y[i-2] = 0.0;nz += 1; } } - continue; - } - /* Check for exhausted loop */ - if (i == n+1) { i = n; } - - rz = 2.0 / zr; - ck = fn * rz; - ib = i + 1; - if (n >= ib) { - fn = fnu + (n - 1); - ipard = 1; - if (mr != 0) { ipard = 0; } - unhj(zn, fn, ipard, tol, &phid, &argd, &zeta1d, &zeta2d, &asumd, &bsumd); - if (kode != 1) { - cfn = fn; - s1 = zeta1d - cfn * (cfn / (zb + zeta2d)); - } else { - s1 = zeta1d - zeta2d; + /* Check for exhausted loop */ + if (k == n + 1) { + k = n; } - rs1 = std::real(s1); - if (fabs(rs1) <= elim) { - if (fabs(rs1) < alim) { goto L120; } - // - // REFINE ESTIMATE AND TEST - // - aphi = std::abs(phid); - aarg = std::abs(argd); - rs1 += log(aphi) - 0.25 * log(aarg) - aic; - if (fabs(rs1) < elim) { goto L120; } + + il = n - k; + if (il == 0) { + return nz; } - if (rs1 > 0.0) { return -1; } - // - // FOR X < 0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW // - if (x < 0.0) { return -1; } - nz = n; - for (i = 0; i < n; i++) { y[i] = 0.0; } - return nz; -L120: - // - // SCALED FORWARD RECURRENCE FOR REMAINDER OF THE SEQUENCE + // RECUR BACKWARD FOR REMAINDER OF I SEQUENCE AND ADD IN THE + // K FUNCTIONS, SCALING THE I SEQUENCE DURING RECURRENCE TO KEEP + // INTERMEDIATE ARITHMETIC ON SCALE NEAR EXPONENT EXTREMES. // s1 = cy[0]; s2 = cy[1]; - c1 = csr[kflag-1]; - ascle = bry[kflag-1]; - for (i = ib; i < (n+1); i++) - { + cs = csr[iflag - 1]; + ascle = bry[iflag - 1]; + fn = inu + il; + for (i = 1; i < (il + 1); i++) { c2 = s2; - s2 = ck * s2 + s1; + s2 = s1 + (fn + fnf) * rz * c2; s1 = c2; - ck += rz; - c2 = s2 * c1; - y[i-1] = c2; - if (kflag < 3) { - c2m = fmax(fabs(std::real(c2)), fabs(std::imag(c2))); + fn -= 1.0; + c2 = s2 * cs; + ck = c2; + c1 = y[kk - 1]; + if (kode != 1) { + nw = s1s2(zr, &c1, &c2, asc, alim, &iuf); + nz = nz + nw; + } + y[kk - 1] = c1 * cspn + c2; + kk -= 1; + cspn = -cspn; + if (iflag < 3) { + c2m = fmax(fabs(std::real(ck)), fabs(std::imag(ck))); if (c2m > ascle) { - kflag += 1; - ascle = bry[kflag-1]; - s1 *= c1; - s2 = c2; - s1 *= css[kflag-1]; - s2 *= css[kflag-1]; - c1 = csr[kflag-1]; + iflag += 1; + ascle = bry[iflag - 1]; + s1 *= cs; + s2 = ck; + s1 *= css[iflag - 1]; + s2 *= css[iflag - 1]; + cs = csr[iflag - 1]; } } } + return nz; } - if (mr == 0) { return nz; } - // - // ANALYTIC CONTINUATION FOR RE(Z) < 0.0 - // - nz = 0; - fmr = mr; - sgn = ( fmr < 0.0 ? pi : -pi); - // - // CSPN AND CSGN ARE COEFF OF K AND I FUNCTIONS RESP. - // - csgn = std::complex(0.0, sgn); - if (yy <= 0.0) { csgn = -csgn; } - ifn = inu + n - 1; - ang = fnf*sgn; - cspn = std::complex(cos(ang), sin(ang)); - if (ifn % 2 == 1) { cspn = -cspn; } - // - // CS=COEFF OF THE J FUNCTION TO GET THE I FUNCTION. I(FNU,Z) IS - // COMPUTED FROM EXP(I*FNU*HPI)*J(FNU,-I*Z) WHERE Z IS IN THE FIRST - // QUADRANT. FOURTH QUADRANT VALUES (YY <= 0.0_dp) ARE COMPUTED BY - // CONJUGATION SINCE THE I FUNCTION IS REAL ON THE POSITIVE REAL AXIS - // - cs = std::complex(car, -sar) * csgn; - in = (ifn % 4) + 1; - c2 = cip[in-1]; - cs *= conj(c2); - asc = bry[0]; - iuf = 0; - kk = n; - kdflg = 1; - ib -= 1; - ic = ib - 1; - for (k = 1; k < (n+1); k++) { - fn = fnu + (kk-1); - if (n > 2) { goto L175; } -L172: - phid = phi[j-1]; - argd = arg[j-1]; - zeta1d = zeta1[j-1]; - zeta2d = zeta2[j-1]; - asumd = asum[j-1]; - bsumd = bsum[j-1]; - j = 3 - j; - goto L210; -L175: - if (!((kk == n) && (ib < n))) { - if ((kk == ib) || (kk == ic)) { goto L172; } - unhj(zn, fn, 0, tol, &phid, &argd, &zeta1d, &zeta2d, &asumd, &bsumd); - } -L210: - if (kode != 1) { - cfn = fn; - s1 = -zeta1d + cfn * (cfn/(zb + zeta2d)); - } else { - s1 = -zeta1d + zeta2d; - } + + inline int uoik( + std::complex z, double fnu, int kode, int ikflg, int n, std::complex *y, double tol, + double elim, double alim + ) { + + //***BEGIN PROLOGUE ZUOIK + //***REFER TO ZBESI,ZBESK,ZBESH // - // TEST FOR UNDERFLOW AND OVERFLOW + // ZUOIK COMPUTES THE LEADING TERMS OF THE UNIFORM ASYMPTOTIC + // EXPANSIONS FOR THE I AND K FUNCTIONS AND COMPARES THEM + // (IN LOGARITHMIC FORM) TO ALIM AND ELIM FOR OVER AND UNDERFLOW + // WHERE ALIM.LT.ELIM. IF THE MAGNITUDE, BASED ON THE LEADING + // EXPONENTIAL, IS LESS THAN ALIM OR GREATER THAN -ALIM, THEN + // THE RESULT IS ON SCALE. IF NOT, THEN A REFINED TEST USING OTHER + // MULTIPLIERS (IN LOGARITHMIC FORM) IS MADE BASED ON ELIM. HERE + // EXP(-ELIM)=SMALLEST MACHINE NUMBER*1.0E+3 AND EXP(-ALIM)= + // EXP(-ELIM)/TOL // - rs1 = std::real(s1); - if (fabs(rs1) > elim) { - if (rs1 > 0.0) { return -1; } - s2 = 0.0; - goto L250; + // IKFLG=1 MEANS THE I SEQUENCE IS TESTED + // =2 MEANS THE K SEQUENCE IS TESTED + // NUF = 0 MEANS THE LAST MEMBER OF THE SEQUENCE IS ON SCALE + // =-1 MEANS AN OVERFLOW WOULD OCCUR + // IKFLG=1 AND NUF.GT.0 MEANS THE LAST NUF Y VALUES WERE SET TO ZERO + // THE FIRST N-NUF VALUES MUST BE SET BY ANOTHER ROUTINE + // IKFLG=2 AND NUF.EQ.N MEANS ALL Y VALUES WERE SET TO ZERO + // IKFLG=2 AND 0.LT.NUF.LT.N NOT CONSIDERED. Y MUST BE SET BY + // ANOTHER ROUTINE + // + //***ROUTINES CALLED ZUCHK,ZUNHJ,ZUNIK,D1MACH,AZABS,AZLOG + //***END PROLOGUE ZUOIK + + std::complex arg, asum, bsum, cz, phi, sum, zb, zeta1; + std::complex zeta2, zn, zr; + double aarg, aphi, ascle, ax, ay, fnn, gnn, gnu, rcz, x, yy; + int iform, init, nn; + double aic = 1.265512123484645396; + std::complex cwrk[16] = {0.}; + + int nuf = 0; + nn = n; + x = std::real(z); + zr = z; + if (x < 0.) { + zr = -z; } - if (kdflg == 1) { iflag = 2; } - if (fabs(rs1) >= alim) { - // - // REFINE TEST AND SCALE - // - aphi = std::abs(phid); - aarg = std::abs(argd); - rs1 += log(aphi) - 0.25f * log(aarg) - aic; - if (fabs(rs1) > elim) { - if (rs1 > 0.0) { return -1; } - s2 = 0.0; - goto L250; - } - if (kdflg == 1) { iflag = 1; } - if (rs1 >= 0.0) { if (kdflg == 1) {iflag = 3;} } + zb = zr; + yy = std::imag(zr); + ax = fabs(x) * sqrt(3.); + ay = fabs(yy); + iform = 1; + if (ay > ax) { + iform = 2; + } + gnu = fmax(fnu, 1.); + if (ikflg != 1) { + fnn = nn; + gnn = fnu + fnn - 1; + gnu = fmax(gnn, fnn); } - ai = airy(argd, 0, 2, &nai, &idum); - dai = airy(argd, 1, 2, &ndai, &idum); - s2 = cs * phid * (ai*asumd + dai*bsumd); - c2r = std::real(s1); - c2i = std::imag(s1); - c2m = exp(c2r) * std::real(css[iflag-1]); - s1 = c2m * std::complex(cos(c2i), sin(c2i)); - s2 *= s1; - if (iflag == 1) { if (uchk(s2, bry[0], tol)) { s2 = 0.0; } } -L250: - if (yy <= 0.0) { s2 = conj(s2); } - cy[kdflg-1] = s2; - c2 = s2; - s2 *= csr[iflag-1]; - // - // ADD I AND K FUNCTIONS, K SEQUENCE IN Y(I), I=1,N - // - s1 = y[kk-1]; - if (kode != 1) { - nw = s1s2(zr, &s1, &s2, asc, alim, &iuf); - nz += nw; + if (iform != 2) { + init = 0; + unik(zr, gnu, ikflg, 1, tol, &init, &phi, &zeta1, &zeta2, &sum, &cwrk[0]); + cz = -zeta1 + zeta2; + } else { + zn = -zr * std::complex(0, 1); + if (yy <= 0.) { + zn = conj(zn); + } + unhj(zn, gnu, 1, tol, &phi, &arg, &zeta1, &zeta2, &asum, &bsum); + cz = zeta2 - zeta1; + aarg = std::abs(arg); } - y[kk-1] = s1 * cspn + s2; - kk -= 1; - cspn = -cspn; - cs *= -std::complex(0, 1); - if (c2 == 0.0) { - kdflg = 1; - continue; + if (kode == 2) { + cz -= zb; } - if (kdflg == 2) { break; } - kdflg = 2; - continue; - } - /* Check for exhausted loop */ - if (k == n+1) { k = n; } + if (ikflg == 2) { + cz = -cz; + } + aphi = std::abs(phi); + rcz = std::real(cz); - il = n - k; - if (il == 0) { return nz; } - // - // RECUR BACKWARD FOR REMAINDER OF I SEQUENCE AND ADD IN THE - // K FUNCTIONS, SCALING THE I SEQUENCE DURING RECURRENCE TO KEEP - // INTERMEDIATE ARITHMETIC ON SCALE NEAR EXPONENT EXTREMES. - // - s1 = cy[0]; - s2 = cy[1]; - cs = csr[iflag-1]; - ascle = bry[iflag-1]; - fn = inu + il; - for (i = 1; i < (il+1); i++) { - c2 = s2; - s2 = s1 + (fn + fnf) * rz * c2; - s1 = c2; - fn -= 1.0; - c2 = s2 * cs; - ck = c2; - c1 = y[kk-1]; - if (kode != 1) { - nw = s1s2(zr, &c1, &c2, asc, alim, &iuf); - nz = nz + nw; - } - y[kk-1] = c1 * cspn + c2; - kk -= 1; - cspn = -cspn; - if (iflag < 3) { - c2m = fmax(fabs(std::real(ck)), fabs(std::imag(ck))); - if (c2m > ascle) { - iflag += 1; - ascle = bry[iflag-1]; - s1 *= cs; - s2 = ck; - s1 *= css[iflag-1]; - s2 *= css[iflag-1]; - cs = csr[iflag-1]; + /* OVERFLOW TEST */ + if (rcz > elim) { + return -1; + } + if (rcz >= alim) { + rcz += log(aphi); + if (iform == 2) { + rcz -= 0.25 * log(aarg) + aic; + } + if (rcz > elim) { + return -1; + } + } else { + /* UNDERFLOW TEST */ + if (rcz >= -elim) { + if (rcz > -alim) { + /* pass */ + } else { + rcz += log(aphi); + if (iform == 2) { + rcz -= 0.25 * log(aarg) + aic; + } + if (rcz > -elim) { + /* goto 30 */ + ascle = 1e3 * d1mach[0] / tol; + cz += std::log(phi); + if (iform != 1) { + cz -= 0.25 * log(arg) + aic; + } + ax = exp(rcz) / tol; + ay = std::imag(cz); + cz = ax * std::exp(ay); + if (uchk(cz, ascle, tol)) { + for (int i = 0; i < nn; i++) { + y[i] = 0.; + } + return nn; + } + } else { + for (int i = 0; i < nn; i++) { + y[i] = 0.; + } + return nn; + } + } + } else { + for (int i = 0; i < nn; i++) { + y[i] = 0.; + } + return nn; } } - } - return nz; -} - - -inline int uoik( - std::complex z, - double fnu, - int kode, - int ikflg, - int n, - std::complex *y, - double tol, - double elim, - double alim -) { - - //***BEGIN PROLOGUE ZUOIK - //***REFER TO ZBESI,ZBESK,ZBESH - // - // ZUOIK COMPUTES THE LEADING TERMS OF THE UNIFORM ASYMPTOTIC - // EXPANSIONS FOR THE I AND K FUNCTIONS AND COMPARES THEM - // (IN LOGARITHMIC FORM) TO ALIM AND ELIM FOR OVER AND UNDERFLOW - // WHERE ALIM.LT.ELIM. IF THE MAGNITUDE, BASED ON THE LEADING - // EXPONENTIAL, IS LESS THAN ALIM OR GREATER THAN -ALIM, THEN - // THE RESULT IS ON SCALE. IF NOT, THEN A REFINED TEST USING OTHER - // MULTIPLIERS (IN LOGARITHMIC FORM) IS MADE BASED ON ELIM. HERE - // EXP(-ELIM)=SMALLEST MACHINE NUMBER*1.0E+3 AND EXP(-ALIM)= - // EXP(-ELIM)/TOL - // - // IKFLG=1 MEANS THE I SEQUENCE IS TESTED - // =2 MEANS THE K SEQUENCE IS TESTED - // NUF = 0 MEANS THE LAST MEMBER OF THE SEQUENCE IS ON SCALE - // =-1 MEANS AN OVERFLOW WOULD OCCUR - // IKFLG=1 AND NUF.GT.0 MEANS THE LAST NUF Y VALUES WERE SET TO ZERO - // THE FIRST N-NUF VALUES MUST BE SET BY ANOTHER ROUTINE - // IKFLG=2 AND NUF.EQ.N MEANS ALL Y VALUES WERE SET TO ZERO - // IKFLG=2 AND 0.LT.NUF.LT.N NOT CONSIDERED. Y MUST BE SET BY - // ANOTHER ROUTINE - // - //***ROUTINES CALLED ZUCHK,ZUNHJ,ZUNIK,D1MACH,AZABS,AZLOG - //***END PROLOGUE ZUOIK - - std::complex arg, asum, bsum, cz, phi, sum, zb, zeta1; - std::complex zeta2, zn, zr; - double aarg, aphi, ascle, ax, ay, fnn, gnn, gnu, rcz, x, yy; - int iform, init, nn; - double aic = 1.265512123484645396; - std::complex cwrk[16] = { 0. }; - - int nuf = 0; - nn = n; - x = std::real(z); - zr = z; - if (x < 0.) { zr = -z; } - zb = zr; - yy = std::imag(zr); - ax = fabs(x) * sqrt(3.); - ay = fabs(yy); - iform = 1; - if (ay > ax) { iform = 2; } - gnu = fmax(fnu, 1.); - if (ikflg != 1) { - fnn = nn; - gnn = fnu + fnn -1; - gnu = fmax(gnn, fnn); - } - - if (iform != 2) { - init = 0; - unik(zr, gnu, ikflg, 1, tol, &init, &phi, &zeta1, &zeta2, &sum, &cwrk[0]); - cz = -zeta1 + zeta2; - } else { - zn = -zr * std::complex(0, 1); - if (yy <= 0.) { - zn = conj(zn); + if ((ikflg == 2) || (n == 1)) { + return nuf; } - unhj(zn, gnu, 1, tol, &phi, &arg, &zeta1, &zeta2, &asum, &bsum); - cz = zeta2 - zeta1; - aarg = std::abs(arg); - } - if (kode == 2) { cz -= zb; } - if (ikflg == 2) { cz = -cz; } - aphi = std::abs(phi); - rcz = std::real(cz); - - /* OVERFLOW TEST */ - if (rcz > elim) { return -1; } - if (rcz >= alim) { - rcz += log(aphi); - if (iform == 2) { rcz -= 0.25*log(aarg) + aic; } - if (rcz > elim) { return -1; } - } else { - /* UNDERFLOW TEST */ - if (rcz >= -elim) { - if (rcz > -alim) { - /* pass */ + /* 140 */ + while (1) { + gnu = fnu + (nn - 1); + if (iform != 2) { + init = 0; + unik(zr, gnu, ikflg, 1, tol, &init, &phi, &zeta1, &zeta2, &sum, &cwrk[0]); + cz = zeta2 - zeta1; } else { + unhj(zn, gnu, 1, tol, &phi, &arg, &zeta1, &zeta2, &asum, &bsum); + cz = zeta2 - zeta1; + aarg = std::abs(phi); + } + if (kode == 2) { + cz -= zb; + } + + /* 170 */ + aphi = std::abs(phi); + rcz = std::real(cz); + + if (rcz >= -elim) { + if (rcz > -alim) { + return nuf; + } rcz += log(aphi); - if (iform == 2) { rcz -= 0.25*log(aarg) + aic; } + if (iform == 2) { + rcz -= 0.25 * log(aarg) + aic; + } if (rcz > -elim) { - /* goto 30 */ - ascle = 1e3*d1mach[0] / tol; - cz += std::log(phi); - if (iform != 1) { cz -= 0.25*log(arg) + aic;} + ascle = 1e3 * d1mach[0] / tol; + cz = std::log(phi); + if (iform != 1) { + cz -= 0.25 * std::log(arg) + aic; + } ax = exp(rcz) / tol; ay = std::imag(cz); - cz = ax*std::exp(ay); - if (uchk(cz, ascle, tol)) { - for (int i = 0; i < nn; i++){ y[i] = 0.; } - return nn; + cz = ax * (cos(ay) + sin(ay * std::complex(0, 1))); + if (!(uchk(cz, ascle, tol))) { + return nuf; } - } else { - for (int i = 0; i < nn; i++){ y[i] = 0.; } - return nn; } } - } else { - for (int i = 0; i < nn; i++){ y[i] = 0.; } - return nn; - } - } - if ((ikflg == 2) || (n == 1)) { return nuf; } - /* 140 */ - while (1) { - gnu = fnu + (nn -1); - if (iform != 2) { - init = 0; - unik(zr, gnu, ikflg, 1, tol, &init, &phi, &zeta1, &zeta2, &sum, &cwrk[0]); - cz = zeta2 - zeta1; - } else { - unhj(zn, gnu, 1, tol, &phi, &arg, &zeta1, &zeta2, &asum, &bsum); - cz = zeta2 - zeta1; - aarg = std::abs(phi); - } - if (kode == 2) { cz -= zb; } - - /* 170 */ - aphi = std::abs(phi); - rcz = std::real(cz); - if (rcz >= -elim) { - if (rcz > -alim) { return nuf; } - rcz += log(aphi); - if (iform == 2) { rcz -= 0.25*log(aarg) + aic; } - if (rcz > -elim) { - ascle = 1e3 * d1mach[0] / tol; - cz = std::log(phi); - if (iform != 1) { cz -= 0.25*std::log(arg) + aic; } - ax = exp(rcz)/tol; - ay = std::imag(cz); - cz = ax*(cos(ay)+sin(ay*std::complex(0, 1))); - if (!(uchk(cz, ascle, tol))) { return nuf; } + y[nn - 1] = 0.; + nn -= 1; + nuf += 1; + if (nn == 0) { + return nuf; } } - - y[nn-1] = 0.; - nn -= 1; - nuf += 1; - if (nn == 0) { return nuf; } + return -1; } - return -1; -} - - -inline int wrsk( - std::complex zr, - double fnu, - int kode, - int n, - std::complex *y, - std::complex *cw, - double tol, - double elim, - double alim -) { - - //***BEGIN PROLOGUE ZWRSK - //***REFER TO ZBESI,ZBESK - // - // ZWRSK COMPUTES THE I BESSEL FUNCTION FOR RE(Z).GE.0.0 BY - // NORMALIZING THE I FUNCTION RATIOS FROM ZRATI BY THE WRONSKIAN - // - //***ROUTINES CALLED D1MACH,ZBKNU,ZRATI,AZABS - //***END PROLOGUE ZWRSK - std::complex cinu, cscl, ct, c1, c2, rct, st; - double act, acw, ascle, yy; - int i, nw, nz; + inline int wrsk( + std::complex zr, double fnu, int kode, int n, std::complex *y, std::complex *cw, + double tol, double elim, double alim + ) { - // - // I(FNU+I-1,Z) BY BACKWARD RECURRENCE FOR RATIOS - // Y(I)=I(FNU+I,Z)/I(FNU+I-1,Z) FROM CRATI NORMALIZED BY THE - // WRONSKIAN WITH K(FNU,Z) AND K(FNU+1,Z) FROM CBKNU. - // - nz = 0; - nw = bknu(zr, fnu, kode, 2, cw, tol, elim, alim); - if (nw != 0) { - /* 50 */ - nz = -1; - if (nw == -2) { - nz = -2; + //***BEGIN PROLOGUE ZWRSK + //***REFER TO ZBESI,ZBESK + // + // ZWRSK COMPUTES THE I BESSEL FUNCTION FOR RE(Z).GE.0.0 BY + // NORMALIZING THE I FUNCTION RATIOS FROM ZRATI BY THE WRONSKIAN + // + //***ROUTINES CALLED D1MACH,ZBKNU,ZRATI,AZABS + //***END PROLOGUE ZWRSK + + std::complex cinu, cscl, ct, c1, c2, rct, st; + double act, acw, ascle, yy; + int i, nw, nz; + + // + // I(FNU+I-1,Z) BY BACKWARD RECURRENCE FOR RATIOS + // Y(I)=I(FNU+I,Z)/I(FNU+I-1,Z) FROM CRATI NORMALIZED BY THE + // WRONSKIAN WITH K(FNU,Z) AND K(FNU+1,Z) FROM CBKNU. + // + nz = 0; + nw = bknu(zr, fnu, kode, 2, cw, tol, elim, alim); + if (nw != 0) { + /* 50 */ + nz = -1; + if (nw == -2) { + nz = -2; + } + return nz; } - return nz; - } - rati(zr, fnu, n, y, tol); - // - // RECUR FORWARD ON I(FNU+1,Z) = R(FNU,Z)*I(FNU,Z), - // R(FNU+J-1,Z)=Y(J), J=1,...,N - // - cinu = 1.0; - if (kode != 1) { - yy = std::imag(zr); - cinu = std::complex(cos(yy), sin(yy)); - } - // - // ON LOW EXPONENT MACHINES THE K FUNCTIONS CAN BE CLOSE TO BOTH THE - // UNDER AND OVERFLOW LIMITS AND THE NORMALIZATION MUST BE SCALED TO - // PREVENT OVER OR UNDERFLOW. CUOIK HAS DETERMINED THAT THE RESULT - // IS ON SCALE. - // - acw = std::abs(cw[1]); - ascle = 1e3*d1mach[0]/tol; - cscl = 1.0; + rati(zr, fnu, n, y, tol); + // + // RECUR FORWARD ON I(FNU+1,Z) = R(FNU,Z)*I(FNU,Z), + // R(FNU+J-1,Z)=Y(J), J=1,...,N + // + cinu = 1.0; + if (kode != 1) { + yy = std::imag(zr); + cinu = std::complex(cos(yy), sin(yy)); + } + // + // ON LOW EXPONENT MACHINES THE K FUNCTIONS CAN BE CLOSE TO BOTH THE + // UNDER AND OVERFLOW LIMITS AND THE NORMALIZATION MUST BE SCALED TO + // PREVENT OVER OR UNDERFLOW. CUOIK HAS DETERMINED THAT THE RESULT + // IS ON SCALE. + // + acw = std::abs(cw[1]); + ascle = 1e3 * d1mach[0] / tol; + cscl = 1.0; - if (acw <= ascle) { - cscl = 1.0 / tol; - } else { - ascle = 1.0 / ascle; - if (acw >= ascle) { - cscl = tol; + if (acw <= ascle) { + cscl = 1.0 / tol; + } else { + ascle = 1.0 / ascle; + if (acw >= ascle) { + cscl = tol; + } } - } - c1 = cw[0]*cscl; - c2 = cw[1]*cscl; - st = y[0]; - // - // CINU=CINU*(CONJG(CT)/ABS(CT))*(1.0_dp/ABS(CT) PREVENTS - // UNDER- OR OVERFLOW PREMATURELY BY SQUARING ABS(CT) - // - ct = zr * (c2 + st*c1); - act = std::abs(ct); - rct = 1.0 / act; - ct = conj(ct)*rct; - cinu *= ct*rct; - y[0] = cinu*cscl; - if (n == 1) { return nz; } - for (i = 2; i < (n+1); i++) { - cinu *= st; - st = y[i-1]; - y[i-1] = cinu*cscl; + c1 = cw[0] * cscl; + c2 = cw[1] * cscl; + st = y[0]; + // + // CINU=CINU*(CONJG(CT)/ABS(CT))*(1.0_dp/ABS(CT) PREVENTS + // UNDER- OR OVERFLOW PREMATURELY BY SQUARING ABS(CT) + // + ct = zr * (c2 + st * c1); + act = std::abs(ct); + rct = 1.0 / act; + ct = conj(ct) * rct; + cinu *= ct * rct; + y[0] = cinu * cscl; + if (n == 1) { + return nz; + } + for (i = 2; i < (n + 1); i++) { + cinu *= st; + st = y[i - 1]; + y[i - 1] = cinu * cscl; + } + return nz; } - return nz; -} -} -} +} // namespace amos +} // namespace xsf diff --git a/include/xsf/binom.h b/include/xsf/binom.h index 64f6e61..d84539d 100644 --- a/include/xsf/binom.h +++ b/include/xsf/binom.h @@ -82,8 +82,6 @@ XSF_HOST_DEVICE inline double binom(double n, double k) { return 1 / (n + 1) / cephes::beta(1 + n - k, 1 + k); } -XSF_HOST_DEVICE inline float binom(float n, float k) { - return binom(static_cast(n), static_cast(k)); -} +XSF_HOST_DEVICE inline float binom(float n, float k) { return binom(static_cast(n), static_cast(k)); } } // namespace xsf diff --git a/include/xsf/cdflib.h b/include/xsf/cdflib.h index 1ce5550..ecebdb2 100644 --- a/include/xsf/cdflib.h +++ b/include/xsf/cdflib.h @@ -43,10 +43,10 @@ XSF_HOST_DEVICE inline double gdtrib(double a, double p, double x) { } double q = 1.0 - p; auto func = [a, p, q, x](double b) { - if (p <= q) { - return cephes::igam(b, a * x) - p; - } - return q - cephes::igamc(b, a * x); + if (p <= q) { + return cephes::igam(b, a * x) - p; + } + return q - cephes::igamc(b, a * x); }; double lower_bound = std::numeric_limits::min(); double upper_bound = std::numeric_limits::max(); @@ -71,9 +71,8 @@ XSF_HOST_DEVICE inline double gdtrib(double a, double p, double x) { * number of iterations needed in this bracket search to check all normalized * floating point values. */ - auto [xl, xr, f_xl, f_xr, bracket_status] = detail::bracket_root_for_cdf_inversion( - func, 1.0, lower_bound, upper_bound, -0.875, 7.0, 0.125, 8, false, 342 - ); + auto [xl, xr, f_xl, f_xr, bracket_status] = + detail::bracket_root_for_cdf_inversion(func, 1.0, lower_bound, upper_bound, -0.875, 7.0, 0.125, 8, false, 342); if (bracket_status == 1) { set_error("gdtrib", SF_ERROR_UNDERFLOW, NULL); return 0.0; @@ -86,9 +85,8 @@ XSF_HOST_DEVICE inline double gdtrib(double a, double p, double x) { set_error("gdtrib", SF_ERROR_OTHER, "Computational Error"); return std::numeric_limits::quiet_NaN(); } - auto [result, root_status] = detail::find_root_chandrupatla( - func, xl, xr, f_xl, f_xr, std::numeric_limits::epsilon(), 1e-100, 100 - ); + auto [result, root_status] = + detail::find_root_chandrupatla(func, xl, xr, f_xl, f_xr, std::numeric_limits::epsilon(), 1e-100, 100); if (root_status) { /* The root finding return should only fail if there's a bug in our code. */ set_error("gdtrib", SF_ERROR_OTHER, "Computational Error, (%.17g, %.17g, %.17g)", a, p, x); diff --git a/include/xsf/cephes/beta.h b/include/xsf/cephes/beta.h index 4372627..42447c6 100644 --- a/include/xsf/cephes/beta.h +++ b/include/xsf/cephes/beta.h @@ -161,9 +161,9 @@ namespace cephes { b = Gamma(b); if (std::isinf(y)) { goto overflow; - } + } - if (std::abs(std::abs(a*y) - 1.0) > std::abs(std::abs(b*y) - 1.0)) { + if (std::abs(std::abs(a * y) - 1.0) > std::abs(std::abs(b * y) - 1.0)) { y = b * y; y *= a; } else { @@ -239,7 +239,7 @@ namespace cephes { return (sign * std::numeric_limits::infinity()); } - if (std::abs(std::abs(a*y) - 1.0) > std::abs(std::abs(b*y) - 1.0)) { + if (std::abs(std::abs(a * y) - 1.0) > std::abs(std::abs(b * y) - 1.0)) { y = b * y; y *= a; } else { diff --git a/include/xsf/cephes/cbrt.h b/include/xsf/cephes/cbrt.h index ee7c628..cf9cae5 100644 --- a/include/xsf/cephes/cbrt.h +++ b/include/xsf/cephes/cbrt.h @@ -57,75 +57,74 @@ namespace cephes { inline constexpr double CBRT2I = 0.79370052598409973737585; inline constexpr double CBRT4I = 0.62996052494743658238361; - } + } // namespace detail XSF_HOST_DEVICE inline double cbrt(double x) { - int e, rem, sign; - double z; - - if (!std::isfinite(x)) { - return x; - } - if (x == 0) { - return (x); - } - if (x > 0) { - sign = 1; - } else { - sign = -1; - x = -x; - } - - z = x; - /* extract power of 2, leaving - * mantissa between 0.5 and 1 - */ - x = std::frexp(x, &e); - - /* Approximate cube root of number between .5 and 1, - * peak relative error = 9.2e-6 - */ - x = (((-1.3466110473359520655053e-1 * x + 5.4664601366395524503440e-1) * x - 9.5438224771509446525043e-1) * - x + - 1.1399983354717293273738e0) * - x + - 4.0238979564544752126924e-1; - - /* exponent divided by 3 */ - if (e >= 0) { - rem = e; - e /= 3; - rem -= 3 * e; - if (rem == 1) { - x *= detail::CBRT2; - } else if (rem == 2) { - x *= detail::CBRT4; - } - } - /* argument less than 1 */ - else { - e = -e; - rem = e; - e /= 3; - rem -= 3 * e; - if (rem == 1) { - x *= detail::CBRT2I; - } else if (rem == 2) { - x *= detail::CBRT4I; - } - e = -e; - } - - /* multiply by power of 2 */ - x = std::ldexp(x, e); - - /* Newton iteration */ - x -= (x - (z / (x * x))) * 0.33333333333333333333; - x -= (x - (z / (x * x))) * 0.33333333333333333333; - - if (sign < 0) - x = -x; - return (x); + int e, rem, sign; + double z; + + if (!std::isfinite(x)) { + return x; + } + if (x == 0) { + return (x); + } + if (x > 0) { + sign = 1; + } else { + sign = -1; + x = -x; + } + + z = x; + /* extract power of 2, leaving + * mantissa between 0.5 and 1 + */ + x = std::frexp(x, &e); + + /* Approximate cube root of number between .5 and 1, + * peak relative error = 9.2e-6 + */ + x = (((-1.3466110473359520655053e-1 * x + 5.4664601366395524503440e-1) * x - 9.5438224771509446525043e-1) * x + + 1.1399983354717293273738e0) * + x + + 4.0238979564544752126924e-1; + + /* exponent divided by 3 */ + if (e >= 0) { + rem = e; + e /= 3; + rem -= 3 * e; + if (rem == 1) { + x *= detail::CBRT2; + } else if (rem == 2) { + x *= detail::CBRT4; + } + } + /* argument less than 1 */ + else { + e = -e; + rem = e; + e /= 3; + rem -= 3 * e; + if (rem == 1) { + x *= detail::CBRT2I; + } else if (rem == 2) { + x *= detail::CBRT4I; + } + e = -e; + } + + /* multiply by power of 2 */ + x = std::ldexp(x, e); + + /* Newton iteration */ + x -= (x - (z / (x * x))) * 0.33333333333333333333; + x -= (x - (z / (x * x))) * 0.33333333333333333333; + + if (sign < 0) + x = -x; + return (x); } } // namespace cephes diff --git a/include/xsf/cephes/chdtr.h b/include/xsf/cephes/chdtr.h index 68f2fbe..30ee84d 100644 --- a/include/xsf/cephes/chdtr.h +++ b/include/xsf/cephes/chdtr.h @@ -165,7 +165,7 @@ namespace cephes { if (x < 0.0) { set_error("chdtr", SF_ERROR_DOMAIN, NULL); return (std::numeric_limits::quiet_NaN()); - } + } return (igamc(df / 2.0, x / 2.0)); } diff --git a/include/xsf/cephes/dd_real.h b/include/xsf/cephes/dd_real.h index 5217a34..f6bf17c 100644 --- a/include/xsf/cephes/dd_real.h +++ b/include/xsf/cephes/dd_real.h @@ -121,9 +121,7 @@ namespace cephes { // Arithmetic operations - XSF_HOST_DEVICE inline double_double operator-(const double_double &x) { - return double_double(-x.hi, -x.lo); - } + XSF_HOST_DEVICE inline double_double operator-(const double_double &x) { return double_double(-x.hi, -x.lo); } XSF_HOST_DEVICE inline double_double operator+(const double_double &lhs, const double_double &rhs) { /* This one satisfies IEEE style error bound, @@ -382,15 +380,15 @@ namespace cephes { return lhs - rhs * n; } - XSF_HOST_DEVICE inline std::pair divrem(const double_double &lhs, - const double_double &rhs) { + XSF_HOST_DEVICE inline std::pair + divrem(const double_double &lhs, const double_double &rhs) { double_double n = round(lhs / rhs); double_double remainder = lhs - n * rhs; return {n, remainder}; } - XSF_HOST_DEVICE inline double_double fma( - const double_double &a, const double_double &b, const double_double &c) { + XSF_HOST_DEVICE inline double_double + fma(const double_double &a, const double_double &b, const double_double &c) { // TODO: make an accurate fma return a * b + c; } @@ -442,21 +440,23 @@ namespace cephes { return double_double(std::numeric_limits::infinity(), std::numeric_limits::infinity()); } - const double_double inv_fact[] = {double_double(1.66666666666666657e-01, 9.25185853854297066e-18), - double_double(4.16666666666666644e-02, 2.31296463463574266e-18), - double_double(8.33333333333333322e-03, 1.15648231731787138e-19), - double_double(1.38888888888888894e-03, -5.30054395437357706e-20), - double_double(1.98412698412698413e-04, 1.72095582934207053e-22), - double_double(2.48015873015873016e-05, 2.15119478667758816e-23), - double_double(2.75573192239858925e-06, -1.85839327404647208e-22), - double_double(2.75573192239858883e-07, 2.37677146222502973e-23), - double_double(2.50521083854417202e-08, -1.44881407093591197e-24), - double_double(2.08767569878681002e-09, -1.20734505911325997e-25), - double_double(1.60590438368216133e-10, 1.25852945887520981e-26), - double_double(1.14707455977297245e-11, 2.06555127528307454e-28), - double_double(7.64716373181981641e-13, 7.03872877733453001e-30), - double_double(4.77947733238738525e-14, 4.39920548583408126e-31), - double_double(2.81145725434552060e-15, 1.65088427308614326e-31)}; + const double_double inv_fact[] = { + double_double(1.66666666666666657e-01, 9.25185853854297066e-18), + double_double(4.16666666666666644e-02, 2.31296463463574266e-18), + double_double(8.33333333333333322e-03, 1.15648231731787138e-19), + double_double(1.38888888888888894e-03, -5.30054395437357706e-20), + double_double(1.98412698412698413e-04, 1.72095582934207053e-22), + double_double(2.48015873015873016e-05, 2.15119478667758816e-23), + double_double(2.75573192239858925e-06, -1.85839327404647208e-22), + double_double(2.75573192239858883e-07, 2.37677146222502973e-23), + double_double(2.50521083854417202e-08, -1.44881407093591197e-24), + double_double(2.08767569878681002e-09, -1.20734505911325997e-25), + double_double(1.60590438368216133e-10, 1.25852945887520981e-26), + double_double(1.14707455977297245e-11, 2.06555127528307454e-28), + double_double(7.64716373181981641e-13, 7.03872877733453001e-30), + double_double(4.77947733238738525e-14, 4.39920548583408126e-31), + double_double(2.81145725434552060e-15, 1.65088427308614326e-31) + }; // Math constants const double_double E = double_double(2.718281828459045091e+00, 1.445646891729250158e-16); diff --git a/include/xsf/cephes/ellik.h b/include/xsf/cephes/ellik.h index c05b3ec..1fe436e 100644 --- a/include/xsf/cephes/ellik.h +++ b/include/xsf/cephes/ellik.h @@ -177,7 +177,7 @@ namespace cephes { return (phi); a = 1.0 - m; if (a == 0.0) { - if (std::abs(phi) >= (double) M_PI_2) { + if (std::abs(phi) >= (double)M_PI_2) { set_error("ellik", SF_ERROR_SINGULAR, NULL); return (std::numeric_limits::infinity()); } diff --git a/include/xsf/cephes/expn.h b/include/xsf/cephes/expn.h index 8b0b07e..f7f47c5 100644 --- a/include/xsf/cephes/expn.h +++ b/include/xsf/cephes/expn.h @@ -65,8 +65,8 @@ #include "../config.h" #include "../error.h" #include "const.h" -#include "rgamma.h" #include "polevl.h" +#include "rgamma.h" namespace xsf { namespace cephes { @@ -78,10 +78,12 @@ namespace cephes { constexpr double expn_A1[] = {1.00000000000000000}; constexpr double expn_A2[] = {-2.00000000000000000, 1.00000000000000000}; constexpr double expn_A3[] = {6.00000000000000000, -8.00000000000000000, 1.00000000000000000}; - constexpr double expn_A4[] = {-24.0000000000000000, 58.0000000000000000, -22.0000000000000000, - 1.00000000000000000}; - constexpr double expn_A5[] = {120.000000000000000, -444.000000000000000, 328.000000000000000, - -52.0000000000000000, 1.00000000000000000}; + constexpr double expn_A4[] = { + -24.0000000000000000, 58.0000000000000000, -22.0000000000000000, 1.00000000000000000 + }; + constexpr double expn_A5[] = { + 120.000000000000000, -444.000000000000000, 328.000000000000000, -52.0000000000000000, 1.00000000000000000 + }; constexpr double expn_A6[] = {-720.000000000000000, 3708.00000000000000, -4400.00000000000000, 1452.00000000000000, -114.000000000000000, 1.00000000000000000}; constexpr double expn_A7[] = {5040.00000000000000, -33984.0000000000000, 58140.0000000000000, diff --git a/include/xsf/cephes/gamma.h b/include/xsf/cephes/gamma.h index 1ede157..84aa77c 100644 --- a/include/xsf/cephes/gamma.h +++ b/include/xsf/cephes/gamma.h @@ -149,20 +149,20 @@ namespace cephes { int sgngam = 1; if (!std::isfinite(x)) { - if (x > 0) { - // gamma(+inf) = +inf - return x; - } - // gamma(NaN) and gamma(-inf) both should equal NaN. + if (x > 0) { + // gamma(+inf) = +inf + return x; + } + // gamma(NaN) and gamma(-inf) both should equal NaN. return std::numeric_limits::quiet_NaN(); } - if (x == 0) { - /* For pole at zero, value depends on sign of zero. - * +inf when approaching from right, -inf when approaching - * from left. */ - return std::copysign(std::numeric_limits::infinity(), x); - } + if (x == 0) { + /* For pole at zero, value depends on sign of zero. + * +inf when approaching from right, -inf when approaching + * from left. */ + return std::copysign(std::numeric_limits::infinity(), x); + } q = std::abs(x); @@ -170,7 +170,7 @@ namespace cephes { if (x < 0.0) { p = std::floor(q); if (p == q) { - // x is a negative integer. This is a pole. + // x is a negative integer. This is a pole. set_error("Gamma", SF_ERROR_SINGULAR, NULL); return (std::numeric_limits::quiet_NaN()); } @@ -228,9 +228,9 @@ namespace cephes { small: if (x == 0.0) { - /* For this to have happened, x must have started as a negative integer. */ - set_error("Gamma", SF_ERROR_SINGULAR, NULL); - return (std::numeric_limits::quiet_NaN()); + /* For this to have happened, x must have started as a negative integer. */ + set_error("Gamma", SF_ERROR_SINGULAR, NULL); + return (std::numeric_limits::quiet_NaN()); } else return (z / ((1.0 + 0.5772156649015329 * x) * x)); } @@ -239,8 +239,10 @@ namespace cephes { /* A[]: Stirling's formula expansion of log Gamma * B[], C[]: log Gamma function between 2 and 3 */ - constexpr double gamma_A[] = {8.11614167470508450300E-4, -5.95061904284301438324E-4, 7.93650340457716943945E-4, - -2.77777777730099687205E-3, 8.33333333333331927722E-2}; + constexpr double gamma_A[] = { + 8.11614167470508450300E-4, -5.95061904284301438324E-4, 7.93650340457716943945E-4, + -2.77777777730099687205E-3, 8.33333333333331927722E-2 + }; constexpr double gamma_B[] = {-1.37825152569120859100E3, -3.88016315134637840924E4, -3.31612992738871184744E5, -1.16237097492762307383E6, -1.72173700820839662146E6, -8.53555664245765465627E5}; @@ -248,7 +250,8 @@ namespace cephes { constexpr double gamma_C[] = { /* 1.00000000000000000000E0, */ -3.51815701436523470549E2, -1.70642106651881159223E4, -2.20528590553854454839E5, - -1.13933444367982507207E6, -2.53252307177582951285E6, -2.01889141433532773231E6}; + -1.13933444367982507207E6, -2.53252307177582951285E6, -2.01889141433532773231E6 + }; /* log( sqrt( 2*pi ) ) */ constexpr double LS2PI = 0.91893853320467274178; @@ -375,23 +378,23 @@ namespace cephes { } if (x > 0) { return 1.0; - } - if (x == 0) { - return std::copysign(1.0, x); - } - if (std::isinf(x)) { - // x > 0 case handled, so x must be negative infinity. - return std::numeric_limits::quiet_NaN(); - } - fx = std::floor(x); - if (x - fx == 0.0) { - return std::numeric_limits::quiet_NaN(); - } - // sign of gamma for x in (-n, -n+1) for positive integer n is (-1)^n. - if (static_cast(fx) % 2) { - return -1.0; - } - return 1.0; + } + if (x == 0) { + return std::copysign(1.0, x); + } + if (std::isinf(x)) { + // x > 0 case handled, so x must be negative infinity. + return std::numeric_limits::quiet_NaN(); + } + fx = std::floor(x); + if (x - fx == 0.0) { + return std::numeric_limits::quiet_NaN(); + } + // sign of gamma for x in (-n, -n+1) for positive integer n is (-1)^n. + if (static_cast(fx) % 2) { + return -1.0; + } + return 1.0; } } // namespace cephes diff --git a/include/xsf/cephes/hyp2f1.h b/include/xsf/cephes/hyp2f1.h index f9ec54b..819512f 100644 --- a/include/xsf/cephes/hyp2f1.h +++ b/include/xsf/cephes/hyp2f1.h @@ -75,8 +75,8 @@ #include "const.h" #include "gamma.h" -#include "rgamma.h" #include "psi.h" +#include "rgamma.h" namespace xsf { namespace cephes { @@ -258,8 +258,8 @@ namespace cephes { p = (a + d1) * (b + d1) * s * xsf::cephes::rgamma(e + 2.0); /* Poch for t=1 */ t = 1.0; do { - r = xsf::cephes::psi(1.0 + t) + xsf::cephes::psi(1.0 + t + e) - - xsf::cephes::psi(a + t + d1) - xsf::cephes::psi(b + t + d1) - ax; + r = xsf::cephes::psi(1.0 + t) + xsf::cephes::psi(1.0 + t + e) - xsf::cephes::psi(a + t + d1) - + xsf::cephes::psi(b + t + d1) - ax; q = p * r; y += q; p *= s * (a + t + d1) / (t + 1.0); @@ -293,8 +293,7 @@ namespace cephes { } nosum: p = xsf::cephes::Gamma(c); - y1 *= xsf::cephes::Gamma(e) * p * - (xsf::cephes::rgamma(a + d1) * xsf::cephes::rgamma(b + d1)); + y1 *= xsf::cephes::Gamma(e) * p * (xsf::cephes::rgamma(a + d1) * xsf::cephes::rgamma(b + d1)); y *= p * (xsf::cephes::rgamma(a + d2) * xsf::cephes::rgamma(b + d2)); if ((aid & 1) != 0) diff --git a/include/xsf/cephes/i0.h b/include/xsf/cephes/i0.h index f61e7b1..96e08af 100644 --- a/include/xsf/cephes/i0.h +++ b/include/xsf/cephes/i0.h @@ -100,7 +100,8 @@ namespace cephes { -5.75419501008210370398E-5, 1.88502885095841655729E-4, -5.76375574538582365885E-4, 1.63947561694133579842E-3, -4.32430999505057594430E-3, 1.05464603945949983183E-2, -2.37374148058994688156E-2, 4.93052842396707084878E-2, -9.49010970480476444210E-2, - 1.71620901522208775349E-1, -3.04682672343198398683E-1, 6.76795274409476084995E-1}; + 1.71620901522208775349E-1, -3.04682672343198398683E-1, 6.76795274409476084995E-1 + }; /* Chebyshev coefficients for exp(-x) sqrt(x) I0(x) * in the inverted interval [8,infinity]. @@ -116,7 +117,8 @@ namespace cephes { -3.14991652796324136454E-11, 1.18891471078464383424E-11, 4.94060238822496958910E-10, 3.39623202570838634515E-9, 2.26666899049817806459E-8, 2.04891858946906374183E-7, 2.89137052083475648297E-6, 6.88975834691682398426E-5, 3.36911647825569408990E-3, - 8.04490411014108831608E-1}; + 8.04490411014108831608E-1 + }; } // namespace detail XSF_HOST_DEVICE inline double i0(double x) { diff --git a/include/xsf/cephes/i1.h b/include/xsf/cephes/i1.h index 49e2690..5b85409 100644 --- a/include/xsf/cephes/i1.h +++ b/include/xsf/cephes/i1.h @@ -102,7 +102,8 @@ namespace cephes { 4.78156510755005422638E-5, -1.61760815825896745588E-4, 5.12285956168575772895E-4, -1.51357245063125314899E-3, 4.15642294431288815669E-3, -1.05640848946261981558E-2, 2.47264490306265168283E-2, -5.29459812080949914269E-2, 1.02643658689847095384E-1, - -1.76416518357834055153E-1, 2.52587186443633654823E-1}; + -1.76416518357834055153E-1, 2.52587186443633654823E-1 + }; /* Chebyshev coefficients for exp(-x) sqrt(x) I1(x) * in the inverted interval [8,infinity]. @@ -118,7 +119,8 @@ namespace cephes { 3.25260358301548823856E-11, -1.89749581235054123450E-11, -5.58974346219658380687E-10, -3.83538038596423702205E-9, -2.63146884688951950684E-8, -2.51223623787020892529E-7, -3.88256480887769039346E-6, -1.10588938762623716291E-4, -9.76109749136146840777E-3, - 7.78576235018280120474E-1}; + 7.78576235018280120474E-1 + }; } // namespace detail diff --git a/include/xsf/cephes/igam.h b/include/xsf/cephes/igam.h index 356ebd1..ce7f31a 100644 --- a/include/xsf/cephes/igam.h +++ b/include/xsf/cephes/igam.h @@ -328,9 +328,9 @@ namespace cephes { XSF_HOST_DEVICE inline double igam(double a, double x) { double absxma_a; - if (std::isnan(a) || std::isnan(x)) { - return std::numeric_limits::quiet_NaN(); - } + if (std::isnan(a) || std::isnan(x)) { + return std::numeric_limits::quiet_NaN(); + } if (x < 0 || a < 0) { set_error("gammainc", SF_ERROR_DOMAIN, NULL); @@ -371,9 +371,9 @@ namespace cephes { XSF_HOST_DEVICE double igamc(double a, double x) { double absxma_a; - if (std::isnan(a) || std::isnan(x)) { - return std::numeric_limits::quiet_NaN(); - } + if (std::isnan(a) || std::isnan(x)) { + return std::numeric_limits::quiet_NaN(); + } if (x < 0 || a < 0) { set_error("gammaincc", SF_ERROR_DOMAIN, NULL); diff --git a/include/xsf/cephes/igam_asymp_coeff.h b/include/xsf/cephes/igam_asymp_coeff.h index 98404c6..e46e97f 100644 --- a/include/xsf/cephes/igam_asymp_coeff.h +++ b/include/xsf/cephes/igam_asymp_coeff.h @@ -188,7 +188,8 @@ namespace cephes { 1.3356313181291573e+2, -1.1276295161252794e+2, 4.6310396098204458e+1, -7.9237387133614756e-6, -1.4510726927018646e+1, 1.1111771248100563e+1, -4.1690817945270892, 3.1008219800117808e-3, 1.1220095449981468, -7.6052379926149916e-1, 3.6262236505085254e-1, 2.216867741940747e-1, - 4.8683443692930507e-1}}; + 4.8683443692930507e-1} + }; } // namespace detail } // namespace cephes diff --git a/include/xsf/cephes/incbet.h b/include/xsf/cephes/incbet.h index aa56dfd..abbf620 100644 --- a/include/xsf/cephes/incbet.h +++ b/include/xsf/cephes/incbet.h @@ -74,17 +74,15 @@ namespace cephes { namespace detail { - /* Compute (u * v) * w, disabling optimizations for gcc on 32 bit systems. - * Used below in incbet_pseries to prevent aggressive optimizations from - * degrading accuracy. - */ + /* Compute (u * v) * w, disabling optimizations for gcc on 32 bit systems. + * Used below in incbet_pseries to prevent aggressive optimizations from + * degrading accuracy. + */ #if defined(__GNUC__) && defined(__i386__) #pragma GCC push_options #pragma GCC optimize("00") #endif - XSF_HOST_DEVICE inline double triple_product(double u, double v, double w) { - return (u * v) * w; - } + XSF_HOST_DEVICE inline double triple_product(double u, double v, double w) { return (u * v) * w; } #if defined(__GNUC__) && defined(__i386__) #pragma GCC pop_options #endif diff --git a/include/xsf/cephes/jv.h b/include/xsf/cephes/jv.h index db5272f..8c250a6 100644 --- a/include/xsf/cephes/jv.h +++ b/include/xsf/cephes/jv.h @@ -55,10 +55,10 @@ #include "airy.h" #include "cbrt.h" -#include "rgamma.h" #include "j0.h" #include "j1.h" #include "polevl.h" +#include "rgamma.h" namespace xsf { namespace cephes { @@ -324,8 +324,9 @@ namespace cephes { constexpr double jv_PF3[] = {1.3671428571428571429e-1, -5.4920634920634920635e-2, -4.4444444444444444444e-3}; - constexpr double jv_PF4[] = {1.3500000000000000000e-3, -1.6036054421768707483e-1, 4.2590187590187590188e-2, - 2.7330447330447330447e-3}; + constexpr double jv_PF4[] = { + 1.3500000000000000000e-3, -1.6036054421768707483e-1, 4.2590187590187590188e-2, 2.7330447330447330447e-3 + }; constexpr double jv_PG1[] = {-2.4285714285714285714e-1, 1.4285714285714285714e-2}; @@ -385,41 +386,49 @@ namespace cephes { * AMS55 #9.3.35. */ - constexpr double jv_lambda[] = {1.0, - 1.041666666666666666666667E-1, - 8.355034722222222222222222E-2, - 1.282265745563271604938272E-1, - 2.918490264641404642489712E-1, - 8.816272674437576524187671E-1, - 3.321408281862767544702647E+0, - 1.499576298686255465867237E+1, - 7.892301301158651813848139E+1, - 4.744515388682643231611949E+2, - 3.207490090890661934704328E+3}; - - constexpr double jv_mu[] = {1.0, - -1.458333333333333333333333E-1, - -9.874131944444444444444444E-2, - -1.433120539158950617283951E-1, - -3.172272026784135480967078E-1, - -9.424291479571202491373028E-1, - -3.511203040826354261542798E+0, - -1.572726362036804512982712E+1, - -8.228143909718594444224656E+1, - -4.923553705236705240352022E+2, - -3.316218568547972508762102E+3}; + constexpr double jv_lambda[] = { + 1.0, + 1.041666666666666666666667E-1, + 8.355034722222222222222222E-2, + 1.282265745563271604938272E-1, + 2.918490264641404642489712E-1, + 8.816272674437576524187671E-1, + 3.321408281862767544702647E+0, + 1.499576298686255465867237E+1, + 7.892301301158651813848139E+1, + 4.744515388682643231611949E+2, + 3.207490090890661934704328E+3 + }; + + constexpr double jv_mu[] = { + 1.0, + -1.458333333333333333333333E-1, + -9.874131944444444444444444E-2, + -1.433120539158950617283951E-1, + -3.172272026784135480967078E-1, + -9.424291479571202491373028E-1, + -3.511203040826354261542798E+0, + -1.572726362036804512982712E+1, + -8.228143909718594444224656E+1, + -4.923553705236705240352022E+2, + -3.316218568547972508762102E+3 + }; constexpr double jv_P1[] = {-2.083333333333333333333333E-1, 1.250000000000000000000000E-1}; - constexpr double jv_P2[] = {3.342013888888888888888889E-1, -4.010416666666666666666667E-1, - 7.031250000000000000000000E-2}; + constexpr double jv_P2[] = { + 3.342013888888888888888889E-1, -4.010416666666666666666667E-1, 7.031250000000000000000000E-2 + }; - constexpr double jv_P3[] = {-1.025812596450617283950617E+0, 1.846462673611111111111111E+0, - -8.912109375000000000000000E-1, 7.324218750000000000000000E-2}; + constexpr double jv_P3[] = { + -1.025812596450617283950617E+0, 1.846462673611111111111111E+0, -8.912109375000000000000000E-1, + 7.324218750000000000000000E-2 + }; - constexpr double jv_P4[] = {4.669584423426247427983539E+0, -1.120700261622299382716049E+1, - 8.789123535156250000000000E+0, -2.364086914062500000000000E+0, - 1.121520996093750000000000E-1}; + constexpr double jv_P4[] = { + 4.669584423426247427983539E+0, -1.120700261622299382716049E+1, 8.789123535156250000000000E+0, + -2.364086914062500000000000E+0, 1.121520996093750000000000E-1 + }; constexpr double jv_P5[] = {-2.8212072558200244877E1, 8.4636217674600734632E1, -9.1818241543240017361E1, 4.2534998745388454861E1, -7.3687943594796316964E0, 2.27108001708984375E-1}; diff --git a/include/xsf/cephes/k0.h b/include/xsf/cephes/k0.h index f617b93..beb59f4 100644 --- a/include/xsf/cephes/k0.h +++ b/include/xsf/cephes/k0.h @@ -114,7 +114,8 @@ namespace cephes { -1.69753450938905987466E-9, 8.57403401741422608519E-9, -4.66048989768794782956E-8, 2.76681363944501510342E-7, -1.83175552271911948767E-6, 1.39498137188764993662E-5, -1.28495495816278026384E-4, 1.56988388573005337491E-3, -3.14481013119645005427E-2, - 2.44030308206595545468E0}; + 2.44030308206595545468E0 + }; } // namespace detail diff --git a/include/xsf/cephes/k1.h b/include/xsf/cephes/k1.h index 96594fd..b64d0d7 100644 --- a/include/xsf/cephes/k1.h +++ b/include/xsf/cephes/k1.h @@ -94,11 +94,12 @@ namespace cephes { * lim(x->0){ x(K1(x) - log(x/2) I1(x)) } = 1. */ - constexpr double k1_A[] = { - -7.02386347938628759343E-18, -2.42744985051936593393E-15, -6.66690169419932900609E-13, - -1.41148839263352776110E-10, -2.21338763073472585583E-8, -2.43340614156596823496E-6, - -1.73028895751305206302E-4, -6.97572385963986435018E-3, -1.22611180822657148235E-1, - -3.53155960776544875667E-1, 1.52530022733894777053E0}; + constexpr double k1_A[] = {-7.02386347938628759343E-18, -2.42744985051936593393E-15, + -6.66690169419932900609E-13, -1.41148839263352776110E-10, + -2.21338763073472585583E-8, -2.43340614156596823496E-6, + -1.73028895751305206302E-4, -6.97572385963986435018E-3, + -1.22611180822657148235E-1, -3.53155960776544875667E-1, + 1.52530022733894777053E0}; /* Chebyshev coefficients for exp(x) sqrt(x) K1(x) * in the interval [2,infinity]. @@ -114,7 +115,8 @@ namespace cephes { 2.01504975519703286596E-9, -1.03457624656780970260E-8, 5.74108412545004946722E-8, -3.50196060308781257119E-7, 2.40648494783721712015E-6, -1.93619797416608296024E-5, 1.95215518471351631108E-4, -2.85781685962277938680E-3, 1.03923736576817238437E-1, - 2.72062619048444266945E0}; + 2.72062619048444266945E0 + }; } // namespace detail diff --git a/include/xsf/cephes/kolmogorov.h b/include/xsf/cephes/kolmogorov.h index 20fba8b..b3c4e85 100644 --- a/include/xsf/cephes/kolmogorov.h +++ b/include/xsf/cephes/kolmogorov.h @@ -124,8 +124,10 @@ namespace cephes { double sf, cdf, pdf; if (std::isnan(x)) { - return {std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN(), - std::numeric_limits::quiet_NaN()}; + return { + std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN(), + std::numeric_limits::quiet_NaN() + }; } if (x <= 0) { return {1.0, 0.0, 0}; @@ -392,7 +394,7 @@ namespace cephes { if (L == 0) { L = std::abs(x); } else { - int Lint = (int) (L); + int Lint = (int)(L); if (Lint == L) { L = Lint; } @@ -613,8 +615,10 @@ namespace cephes { * Compute a single term in the summation, A_v(n, x): * A_v(n, x) = Binomial(n,v) * (1-x-v/n)^(n-v) * (x+v/n)^(v-1) */ - XSF_HOST_DEVICE inline void computeAv(int n, double x, int v, const double_double &Cman, int Cexpt, - double_double *pt1, double_double *pt2, double_double *pAv) { + XSF_HOST_DEVICE inline void computeAv( + int n, double x, int v, const double_double &Cman, int Cexpt, double_double *pt1, double_double *pt2, + double_double *pAv + ) { int t1E, t2E, ansE; double_double Av; double_double t2x = double_double(n - v) / n - x; /* 1 - x - v/n */ @@ -640,8 +644,10 @@ namespace cephes { int nxfl, n1mxfl, n1mxceil; if (!(n > 0 && x >= 0.0 && x <= 1.0)) { - return {std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN(), - std::numeric_limits::quiet_NaN()}; + return { + std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN(), + std::numeric_limits::quiet_NaN() + }; } if (n == 1) { return {1 - x, x, 1.0}; @@ -712,8 +718,9 @@ namespace cephes { */ int nUpperTerms = n - n1mxceil + 1; bUseUpperSum = (nUpperTerms <= 1 && x < 0.5); - bUseUpperSum = (bUseUpperSum || ((n >= SM_UPPERSUM_MIN_N) && (nUpperTerms <= SM_UPPER_MAX_TERMS) && - (x <= 0.5 / std::sqrt(n)))); + bUseUpperSum = + (bUseUpperSum || + ((n >= SM_UPPERSUM_MIN_N) && (nUpperTerms <= SM_UPPER_MAX_TERMS) && (x <= 0.5 / std::sqrt(n)))); } { int start = 0, step = 1, nTerms = n1mxfl + 1; diff --git a/include/xsf/cephes/lanczos.h b/include/xsf/cephes/lanczos.h index a8cbbe1..f387412 100644 --- a/include/xsf/cephes/lanczos.h +++ b/include/xsf/cephes/lanczos.h @@ -47,7 +47,8 @@ namespace cephes { 248874557.8620541565114603864132294232163, 1439720407.311721673663223072794912393972, 6039542586.35202800506429164430729792107, 17921034426.03720969991975575445893111267, 35711959237.35566804944018545154716670596, 42919803642.64909876895789904700198885093, - 23531376880.41075968857200767445163675473}; + 23531376880.41075968857200767445163675473 + }; constexpr double lanczos_denom[] = {1, 66, 1925, 32670, 357423, 2637558, 13339535, 45995730, 105258076, 150917976, 120543840, 39916800, 0}; @@ -59,10 +60,12 @@ namespace cephes { 601859.6171681098786670226533699352302507, 3481712.15498064590882071018964774556468, 14605578.08768506808414169982791359218571, 43338889.32467613834773723740590533316085, 86363131.28813859145546927288977868422342, 103794043.1163445451906271053616070238554, - 56906521.91347156388090791033559122686859}; + 56906521.91347156388090791033559122686859 + }; - constexpr double lanczos_sum_expg_scaled_denom[] = { - 1, 66, 1925, 32670, 357423, 2637558, 13339535, 45995730, 105258076, 150917976, 120543840, 39916800, 0}; + constexpr double lanczos_sum_expg_scaled_denom[] = {1, 66, 1925, 32670, 357423, + 2637558, 13339535, 45995730, 105258076, 150917976, + 120543840, 39916800, 0}; constexpr double lanczos_sum_near_1_d[] = { 0.3394643171893132535170101292240837927725e-9, -0.2499505151487868335680273909354071938387e-8, @@ -70,7 +73,8 @@ namespace cephes { 0.3075580174791348492737947340039992829546e-7, -0.2752907702903126466004207345038327818713e-7, -0.1515973019871092388943437623825208095123e-5, 0.004785200610085071473880915854204301886437, -0.1993758927614728757314233026257810172008, 1.483082862367253753040442933770164111678, - -3.327150580651624233553677113928873034916, 2.208709979316623790862569924861841433016}; + -3.327150580651624233553677113928873034916, 2.208709979316623790862569924861841433016 + }; constexpr double lanczos_sum_near_2_d[] = { 0.1009141566987569892221439918230042368112e-8, -0.7430396708998719707642735577238449585822e-8, @@ -78,7 +82,8 @@ namespace cephes { 0.9142922068165324132060550591210267992072e-7, -0.8183698410724358930823737982119474130069e-7, -0.4506604409707170077136555010018549819192e-5, 0.01422519127192419234315002746252160965831, -0.5926941084905061794445733628891024027949, 4.408830289125943377923077727900630927902, - -9.8907772644920670589288081640128194231, 6.565936202082889535528455955485877361223}; + -9.8907772644920670589288081640128194231, 6.565936202082889535528455955485877361223 + }; XSF_HOST_DEVICE double lanczos_sum(double x) { return ratevl(x, lanczos_num, 12, lanczos_denom, 12); } diff --git a/include/xsf/cephes/ndtr.h b/include/xsf/cephes/ndtr.h index 21bfc12..a8b310e 100644 --- a/include/xsf/cephes/ndtr.h +++ b/include/xsf/cephes/ndtr.h @@ -152,7 +152,8 @@ namespace cephes { constexpr double ndtr_Q[] = { /* 1.00000000000000000000E0, */ 1.32281951154744992508E1, 8.67072140885989742329E1, 3.54937778887819891062E2, 9.75708501743205489753E2, - 1.82390916687909736289E3, 2.24633760818710981792E3, 1.65666309194161350182E3, 5.57535340817727675546E2}; + 1.82390916687909736289E3, 2.24633760818710981792E3, 1.65666309194161350182E3, 5.57535340817727675546E2 + }; constexpr double ndtr_R[] = {5.64189583547755073984E-1, 1.27536670759978104416E0, 5.01905042251180477414E0, 6.16021097993053585195E0, 7.40974269950448939160E0, 2.97886665372100240670E0}; @@ -160,15 +161,19 @@ namespace cephes { constexpr double ndtr_S[] = { /* 1.00000000000000000000E0, */ 2.26052863220117276590E0, 9.39603524938001434673E0, 1.20489539808096656605E1, - 1.70814450747565897222E1, 9.60896809063285878198E0, 3.36907645100081516050E0}; + 1.70814450747565897222E1, 9.60896809063285878198E0, 3.36907645100081516050E0 + }; - constexpr double ndtr_T[] = {9.60497373987051638749E0, 9.00260197203842689217E1, 2.23200534594684319226E3, - 7.00332514112805075473E3, 5.55923013010394962768E4}; + constexpr double ndtr_T[] = { + 9.60497373987051638749E0, 9.00260197203842689217E1, 2.23200534594684319226E3, 7.00332514112805075473E3, + 5.55923013010394962768E4 + }; constexpr double ndtr_U[] = { /* 1.00000000000000000000E0, */ 3.35617141647503099647E1, 5.21357949780152679795E2, 4.59432382970980127987E3, 2.26290000613890934246E4, - 4.92673942608635921086E4}; + 4.92673942608635921086E4 + }; constexpr double ndtri_UTHRESH = 37.519379347; diff --git a/include/xsf/cephes/owens_t.h b/include/xsf/cephes/owens_t.h index 3a30c24..379a548 100644 --- a/include/xsf/cephes/owens_t.h +++ b/include/xsf/cephes/owens_t.h @@ -27,12 +27,13 @@ namespace cephes { namespace detail { - constexpr int owens_t_SELECT_METHOD[] = { - 0, 0, 1, 12, 12, 12, 12, 12, 12, 12, 12, 15, 15, 15, 8, 0, 1, 1, 2, 2, 4, 4, 13, 13, - 14, 14, 15, 15, 15, 8, 1, 1, 2, 2, 2, 4, 4, 14, 14, 14, 14, 15, 15, 15, 9, 1, 1, 2, - 4, 4, 4, 4, 6, 6, 15, 15, 15, 15, 15, 9, 1, 2, 2, 4, 4, 5, 5, 7, 7, 16, 16, 16, - 11, 11, 10, 1, 2, 4, 4, 4, 5, 5, 7, 7, 16, 16, 16, 11, 11, 11, 1, 2, 3, 3, 5, 5, - 7, 7, 16, 16, 16, 16, 16, 11, 11, 1, 2, 3, 3, 5, 5, 17, 17, 17, 17, 16, 16, 16, 11, 11}; + constexpr int owens_t_SELECT_METHOD[] = {0, 0, 1, 12, 12, 12, 12, 12, 12, 12, 12, 15, 15, 15, 8, 0, 1, 1, + 2, 2, 4, 4, 13, 13, 14, 14, 15, 15, 15, 8, 1, 1, 2, 2, 2, 4, + 4, 14, 14, 14, 14, 15, 15, 15, 9, 1, 1, 2, 4, 4, 4, 4, 6, 6, + 15, 15, 15, 15, 15, 9, 1, 2, 2, 4, 4, 5, 5, 7, 7, 16, 16, 16, + 11, 11, 10, 1, 2, 4, 4, 4, 5, 5, 7, 7, 16, 16, 16, 11, 11, 11, + 1, 2, 3, 3, 5, 5, 7, 7, 16, 16, 16, 16, 16, 11, 11, 1, 2, 3, + 3, 5, 5, 17, 17, 17, 17, 16, 16, 16, 11, 11}; constexpr double owens_t_HRANGE[] = {0.02, 0.06, 0.09, 0.125, 0.26, 0.4, 0.6, 1.6, 1.7, 2.33, 2.4, 3.36, 3.4, 4.8}; @@ -77,19 +78,21 @@ namespace cephes { 9.072354320794358e-06, }; - constexpr double owens_t_PTS[] = { - 0.35082039676451715489E-02, 0.31279042338030753740E-01, 0.85266826283219451090E-01, - 0.16245071730812277011E+00, 0.25851196049125434828E+00, 0.36807553840697533536E+00, - 0.48501092905604697475E+00, 0.60277514152618576821E+00, 0.71477884217753226516E+00, - 0.81475510988760098605E+00, 0.89711029755948965867E+00, 0.95723808085944261843E+00, - 0.99178832974629703586E+00}; - - constexpr double owens_t_WTS[] = { - 0.18831438115323502887E-01, 0.18567086243977649478E-01, 0.18042093461223385584E-01, - 0.17263829606398753364E-01, 0.16243219975989856730E-01, 0.14994592034116704829E-01, - 0.13535474469662088392E-01, 0.11886351605820165233E-01, 0.10070377242777431897E-01, - 0.81130545742299586629E-02, 0.60419009528470238773E-02, 0.38862217010742057883E-02, - 0.16793031084546090448E-02}; + constexpr double owens_t_PTS[] = {0.35082039676451715489E-02, 0.31279042338030753740E-01, + 0.85266826283219451090E-01, 0.16245071730812277011E+00, + 0.25851196049125434828E+00, 0.36807553840697533536E+00, + 0.48501092905604697475E+00, 0.60277514152618576821E+00, + 0.71477884217753226516E+00, 0.81475510988760098605E+00, + 0.89711029755948965867E+00, 0.95723808085944261843E+00, + 0.99178832974629703586E+00}; + + constexpr double owens_t_WTS[] = {0.18831438115323502887E-01, 0.18567086243977649478E-01, + 0.18042093461223385584E-01, 0.17263829606398753364E-01, + 0.16243219975989856730E-01, 0.14994592034116704829E-01, + 0.13535474469662088392E-01, 0.11886351605820165233E-01, + 0.10070377242777431897E-01, 0.81130545742299586629E-02, + 0.60419009528470238773E-02, 0.38862217010742057883E-02, + 0.16793031084546090448E-02}; XSF_HOST_DEVICE inline int get_method(double h, double a) { int ihint, iaint, i; @@ -115,9 +118,7 @@ namespace cephes { XSF_HOST_DEVICE inline double owens_t_norm1(double x) { return xsf::cephes::erf(x / std::sqrt(2)) / 2; } - XSF_HOST_DEVICE inline double owens_t_norm2(double x) { - return xsf::cephes::erfc(x / std::sqrt(2)) / 2; - } + XSF_HOST_DEVICE inline double owens_t_norm2(double x) { return xsf::cephes::erfc(x / std::sqrt(2)) / 2; } XSF_HOST_DEVICE inline double owensT1(double h, double a, double m) { int j = 1; diff --git a/include/xsf/cephes/psi.h b/include/xsf/cephes/psi.h index c028e9e..bcc3c61 100644 --- a/include/xsf/cephes/psi.h +++ b/include/xsf/cephes/psi.h @@ -89,13 +89,15 @@ namespace cephes { constexpr double psi_P[] = {-0.0020713321167745952, -0.045251321448739056, -0.28919126444774784, -0.65031853770896507, -0.32555031186804491, 0.25479851061131551}; - constexpr double psi_Q[] = {-0.55789841321675513e-6, - 0.0021284987017821144, - 0.054151797245674225, - 0.43593529692665969, - 1.4606242909763515, - 2.0767117023730469, - 1.0}; + constexpr double psi_Q[] = { + -0.55789841321675513e-6, + 0.0021284987017821144, + 0.054151797245674225, + 0.43593529692665969, + 1.4606242909763515, + 2.0767117023730469, + 1.0 + }; XSF_HOST_DEVICE double digamma_imp_1_2(double x) { /* diff --git a/include/xsf/cephes/rgamma.h b/include/xsf/cephes/rgamma.h index 97f29b3..7c41601 100644 --- a/include/xsf/cephes/rgamma.h +++ b/include/xsf/cephes/rgamma.h @@ -61,32 +61,33 @@ namespace cephes { * in interval 0 to 1. Function is 1/(x Gamma(x)) - 1 */ - constexpr double rgamma_R[] = { - 3.13173458231230000000E-17, -6.70718606477908000000E-16, 2.20039078172259550000E-15, - 2.47691630348254132600E-13, -6.60074100411295197440E-12, 5.13850186324226978840E-11, - 1.08965386454418662084E-9, -3.33964630686836942556E-8, 2.68975996440595483619E-7, - 2.96001177518801696639E-6, -8.04814124978471142852E-5, 4.16609138709688864714E-4, - 5.06579864028608725080E-3, -6.41925436109158228810E-2, -4.98558728684003594785E-3, - 1.27546015610523951063E-1}; + constexpr double rgamma_R[] = {3.13173458231230000000E-17, -6.70718606477908000000E-16, + 2.20039078172259550000E-15, 2.47691630348254132600E-13, + -6.60074100411295197440E-12, 5.13850186324226978840E-11, + 1.08965386454418662084E-9, -3.33964630686836942556E-8, + 2.68975996440595483619E-7, 2.96001177518801696639E-6, + -8.04814124978471142852E-5, 4.16609138709688864714E-4, + 5.06579864028608725080E-3, -6.41925436109158228810E-2, + -4.98558728684003594785E-3, 1.27546015610523951063E-1}; } // namespace detail XSF_HOST_DEVICE double rgamma(double x) { double w, y, z; - if (x == 0) { - // This case is separate from below to get correct sign for zero. - return x; - } + if (x == 0) { + // This case is separate from below to get correct sign for zero. + return x; + } - if (x < 0 && x == std::floor(x)) { - // Gamma poles. - return 0.0; - } + if (x < 0 && x == std::floor(x)) { + // Gamma poles. + return 0.0; + } - if (std::abs(x) > 4.0) { - return 1.0 / Gamma(x); - } + if (std::abs(x) > 4.0) { + return 1.0 / Gamma(x); + } z = 1.0; w = x; diff --git a/include/xsf/cephes/scipy_iv.h b/include/xsf/cephes/scipy_iv.h index fe0c631..efec0ec 100644 --- a/include/xsf/cephes/scipy_iv.h +++ b/include/xsf/cephes/scipy_iv.h @@ -362,7 +362,8 @@ namespace cephes { 0.0, 0.0, 0.0, - 0.0}}; + 0.0} + }; /* * Compute Iv, Kv from (AMS5 9.7.7 + 9.7.8), asymptotic expansion for large v diff --git a/include/xsf/cephes/shichi.h b/include/xsf/cephes/shichi.h index f249ca4..670af14 100644 --- a/include/xsf/cephes/shichi.h +++ b/include/xsf/cephes/shichi.h @@ -78,7 +78,8 @@ namespace cephes { -1.03257121792819495123E-9, -3.56699611114982536845E-8, 1.44818877384267342057E-7, 7.82018215184051295296E-7, -5.39919118403805073710E-6, -3.12458202168959833422E-5, 8.90136741950727517826E-5, 2.02558474743846862168E-3, 2.96064440855633256972E-2, - 1.11847751047257036625E0}; + 1.11847751047257036625E0 + }; /* x exp(-x) shi(x), inverted interval 18 to 88 */ constexpr double shichi_S2[] = { @@ -89,7 +90,8 @@ namespace cephes { -3.49278141024730899554E-11, -1.58580661666482709598E-10, -1.79289437183355633342E-10, 1.76281629144264523277E-9, 1.69050228879421288846E-8, 1.25391771228487041649E-7, 1.16229947068677338732E-6, 1.61038260117376323993E-5, 3.49810375601053973070E-4, - 1.28478065259647610779E-2, 1.03665722588798326712E0}; + 1.28478065259647610779E-2, 1.03665722588798326712E0 + }; /* x exp(-x) chin(x), inverted interval 8 to 18 */ constexpr double shichi_C1[] = { @@ -100,7 +102,8 @@ namespace cephes { -1.87992075640569295479E-10, 1.31458150989474594064E-8, -4.75513930924765465590E-8, -2.21775018801848880741E-7, 1.94635531373272490962E-6, 4.33505889257316408893E-6, -6.13387001076494349496E-5, -3.13085477492997465138E-4, 4.97164789823116062801E-4, - 2.64347496031374526641E-2, 1.11446150876699213025E0}; + 2.64347496031374526641E-2, 1.11446150876699213025E0 + }; /* x exp(-x) chin(x), inverted interval 18 to 88 */ constexpr double shichi_C2[] = { @@ -111,7 +114,8 @@ namespace cephes { 2.33781843985453438400E-11, 2.71436006377612442764E-11, -2.56600180000355990529E-10, -1.61021375163803438552E-9, -4.72543064876271773512E-9, -3.00095178028681682282E-9, 7.79387474390914922337E-8, 1.06942765566401507066E-6, 1.59503164802313196374E-5, - 3.49592575153777996871E-4, 1.28475387530065247392E-2, 1.03665693917934275131E0}; + 3.49592575153777996871E-4, 1.28475387530065247392E-2, 1.03665693917934275131E0 + }; /* * Evaluate 3F0(a1, a2, a3; z) diff --git a/include/xsf/cephes/struve.h b/include/xsf/cephes/struve.h index 3ed5bae..6cfec2d 100644 --- a/include/xsf/cephes/struve.h +++ b/include/xsf/cephes/struve.h @@ -125,7 +125,7 @@ namespace cephes { } else if (m > STRUVE_MAXITER) { maxiter = STRUVE_MAXITER; } else { - maxiter = (int) m; + maxiter = (int)m; } if (maxiter == 0) { *err = std::numeric_limits::infinity(); diff --git a/include/xsf/cephes/zetac.h b/include/xsf/cephes/zetac.h index c006681..7e6529e 100644 --- a/include/xsf/cephes/zetac.h +++ b/include/xsf/cephes/zetac.h @@ -197,9 +197,7 @@ namespace cephes { * Compute zetac for small negative x. We can't use the reflection * formula because to double precision 1 - x = 1 and zetac(1) = inf. */ - XSF_HOST_DEVICE inline double zetac_smallneg(double x) { - return xsf::cephes::polevl(x, zetac_TAYLOR0, 9); - } + XSF_HOST_DEVICE inline double zetac_smallneg(double x) { return xsf::cephes::polevl(x, zetac_TAYLOR0, 9); } /* * Compute zetac using the reflection formula (see DLMF 25.4.2) plus diff --git a/include/xsf/erf.h b/include/xsf/erf.h index 0ec390d..7c34b0e 100644 --- a/include/xsf/erf.h +++ b/include/xsf/erf.h @@ -1,8 +1,8 @@ #pragma once -#include "faddeeva.h" #include "cephes/ndtr.h" #include "config.h" +#include "faddeeva.h" namespace xsf { diff --git a/include/xsf/expint.h b/include/xsf/expint.h index 600448a..e6235dd 100644 --- a/include/xsf/expint.h +++ b/include/xsf/expint.h @@ -15,10 +15,8 @@ #include "cephes/const.h" - namespace xsf { - XSF_HOST_DEVICE inline double exp1(double x) { // ============================================ // Purpose: Compute exponential integral E1(x) @@ -30,25 +28,27 @@ XSF_HOST_DEVICE inline double exp1(double x) { constexpr double ga = cephes::detail::SCIPY_EULER; if (x == 0.0) { - return std::numeric_limits::infinity(); + return std::numeric_limits::infinity(); } if (x <= 1.0) { e1 = 1.0; r = 1.0; for (k = 1; k < 26; k++) { - r = -r*k*x/std::pow(k+1.0, 2); + r = -r * k * x / std::pow(k + 1.0, 2); e1 += r; - if (std::abs(r) <= std::abs(e1)*1e-15) { break; } + if (std::abs(r) <= std::abs(e1) * 1e-15) { + break; + } } - return -ga - std::log(x) + x*e1; + return -ga - std::log(x) + x * e1; } - m = 20 + (int)(80.0/x); + m = 20 + (int)(80.0 / x); t0 = 0.0; for (k = m; k > 0; k--) { - t0 = k / (1.0 + k / (x+t0)); + t0 = k / (1.0 + k / (x + t0)); } t = 1.0 / (x + t0); - return std::exp(-x)*t; + return std::exp(-x) * t; } XSF_HOST_DEVICE inline float exp1(float x) { return exp1(static_cast(x)); } @@ -66,24 +66,28 @@ XSF_HOST_DEVICE inline std::complex exp1(std::complex z) { double a0 = std::abs(z); // Continued fraction converges slowly near negative real axis, // so use power series in a wedge around it until radius 40.0 - double xt = -2.0*std::abs(z.imag()); + double xt = -2.0 * std::abs(z.imag()); - if (a0 == 0.0) { return std::numeric_limits::infinity(); } + if (a0 == 0.0) { + return std::numeric_limits::infinity(); + } if ((a0 < 5.0) || ((x < xt) && (a0 < 40.0))) { // Power series ce1 = 1.0; cr = 1.0; for (k = 1; k < 501; k++) { - cr = -cr*z*static_cast(k / std::pow(k + 1, 2)); + cr = -cr * z * static_cast(k / std::pow(k + 1, 2)); ce1 += cr; - if (std::abs(cr) < std::abs(ce1)*1e-15) { break; } + if (std::abs(cr) < std::abs(ce1) * 1e-15) { + break; + } } if ((x <= 0.0) && (z.imag() == 0.0)) { - //Careful on the branch cut -- use the sign of the imaginary part - // to get the right sign on the factor if pi. - ce1 = -el - std::log(-z) + z*ce1 - std::copysign(M_PI, z.imag())*std::complex(0.0, 1.0); + // Careful on the branch cut -- use the sign of the imaginary part + // to get the right sign on the factor if pi. + ce1 = -el - std::log(-z) + z * ce1 - std::copysign(M_PI, z.imag()) * std::complex(0.0, 1.0); } else { - ce1 = -el - std::log(z) + z*ce1; + ce1 = -el - std::log(z) + z * ce1; } } else { // Continued fraction https://dlmf.nist.gov/6.9 @@ -95,18 +99,20 @@ XSF_HOST_DEVICE inline std::complex exp1(std::complex z) { zdc = zd; zc += zdc; for (k = 1; k < 501; k++) { - zd = static_cast(1) / (zd*static_cast(k) + static_cast(1)); + zd = static_cast(1) / (zd * static_cast(k) + static_cast(1)); zdc *= (zd - static_cast(1)); zc += zdc; - zd = static_cast(1) / (zd*static_cast(k) + z); - zdc *= (z*zd - static_cast(1)); + zd = static_cast(1) / (zd * static_cast(k) + z); + zdc *= (z * zd - static_cast(1)); zc += zdc; - if ((std::abs(zdc) <= std::abs(zc)*1e-15) && (k > 20)) { break; } + if ((std::abs(zdc) <= std::abs(zc) * 1e-15) && (k > 20)) { + break; + } } - ce1 = std::exp(-z)*zc; + ce1 = std::exp(-z) * zc; if ((x <= 0.0) && (z.imag() == 0.0)) { - ce1 -= M_PI*std::complex(0.0, 1.0); + ce1 -= M_PI * std::complex(0.0, 1.0); } } return ce1; @@ -138,7 +144,9 @@ XSF_HOST_DEVICE inline double expi(double x) { for (int k = 1; k <= 100; k++) { r = r * k * x / ((k + 1.0) * (k + 1.0)); ei += r; - if (std::abs(r / ei) <= 1.0e-15) { break; } + if (std::abs(r / ei) <= 1.0e-15) { + break; + } } ei = ga + std::log(x) + x * ei; } else { @@ -155,7 +163,7 @@ XSF_HOST_DEVICE inline double expi(double x) { } XSF_HOST_DEVICE inline float expi(float x) { return expi(static_cast(x)); } - + std::complex expi(std::complex z) { // ============================================ // Purpose: Compute exponential integral Ei(x) @@ -164,10 +172,10 @@ std::complex expi(std::complex z) { // ============================================ std::complex cei; - cei = - exp1(-z); + cei = -exp1(-z); if (z.imag() > 0.0) { cei += std::complex(0.0, M_PI); - } else if (z.imag() < 0.0 ) { + } else if (z.imag() < 0.0) { cei -= std::complex(0.0, M_PI); } else { if (z.real() > 0.0) { @@ -177,7 +185,6 @@ std::complex expi(std::complex z) { return cei; } - XSF_HOST_DEVICE inline std::complex expi(std::complex z) { return static_cast>(expi(static_cast>(z))); } @@ -213,7 +220,7 @@ namespace detail { XSF_HOST_DEVICE inline double expint1_factor_cont_frac(double x) { // The number of terms to use in the truncated continued fraction // depends on x. Larger values of x require fewer terms. - int m = 20 + (int) (80.0 / x); + int m = 20 + (int)(80.0 / x); double t0 = 0.0; for (int k = m; k > 0; --k) { t0 = k / (x + k / (1 + t0)); diff --git a/include/xsf/faddeeva.h b/include/xsf/faddeeva.h index 78b51dc..d4c67d1 100644 --- a/include/xsf/faddeeva.h +++ b/include/xsf/faddeeva.h @@ -1,5 +1,5 @@ /* Copyright (c) 2012 Massachusetts Institute of Technology - * + * * Permission is hereby granted, free of charge, to any person obtaining * a copy of this software and associated documentation files (the * "Software"), to deal in the Software without restriction, including @@ -7,24 +7,24 @@ * distribute, sublicense, and/or sell copies of the Software, and to * permit persons to whom the Software is furnished to do so, subject to * the following conditions: - * + * * The above copyright notice and this permission notice shall be * included in all copies or substantial portions of the Software. - * + * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE * LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION * OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION - * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. */ /* Available at: http://ab-initio.mit.edu/Faddeeva - Computes various error functions (erf, erfc, erfi, erfcx), + Computes various error functions (erf, erfc, erfi, erfcx), including the Dawson integral, in the complex plane, based - on algorithms for the computation of the Faddeeva function + on algorithms for the computation of the Faddeeva function w(z) = exp(-z^2) * erfc(-i*z). Given w(z), the error functions are mostly straightforward to compute, except for certain regions where we have to @@ -53,7 +53,7 @@ (I initially used this algorithm for all z, but it turned out to be significantly slower than the continued-fraction expansion for - larger |z|. On the other hand, it is competitive for smaller |z|, + larger |z|. On the other hand, it is competitive for smaller |z|, and is significantly more accurate than the Poppe & Wijers code in some regions, e.g. in the vicinity of z=1+1i.) @@ -67,7 +67,7 @@ http://math.mit.edu/~stevenj October 2012. - -- Note that Algorithm 916 assumes that the erfc(x) function, + -- Note that Algorithm 916 assumes that the erfc(x) function, or rather the scaled function erfcx(x) = exp(x*x)*erfc(x), is supplied for REAL arguments x. I originally used an erfcx routine derived from DERFC in SLATEC, but I have @@ -86,33 +86,33 @@ 4 October 2012: Initial public release (SGJ) 5 October 2012: Revised (SGJ) to fix spelling error, start summation for large x at round(x/a) (> 1) - rather than ceil(x/a) as in the original - paper, which should slightly improve performance - (and, apparently, slightly improves accuracy) + rather than ceil(x/a) as in the original + paper, which should slightly improve performance + (and, apparently, slightly improves accuracy) 19 October 2012: Revised (SGJ) to fix bugs for large x, large -y, and 15 1e154. - Set relerr argument to min(relerr,0.1). + Also, avoid spurious overflow for |z| > 1e154. + Set relerr argument to min(relerr,0.1). 27 October 2012: Enhance accuracy in Re[w(z)] taken by itself, by switching to Alg. 916 in a region near - the real-z axis where continued fractions - have poor relative accuracy in Re[w(z)]. Thanks - to M. Zaghloul for the tip. + the real-z axis where continued fractions + have poor relative accuracy in Re[w(z)]. Thanks + to M. Zaghloul for the tip. 29 October 2012: Replace SLATEC-derived erfcx routine with completely rewritten code by me, using a very - different algorithm which is much faster. + different algorithm which is much faster. 30 October 2012: Implemented special-case code for real z (where real part is exp(-x^2) and imag part is - Dawson integral), using algorithm similar to erfx. - Export ImFaddeeva_w function to make Dawson's - integral directly accessible. + Dawson integral), using algorithm similar to erfx. + Export ImFaddeeva_w function to make Dawson's + integral directly accessible. 3 November 2012: Provide implementations of erf, erfc, erfcx, and Dawson functions in Faddeeva:: namespace, - in addition to Faddeeva::w. Provide header - file Faddeeva.hh. + in addition to Faddeeva::w. Provide header + file Faddeeva.hh. */ #pragma once @@ -123,716 +123,675 @@ namespace Faddeeva { // compute w(z) = exp(-z^2) erfc(-iz) [ Faddeeva / scaled complex error func ] -std::complex w(std::complex z,double relerr=0); +std::complex w(std::complex z, double relerr = 0); double w_im(double x); // special-case code for Im[w(x)] of real x // Various functions that we can compute with the help of w(z) // compute erfcx(z) = exp(z^2) erfz(z) -std::complex erfcx(std::complex z, double relerr=0); +std::complex erfcx(std::complex z, double relerr = 0); double erfcx(double x); // special case for real x // compute erf(z), the error function of complex arguments -std::complex erf(std::complex z, double relerr=0); +std::complex erf(std::complex z, double relerr = 0); double erf(double x); // special case for real x // compute erfi(z) = -i erf(iz), the imaginary error function -std::complex erfi(std::complex z, double relerr=0); +std::complex erfi(std::complex z, double relerr = 0); double erfi(double x); // special case for real x // compute erfc(z) = 1 - erf(z), the complementary error function -std::complex erfc(std::complex z, double relerr=0); +std::complex erfc(std::complex z, double relerr = 0); double erfc(double x); // special case for real x // compute Dawson(z) = sqrt(pi)/2 * exp(-z^2) * erfi(z) -std::complex Dawson(std::complex z, double relerr=0); +std::complex Dawson(std::complex z, double relerr = 0); double Dawson(double x); // special case for real x // compute erfcx(z) = exp(z^2) erfz(z) -std::complex erfcx(std::complex z, double relerr) -{ - return w(std::complex(-imag(z), real(z))); -} +std::complex erfcx(std::complex z, double relerr) { return w(std::complex(-imag(z), real(z))); } // compute the error function erf(x) -double erf(double x) -{ - double mx2 = -x*x; - if (mx2 < -750) // underflow - return (x >= 0 ? 1.0 : -1.0); - - if (x >= 0) { - if (x < 5e-3) goto taylor; - return 1.0 - exp(mx2) * erfcx(x); - } - else { // x < 0 - if (x > -5e-3) goto taylor; - return exp(mx2) * erfcx(-x) - 1.0; - } - - // Use Taylor series for small |x|, to avoid cancellation inaccuracy - // erf(x) = 2/sqrt(pi) * x * (1 - x^2/3 + x^4/10 - ...) - taylor: - return x * (1.1283791670955125739 - + mx2 * (0.37612638903183752464 - + mx2 * 0.11283791670955125739)); -} +double erf(double x) { + double mx2 = -x * x; + if (mx2 < -750) // underflow + return (x >= 0 ? 1.0 : -1.0); + + if (x >= 0) { + if (x < 5e-3) + goto taylor; + return 1.0 - exp(mx2) * erfcx(x); + } else { // x < 0 + if (x > -5e-3) + goto taylor; + return exp(mx2) * erfcx(-x) - 1.0; + } + // Use Taylor series for small |x|, to avoid cancellation inaccuracy + // erf(x) = 2/sqrt(pi) * x * (1 - x^2/3 + x^4/10 - ...) +taylor: + return x * (1.1283791670955125739 + mx2 * (0.37612638903183752464 + mx2 * 0.11283791670955125739)); +} // compute the error function erf(z) -std::complex erf(std::complex z, double relerr) -{ - double x = real(z), y = imag(z); - - if (x == 0) // handle separately for speed & handling of y = Inf or NaN - return std::complex(x, // preserve sign of 0 - /* handle y -> Inf limit manually, since - exp(y^2) -> Inf but Im[w(y)] -> 0, so - IEEE will give us a NaN when it should be Inf */ - y*y > 720 ? (y > 0 ? std::numeric_limits::infinity() : -std::numeric_limits::infinity()) - : exp(y*y) * w_im(y)); - - double mRe_z2 = (y - x) * (x + y); // Re(-z^2), being careful of overflow - double mIm_z2 = -2*x*y; // Im(-z^2) - if (mRe_z2 < -750) // underflow - return (x >= 0 ? 1.0 : -1.0); - - /* Handle positive and negative x via different formulas, - using the mirror symmetries of w, to avoid overflow/underflow - problems from multiplying exponentially large and small quantities. */ - if (x >= 0) { - if (x < 5e-3) { - if (fabs(y) < 5e-3) - goto taylor; - else if (fabs(mIm_z2) < 5e-3) - goto taylor_erfi; - } - /* don't use complex exp function, since that will produce spurious NaN - values when multiplying w in an overflow situation. */ - return 1.0 - exp(mRe_z2) * - (std::complex(cos(mIm_z2), sin(mIm_z2)) - * w(std::complex(-y,x))); - } - else { // x < 0 - if (x > -5e-3) { // duplicate from above to avoid fabs(x) call - if (fabs(y) < 5e-3) - goto taylor; - else if (fabs(mIm_z2) < 5e-3) - goto taylor_erfi; - } - else if (std::isnan(x)) - return std::complex(std::numeric_limits::quiet_NaN(), y == 0 ? 0 : std::numeric_limits::quiet_NaN()); - /* don't use complex exp function, since that will produce spurious NaN - values when multiplying w in an overflow situation. */ - return exp(mRe_z2) * - (std::complex(cos(mIm_z2), sin(mIm_z2)) - * w(std::complex(y,-x))) - 1.0; - } - - // Use Taylor series for small |z|, to avoid cancellation inaccuracy - // erf(z) = 2/sqrt(pi) * z * (1 - z^2/3 + z^4/10 - ...) - taylor: - { +std::complex erf(std::complex z, double relerr) { + double x = real(z), y = imag(z); + + if (x == 0) // handle separately for speed & handling of y = Inf or NaN + return std::complex( + x, // preserve sign of 0 + /* handle y -> Inf limit manually, since + exp(y^2) -> Inf but Im[w(y)] -> 0, so + IEEE will give us a NaN when it should be Inf */ + y * y > 720 ? (y > 0 ? std::numeric_limits::infinity() : -std::numeric_limits::infinity()) + : exp(y * y) * w_im(y) + ); + + double mRe_z2 = (y - x) * (x + y); // Re(-z^2), being careful of overflow + double mIm_z2 = -2 * x * y; // Im(-z^2) + if (mRe_z2 < -750) // underflow + return (x >= 0 ? 1.0 : -1.0); + + /* Handle positive and negative x via different formulas, + using the mirror symmetries of w, to avoid overflow/underflow + problems from multiplying exponentially large and small quantities. */ + if (x >= 0) { + if (x < 5e-3) { + if (fabs(y) < 5e-3) + goto taylor; + else if (fabs(mIm_z2) < 5e-3) + goto taylor_erfi; + } + /* don't use complex exp function, since that will produce spurious NaN + values when multiplying w in an overflow situation. */ + return 1.0 - exp(mRe_z2) * (std::complex(cos(mIm_z2), sin(mIm_z2)) * w(std::complex(-y, x))); + } else { // x < 0 + if (x > -5e-3) { // duplicate from above to avoid fabs(x) call + if (fabs(y) < 5e-3) + goto taylor; + else if (fabs(mIm_z2) < 5e-3) + goto taylor_erfi; + } else if (std::isnan(x)) + return std::complex( + std::numeric_limits::quiet_NaN(), y == 0 ? 0 : std::numeric_limits::quiet_NaN() + ); + /* don't use complex exp function, since that will produce spurious NaN + values when multiplying w in an overflow situation. */ + return exp(mRe_z2) * (std::complex(cos(mIm_z2), sin(mIm_z2)) * w(std::complex(y, -x))) - 1.0; + } + + // Use Taylor series for small |z|, to avoid cancellation inaccuracy + // erf(z) = 2/sqrt(pi) * z * (1 - z^2/3 + z^4/10 - ...) +taylor: { std::complex mz2(mRe_z2, mIm_z2); // -z^2 - return z * (1.1283791670955125739 - + mz2 * (0.37612638903183752464 - + mz2 * 0.11283791670955125739)); - } - - /* for small |x| and small |xy|, - use Taylor series to avoid cancellation inaccuracy: - erf(x+iy) = erf(iy) - + 2*exp(y^2)/sqrt(pi) * - [ x * (1 - x^2 * (1+2y^2)/3 + x^4 * (3+12y^2+4y^4)/30 + ... - - i * x^2 * y * (1 - x^2 * (3+2y^2)/6 + ...) ] - where: - erf(iy) = exp(y^2) * Im[w(y)] - */ - taylor_erfi: - { - double x2 = x*x, y2 = y*y; + return z * (1.1283791670955125739 + mz2 * (0.37612638903183752464 + mz2 * 0.11283791670955125739)); +} + + /* for small |x| and small |xy|, + use Taylor series to avoid cancellation inaccuracy: + erf(x+iy) = erf(iy) + + 2*exp(y^2)/sqrt(pi) * + [ x * (1 - x^2 * (1+2y^2)/3 + x^4 * (3+12y^2+4y^4)/30 + ... + - i * x^2 * y * (1 - x^2 * (3+2y^2)/6 + ...) ] + where: + erf(iy) = exp(y^2) * Im[w(y)] + */ +taylor_erfi: { + double x2 = x * x, y2 = y * y; double expy2 = exp(y2); - return std::complex - (expy2 * x * (1.1283791670955125739 - - x2 * (0.37612638903183752464 - + 0.75225277806367504925*y2) - + x2*x2 * (0.11283791670955125739 - + y2 * (0.45135166683820502956 - + 0.15045055561273500986*y2))), - expy2 * (w_im(y) - - x2*y * (1.1283791670955125739 - - x2 * (0.56418958354775628695 - + 0.37612638903183752464*y2)))); - } + return std::complex( + expy2 * x * + (1.1283791670955125739 - x2 * (0.37612638903183752464 + 0.75225277806367504925 * y2) + + x2 * x2 * (0.11283791670955125739 + y2 * (0.45135166683820502956 + 0.15045055561273500986 * y2))), + expy2 * + (w_im(y) - x2 * y * (1.1283791670955125739 - x2 * (0.56418958354775628695 + 0.37612638903183752464 * y2))) + ); +} } - // erfi(z) = -i erf(iz) -std::complex erfi(std::complex z, double relerr) -{ - std::complex e = erf(std::complex(-imag(z),real(z)), relerr); - return std::complex(imag(e), -real(e)); +std::complex erfi(std::complex z, double relerr) { + std::complex e = erf(std::complex(-imag(z), real(z)), relerr); + return std::complex(imag(e), -real(e)); } // erfi(x) = -i erf(ix) -double erfi(double x) -{ - return x*x > 720 ? (x > 0 ? std::numeric_limits::infinity() : -std::numeric_limits::infinity()) - : exp(x*x) * w_im(x); +double erfi(double x) { + return x * x > 720 ? (x > 0 ? std::numeric_limits::infinity() : -std::numeric_limits::infinity()) + : exp(x * x) * w_im(x); } // erfc(x) = 1 - erf(x) -double erfc(double x) -{ - if (x*x > 750) // underflow - return (x >= 0 ? 0.0 : 2.0); - return x >= 0 ? exp(-x*x) * erfcx(x) - : 2. - exp(-x*x) * erfcx(-x); +double erfc(double x) { + if (x * x > 750) // underflow + return (x >= 0 ? 0.0 : 2.0); + return x >= 0 ? exp(-x * x) * erfcx(x) : 2. - exp(-x * x) * erfcx(-x); } // erfc(z) = 1 - erf(z) -std::complex erfc(std::complex z, double relerr) -{ - double x = real(z), y = imag(z); - - if (x == 0.) - return std::complex(1, - /* handle y -> Inf limit manually, since - exp(y^2) -> Inf but Im[w(y)] -> 0, so - IEEE will give us a NaN when it should be Inf */ - y*y > 720 ? (y > 0 ? -std::numeric_limits::infinity() : std::numeric_limits::infinity()) - : -exp(y*y) * w_im(y)); - if (y == 0.) { - if (x*x > 750) // underflow - return (x >= 0 ? 0.0 : 2.0); - return x >= 0 ? exp(-x*x) * erfcx(x) - : 2. - exp(-x*x) * erfcx(-x); - } - - double mRe_z2 = (y - x) * (x + y); // Re(-z^2), being careful of overflow - double mIm_z2 = -2*x*y; // Im(-z^2) - if (mRe_z2 < -750) // underflow - return (x >= 0 ? 0.0 : 2.0); - - if (x >= 0) - return exp(std::complex(mRe_z2, mIm_z2)) - * w(std::complex(-y,x), relerr); - else - return 2.0 - exp(std::complex(mRe_z2, mIm_z2)) - * w(std::complex(y,-x), relerr); +std::complex erfc(std::complex z, double relerr) { + double x = real(z), y = imag(z); + + if (x == 0.) + return std::complex( + 1, + /* handle y -> Inf limit manually, since + exp(y^2) -> Inf but Im[w(y)] -> 0, so + IEEE will give us a NaN when it should be Inf */ + y * y > 720 ? (y > 0 ? -std::numeric_limits::infinity() : std::numeric_limits::infinity()) + : -exp(y * y) * w_im(y) + ); + if (y == 0.) { + if (x * x > 750) // underflow + return (x >= 0 ? 0.0 : 2.0); + return x >= 0 ? exp(-x * x) * erfcx(x) : 2. - exp(-x * x) * erfcx(-x); + } + + double mRe_z2 = (y - x) * (x + y); // Re(-z^2), being careful of overflow + double mIm_z2 = -2 * x * y; // Im(-z^2) + if (mRe_z2 < -750) // underflow + return (x >= 0 ? 0.0 : 2.0); + + if (x >= 0) + return exp(std::complex(mRe_z2, mIm_z2)) * w(std::complex(-y, x), relerr); + else + return 2.0 - exp(std::complex(mRe_z2, mIm_z2)) * w(std::complex(y, -x), relerr); } // compute Dawson(x) = sqrt(pi)/2 * exp(-x^2) * erfi(x) -double Dawson(double x) -{ - const double spi2 = 0.8862269254527580136490837416705725913990; // sqrt(pi)/2 - return spi2 * w_im(x); +double Dawson(double x) { + const double spi2 = 0.8862269254527580136490837416705725913990; // sqrt(pi)/2 + return spi2 * w_im(x); } // compute Dawson(z) = sqrt(pi)/2 * exp(-z^2) * erfi(z) -std::complex Dawson(std::complex z, double relerr) -{ - const double spi2 = 0.8862269254527580136490837416705725913990; // sqrt(pi)/2 - double x = real(z), y = imag(z); - - // handle axes separately for speed & proper handling of x or y = Inf or NaN - if (y == 0) - return std::complex(spi2 * w_im(x), - -y); // preserve sign of 0 - if (x == 0) { - double y2 = y*y; - if (y2 < 2.5e-5) { // Taylor expansion - return std::complex(x, // preserve sign of 0 - y * (1. - + y2 * (0.6666666666666666666666666666666666666667 - + y2 * 0.2666666666666666666666666666666666666667))); - } - return std::complex(x, // preserve sign of 0 - spi2 * (y >= 0 - ? exp(y2) - erfcx(y) - : erfcx(-y) - exp(y2))); - } - - double mRe_z2 = (y - x) * (x + y); // Re(-z^2), being careful of overflow - double mIm_z2 = -2*x*y; // Im(-z^2) - std::complex mz2(mRe_z2, mIm_z2); // -z^2 - - /* Handle positive and negative x via different formulas, - using the mirror symmetries of w, to avoid overflow/underflow - problems from multiplying exponentially large and small quantities. */ - if (y >= 0) { - if (y < 5e-3) { - if (fabs(x) < 5e-3) - goto taylor; - else if (fabs(mIm_z2) < 5e-3) - goto taylor_realaxis; - } - std::complex res = exp(mz2) - w(z); - return spi2 * std::complex(-imag(res), real(res)); - } - else { // y < 0 - if (y > -5e-3) { // duplicate from above to avoid fabs(x) call - if (fabs(x) < 5e-3) - goto taylor; - else if (fabs(mIm_z2) < 5e-3) - goto taylor_realaxis; - } - else if (std::isnan(y)) - return std::complex(x == 0 ? 0 : std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN()); - std::complex res = w(-z) - exp(mz2); - return spi2 * std::complex(-imag(res), real(res)); - } - - // Use Taylor series for small |z|, to avoid cancellation inaccuracy - // dawson(z) = z - 2/3 z^3 + 4/15 z^5 + ... - taylor: - return z * (1. - + mz2 * (0.6666666666666666666666666666666666666667 - + mz2 * 0.2666666666666666666666666666666666666667)); - - /* for small |y| and small |xy|, - use Taylor series to avoid cancellation inaccuracy: - dawson(x + iy) - = D + y^2 (D + x - 2Dx^2) - + y^4 (D/2 + 5x/6 - 2Dx^2 - x^3/3 + 2Dx^4/3) - + iy [ (1-2Dx) + 2/3 y^2 (1 - 3Dx - x^2 + 2Dx^3) - + y^4/15 (4 - 15Dx - 9x^2 + 20Dx^3 + 2x^4 - 4Dx^5) ] + ... - where D = dawson(x) - - However, for large |x|, 2Dx -> 1 which gives cancellation problems in - this series (many of the leading terms cancel). So, for large |x|, - we need to substitute a continued-fraction expansion for D. - - dawson(x) = 0.5 / (x-0.5/(x-1/(x-1.5/(x-2/(x-2.5/(x...)))))) - - The 6 terms shown here seems to be the minimum needed to be - accurate as soon as the simpler Taylor expansion above starts - breaking down. Using this 6-term expansion, factoring out the - denominator, and simplifying with Maple, we obtain: - - Re dawson(x + iy) * (-15 + 90x^2 - 60x^4 + 8x^6) / x - = 33 - 28x^2 + 4x^4 + y^2 (18 - 4x^2) + 4 y^4 - Im dawson(x + iy) * (-15 + 90x^2 - 60x^4 + 8x^6) / y - = -15 + 24x^2 - 4x^4 + 2/3 y^2 (6x^2 - 15) - 4 y^4 - - Finally, for |x| > 5e7, we can use a simpler 1-term continued-fraction - expansion for the real part, and a 2-term expansion for the imaginary - part. (This avoids overflow problems for huge |x|.) This yields: - - Re dawson(x + iy) = [1 + y^2 (1 + y^2/2 - (xy)^2/3)] / (2x) - Im dawson(x + iy) = y [ -1 - 2/3 y^2 + y^4/15 (2x^2 - 4) ] / (2x^2 - 1) +std::complex Dawson(std::complex z, double relerr) { + const double spi2 = 0.8862269254527580136490837416705725913990; // sqrt(pi)/2 + double x = real(z), y = imag(z); + + // handle axes separately for speed & proper handling of x or y = Inf or NaN + if (y == 0) + return std::complex(spi2 * w_im(x), + -y); // preserve sign of 0 + if (x == 0) { + double y2 = y * y; + if (y2 < 2.5e-5) { // Taylor expansion + return std::complex( + x, // preserve sign of 0 + y * (1. + y2 * (0.6666666666666666666666666666666666666667 + + y2 * 0.2666666666666666666666666666666666666667)) + ); + } + return std::complex( + x, // preserve sign of 0 + spi2 * (y >= 0 ? exp(y2) - erfcx(y) : erfcx(-y) - exp(y2)) + ); + } + + double mRe_z2 = (y - x) * (x + y); // Re(-z^2), being careful of overflow + double mIm_z2 = -2 * x * y; // Im(-z^2) + std::complex mz2(mRe_z2, mIm_z2); // -z^2 - */ - taylor_realaxis: - { - double x2 = x*x; + /* Handle positive and negative x via different formulas, + using the mirror symmetries of w, to avoid overflow/underflow + problems from multiplying exponentially large and small quantities. */ + if (y >= 0) { + if (y < 5e-3) { + if (fabs(x) < 5e-3) + goto taylor; + else if (fabs(mIm_z2) < 5e-3) + goto taylor_realaxis; + } + std::complex res = exp(mz2) - w(z); + return spi2 * std::complex(-imag(res), real(res)); + } else { // y < 0 + if (y > -5e-3) { // duplicate from above to avoid fabs(x) call + if (fabs(x) < 5e-3) + goto taylor; + else if (fabs(mIm_z2) < 5e-3) + goto taylor_realaxis; + } else if (std::isnan(y)) + return std::complex( + x == 0 ? 0 : std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN() + ); + std::complex res = w(-z) - exp(mz2); + return spi2 * std::complex(-imag(res), real(res)); + } + + // Use Taylor series for small |z|, to avoid cancellation inaccuracy + // dawson(z) = z - 2/3 z^3 + 4/15 z^5 + ... +taylor: + return z * + (1. + mz2 * (0.6666666666666666666666666666666666666667 + mz2 * 0.2666666666666666666666666666666666666667)); + + /* for small |y| and small |xy|, + use Taylor series to avoid cancellation inaccuracy: + dawson(x + iy) + = D + y^2 (D + x - 2Dx^2) + + y^4 (D/2 + 5x/6 - 2Dx^2 - x^3/3 + 2Dx^4/3) + + iy [ (1-2Dx) + 2/3 y^2 (1 - 3Dx - x^2 + 2Dx^3) + + y^4/15 (4 - 15Dx - 9x^2 + 20Dx^3 + 2x^4 - 4Dx^5) ] + ... + where D = dawson(x) + + However, for large |x|, 2Dx -> 1 which gives cancellation problems in + this series (many of the leading terms cancel). So, for large |x|, + we need to substitute a continued-fraction expansion for D. + + dawson(x) = 0.5 / (x-0.5/(x-1/(x-1.5/(x-2/(x-2.5/(x...)))))) + + The 6 terms shown here seems to be the minimum needed to be + accurate as soon as the simpler Taylor expansion above starts + breaking down. Using this 6-term expansion, factoring out the + denominator, and simplifying with Maple, we obtain: + + Re dawson(x + iy) * (-15 + 90x^2 - 60x^4 + 8x^6) / x + = 33 - 28x^2 + 4x^4 + y^2 (18 - 4x^2) + 4 y^4 + Im dawson(x + iy) * (-15 + 90x^2 - 60x^4 + 8x^6) / y + = -15 + 24x^2 - 4x^4 + 2/3 y^2 (6x^2 - 15) - 4 y^4 + + Finally, for |x| > 5e7, we can use a simpler 1-term continued-fraction + expansion for the real part, and a 2-term expansion for the imaginary + part. (This avoids overflow problems for huge |x|.) This yields: + + Re dawson(x + iy) = [1 + y^2 (1 + y^2/2 - (xy)^2/3)] / (2x) + Im dawson(x + iy) = y [ -1 - 2/3 y^2 + y^4/15 (2x^2 - 4) ] / (2x^2 - 1) + + */ +taylor_realaxis: { + double x2 = x * x; if (x2 > 1600) { // |x| > 40 - double y2 = y*y; - if (x2 > 25e14) {// |x| > 5e7 - double xy2 = (x*y)*(x*y); - return std::complex((0.5 + y2 * (0.5 + 0.25*y2 - - 0.16666666666666666667*xy2)) / x, - y * (-1 + y2 * (-0.66666666666666666667 - + 0.13333333333333333333*xy2 - - 0.26666666666666666667*y2)) - / (2*x2 - 1)); - } - return (1. / (-15 + x2*(90 + x2*(-60 + 8*x2)))) * - std::complex(x * (33 + x2 * (-28 + 4*x2) - + y2 * (18 - 4*x2 + 4*y2)), - y * (-15 + x2 * (24 - 4*x2) - + y2 * (4*x2 - 10 - 4*y2))); - } - else { - double D = spi2 * w_im(x); - double x2 = x*x, y2 = y*y; - return std::complex - (D + y2 * (D + x - 2*D*x2) - + y2*y2 * (D * (0.5 - x2 * (2 - 0.66666666666666666667*x2)) - + x * (0.83333333333333333333 - - 0.33333333333333333333 * x2)), - y * (1 - 2*D*x - + y2 * 0.66666666666666666667 * (1 - x2 - D*x * (3 - 2*x2)) - + y2*y2 * (0.26666666666666666667 - - x2 * (0.6 - 0.13333333333333333333 * x2) - - D*x * (1 - x2 * (1.3333333333333333333 - - 0.26666666666666666667 * x2))))); - } - } -} - -// return sinc(x) = sin(x)/x, given both x and sin(x) + double y2 = y * y; + if (x2 > 25e14) { // |x| > 5e7 + double xy2 = (x * y) * (x * y); + return std::complex( + (0.5 + y2 * (0.5 + 0.25 * y2 - 0.16666666666666666667 * xy2)) / x, + y * (-1 + y2 * (-0.66666666666666666667 + 0.13333333333333333333 * xy2 - 0.26666666666666666667 * y2)) / + (2 * x2 - 1) + ); + } + return (1. / (-15 + x2 * (90 + x2 * (-60 + 8 * x2)))) * + std::complex( + x * (33 + x2 * (-28 + 4 * x2) + y2 * (18 - 4 * x2 + 4 * y2)), + y * (-15 + x2 * (24 - 4 * x2) + y2 * (4 * x2 - 10 - 4 * y2)) + ); + } else { + double D = spi2 * w_im(x); + double x2 = x * x, y2 = y * y; + return std::complex( + D + y2 * (D + x - 2 * D * x2) + + y2 * y2 * + (D * (0.5 - x2 * (2 - 0.66666666666666666667 * x2)) + + x * (0.83333333333333333333 - 0.33333333333333333333 * x2)), + y * (1 - 2 * D * x + y2 * 0.66666666666666666667 * (1 - x2 - D * x * (3 - 2 * x2)) + + y2 * y2 * + (0.26666666666666666667 - x2 * (0.6 - 0.13333333333333333333 * x2) - + D * x * (1 - x2 * (1.3333333333333333333 - 0.26666666666666666667 * x2)))) + ); + } +} +} + +// return sinc(x) = sin(x)/x, given both x and sin(x) // [since we only use this in cases where sin(x) has already been computed] -inline double sinc(double x, double sinx) { - return fabs(x) < 1e-4 ? 1 - (0.1666666666666666666667)*x*x : sinx / x; -} +inline double sinc(double x, double sinx) { return fabs(x) < 1e-4 ? 1 - (0.1666666666666666666667) * x * x : sinx / x; } // sinh(x) via Taylor series, accurate to machine precision for |x| < 1e-2 inline double sinh_taylor(double x) { - return x * (1 + (x*x) * (0.1666666666666666666667 - + 0.00833333333333333333333 * (x*x))); + return x * (1 + (x * x) * (0.1666666666666666666667 + 0.00833333333333333333333 * (x * x))); } -inline double sqr(double x) { return x*x; } +inline double sqr(double x) { return x * x; } ///////////////////////////////////////////////////////////////////////// // precomputed table of expa2n2[n-1] = exp(-a2*n*n) // for double-precision a2 = 0.26865... in Faddeeva::w, below. static const double expa2n2[] = { - 7.64405281671221563e-01, - 3.41424527166548425e-01, - 8.91072646929412548e-02, - 1.35887299055460086e-02, - 1.21085455253437481e-03, - 6.30452613933449404e-05, - 1.91805156577114683e-06, - 3.40969447714832381e-08, - 3.54175089099469393e-10, - 2.14965079583260682e-12, - 7.62368911833724354e-15, - 1.57982797110681093e-17, - 1.91294189103582677e-20, - 1.35344656764205340e-23, - 5.59535712428588720e-27, - 1.35164257972401769e-30, - 1.90784582843501167e-34, - 1.57351920291442930e-38, - 7.58312432328032845e-43, - 2.13536275438697082e-47, - 3.51352063787195769e-52, - 3.37800830266396920e-57, - 1.89769439468301000e-62, - 6.22929926072668851e-68, - 1.19481172006938722e-73, - 1.33908181133005953e-79, - 8.76924303483223939e-86, - 3.35555576166254986e-92, - 7.50264110688173024e-99, - 9.80192200745410268e-106, - 7.48265412822268959e-113, - 3.33770122566809425e-120, - 8.69934598159861140e-128, - 1.32486951484088852e-135, - 1.17898144201315253e-143, - 6.13039120236180012e-152, - 1.86258785950822098e-160, - 3.30668408201432783e-169, - 3.43017280887946235e-178, - 2.07915397775808219e-187, - 7.36384545323984966e-197, - 1.52394760394085741e-206, - 1.84281935046532100e-216, - 1.30209553802992923e-226, - 5.37588903521080531e-237, - 1.29689584599763145e-247, - 1.82813078022866562e-258, - 1.50576355348684241e-269, - 7.24692320799294194e-281, - 2.03797051314726829e-292, - 3.34880215927873807e-304, - 0.0 // underflow (also prevents reads past array end, below) + 7.64405281671221563e-01, + 3.41424527166548425e-01, + 8.91072646929412548e-02, + 1.35887299055460086e-02, + 1.21085455253437481e-03, + 6.30452613933449404e-05, + 1.91805156577114683e-06, + 3.40969447714832381e-08, + 3.54175089099469393e-10, + 2.14965079583260682e-12, + 7.62368911833724354e-15, + 1.57982797110681093e-17, + 1.91294189103582677e-20, + 1.35344656764205340e-23, + 5.59535712428588720e-27, + 1.35164257972401769e-30, + 1.90784582843501167e-34, + 1.57351920291442930e-38, + 7.58312432328032845e-43, + 2.13536275438697082e-47, + 3.51352063787195769e-52, + 3.37800830266396920e-57, + 1.89769439468301000e-62, + 6.22929926072668851e-68, + 1.19481172006938722e-73, + 1.33908181133005953e-79, + 8.76924303483223939e-86, + 3.35555576166254986e-92, + 7.50264110688173024e-99, + 9.80192200745410268e-106, + 7.48265412822268959e-113, + 3.33770122566809425e-120, + 8.69934598159861140e-128, + 1.32486951484088852e-135, + 1.17898144201315253e-143, + 6.13039120236180012e-152, + 1.86258785950822098e-160, + 3.30668408201432783e-169, + 3.43017280887946235e-178, + 2.07915397775808219e-187, + 7.36384545323984966e-197, + 1.52394760394085741e-206, + 1.84281935046532100e-216, + 1.30209553802992923e-226, + 5.37588903521080531e-237, + 1.29689584599763145e-247, + 1.82813078022866562e-258, + 1.50576355348684241e-269, + 7.24692320799294194e-281, + 2.03797051314726829e-292, + 3.34880215927873807e-304, + 0.0 // underflow (also prevents reads past array end, below) }; - - ///////////////////////////////////////////////////////////////////////// -std::complex w(std::complex z, double relerr) -{ - if (real(z) == 0.0) - return std::complex(erfcx(imag(z)), - real(z)); // give correct sign of 0 in imag(w) - else if (imag(z) == 0) - return std::complex(exp(-sqr(real(z))), - w_im(real(z))); - - double a, a2, c; - if (relerr <= DBL_EPSILON) { - relerr = DBL_EPSILON; - a = 0.518321480430085929872; // pi / sqrt(-log(eps*0.5)) - c = 0.329973702884629072537; // (2/pi) * a; - a2 = 0.268657157075235951582; // a^2 - } - else { - const double pi = 3.14159265358979323846264338327950288419716939937510582; - if (relerr > 0.1) relerr = 0.1; // not sensible to compute < 1 digit - a = pi / sqrt(-log(relerr*0.5)); - c = (2/pi)*a; - a2 = a*a; - } - const double x = fabs(real(z)); - const double y = imag(z), ya = fabs(y); - - std::complex ret(0.,0.); // return value - - double sum1 = 0, sum2 = 0, sum3 = 0, sum4 = 0, sum5 = 0; +std::complex w(std::complex z, double relerr) { + if (real(z) == 0.0) + return std::complex(erfcx(imag(z)), + real(z)); // give correct sign of 0 in imag(w) + else if (imag(z) == 0) + return std::complex(exp(-sqr(real(z))), w_im(real(z))); + + double a, a2, c; + if (relerr <= DBL_EPSILON) { + relerr = DBL_EPSILON; + a = 0.518321480430085929872; // pi / sqrt(-log(eps*0.5)) + c = 0.329973702884629072537; // (2/pi) * a; + a2 = 0.268657157075235951582; // a^2 + } else { + const double pi = 3.14159265358979323846264338327950288419716939937510582; + if (relerr > 0.1) + relerr = 0.1; // not sensible to compute < 1 digit + a = pi / sqrt(-log(relerr * 0.5)); + c = (2 / pi) * a; + a2 = a * a; + } + const double x = fabs(real(z)); + const double y = imag(z), ya = fabs(y); + + std::complex ret(0., 0.); // return value + + double sum1 = 0, sum2 = 0, sum3 = 0, sum4 = 0, sum5 = 0; #define USE_CONTINUED_FRACTION 1 // 1 to use continued fraction for large |z| #if USE_CONTINUED_FRACTION - if (ya > 7 || (x > 6 // continued fraction is faster - /* As pointed out by M. Zaghloul, the continued - fraction seems to give a large relative error in - Re w(z) for |x| ~ 6 and small |y|, so use - algorithm 816 in this region: */ - && (ya > 0.1 || (x > 8 && ya > 1e-10) || x > 28))) { - - /* Poppe & Wijers suggest using a number of terms - nu = 3 + 1442 / (26*rho + 77) - where rho = sqrt((x/x0)^2 + (y/y0)^2) where x0=6.3, y0=4.4. - (They only use this expansion for rho >= 1, but rho a little less - than 1 seems okay too.) - Instead, I did my own fit to a slightly different function - that avoids the hypotenuse calculation, using NLopt to minimize - the sum of the squares of the errors in nu with the constraint - that the estimated nu be >= minimum nu to attain machine precision. - I also separate the regions where nu == 2 and nu == 1. */ - const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi) - double xs = y < 0 ? -real(z) : real(z); // compute for -z if y < 0 - if (x + ya > 4000) { // nu <= 2 - if (x + ya > 1e7) { // nu == 1, w(z) = i/sqrt(pi) / z - // scale to avoid overflow - if (x > ya) { - double yax = ya / xs; - double denom = ispi / (xs + yax*ya); - ret = std::complex(denom*yax, denom); - } - else if (std::isinf(ya)) - return ((std::isnan(x) || y < 0) - ? std::complex(std::numeric_limits::quiet_NaN(),std::numeric_limits::quiet_NaN()) : std::complex(0,0)); - else { - double xya = xs / ya; - double denom = ispi / (xya*xs + ya); - ret = std::complex(denom, denom*xya); - } - } - else { // nu == 2, w(z) = i/sqrt(pi) * z / (z*z - 0.5) - double dr = xs*xs - ya*ya - 0.5, di = 2*xs*ya; - double denom = ispi / (dr*dr + di*di); - ret = std::complex(denom * (xs*di-ya*dr), denom * (xs*dr+ya*di)); - } - } - else { // compute nu(z) estimate and do general continued fraction - const double c0=3.9, c1=11.398, c2=0.08254, c3=0.1421, c4=0.2023; // fit - double nu = floor(c0 + c1 / (c2*x + c3*ya + c4)); - double wr = xs, wi = ya; - for (nu = 0.5 * (nu - 1); nu > 0.4; nu -= 0.5) { - // w <- z - nu/w: - double denom = nu / (wr*wr + wi*wi); - wr = xs - wr * denom; - wi = ya + wi * denom; - } - { // w(z) = i/sqrt(pi) / w: - double denom = ispi / (wr*wr + wi*wi); - ret = std::complex(denom*wi, denom*wr); - } - } - if (y < 0) { - // use w(z) = 2.0*exp(-z*z) - w(-z), - // but be careful of overflow in exp(-z*z) - // = exp(-(xs*xs-ya*ya) -2*i*xs*ya) - return 2.0*exp(std::complex((ya-xs)*(xs+ya), 2*xs*y)) - ret; - } - else - return ret; - } -#else // !USE_CONTINUED_FRACTION - if (x + ya > 1e7) { // w(z) = i/sqrt(pi) / z, to machine precision - const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi) - double xs = y < 0 ? -real(z) : real(z); // compute for -z if y < 0 - // scale to avoid overflow - if (x > ya) { - double yax = ya / xs; - double denom = ispi / (xs + yax*ya); - ret = std::complex(denom*yax, denom); - } - else { - double xya = xs / ya; - double denom = ispi / (xya*xs + ya); - ret = std::complex(denom, denom*xya); - } - if (y < 0) { - // use w(z) = 2.0*exp(-z*z) - w(-z), - // but be careful of overflow in exp(-z*z) - // = exp(-(xs*xs-ya*ya) -2*i*xs*ya) - return 2.0*exp(std::complex((ya-xs)*(xs+ya), 2*xs*y)) - ret; - } - else - return ret; - } -#endif // !USE_CONTINUED_FRACTION - - /* Note: The test that seems to be suggested in the paper is x < - sqrt(-log(DBL_MIN)), about 26.6, since otherwise exp(-x^2) - underflows to zero and sum1,sum2,sum4 are zero. However, long - before this occurs, the sum1,sum2,sum4 contributions are - negligible in double precision; I find that this happens for x > - about 6, for all y. On the other hand, I find that the case - where we compute all of the sums is faster (at least with the - precomputed expa2n2 table) until about x=10. Furthermore, if we - try to compute all of the sums for x > 20, I find that we - sometimes run into numerical problems because underflow/overflow - problems start to appear in the various coefficients of the sums, - below. Therefore, we use x < 10 here. */ - else if (x < 10) { - double prod2ax = 1, prodm2ax = 1; - double expx2; - - if (std::isnan(y)) - return std::complex(y,y); - - /* Somewhat ugly copy-and-paste duplication here, but I see significant - speedups from using the special-case code with the precomputed - exponential, and the x < 5e-4 special case is needed for accuracy. */ - - if (relerr == DBL_EPSILON) { // use precomputed exp(-a2*(n*n)) table - if (x < 5e-4) { // compute sum4 and sum5 together as sum5-sum4 - const double x2 = x*x; - expx2 = 1 - x2 * (1 - 0.5*x2); // exp(-x*x) via Taylor - // compute exp(2*a*x) and exp(-2*a*x) via Taylor, to double precision - const double ax2 = 1.036642960860171859744*x; // 2*a*x - const double exp2ax = - 1 + ax2 * (1 + ax2 * (0.5 + 0.166666666666666666667*ax2)); - const double expm2ax = - 1 - ax2 * (1 - ax2 * (0.5 - 0.166666666666666666667*ax2)); - for (int n = 1; 1; ++n) { - const double coef = expa2n2[n-1] * expx2 / (a2*(n*n) + y*y); - prod2ax *= exp2ax; - prodm2ax *= expm2ax; - sum1 += coef; - sum2 += coef * prodm2ax; - sum3 += coef * prod2ax; - - // really = sum5 - sum4 - sum5 += coef * (2*a) * n * sinh_taylor((2*a)*n*x); - - // test convergence via sum3 - if (coef * prod2ax < relerr * sum3) break; - } - } - else { // x > 5e-4, compute sum4 and sum5 separately - expx2 = exp(-x*x); - const double exp2ax = exp((2*a)*x), expm2ax = 1 / exp2ax; - for (int n = 1; 1; ++n) { - const double coef = expa2n2[n-1] * expx2 / (a2*(n*n) + y*y); - prod2ax *= exp2ax; - prodm2ax *= expm2ax; - sum1 += coef; - sum2 += coef * prodm2ax; - sum4 += (coef * prodm2ax) * (a*n); - sum3 += coef * prod2ax; - sum5 += (coef * prod2ax) * (a*n); - // test convergence via sum5, since this sum has the slowest decay - if ((coef * prod2ax) * (a*n) < relerr * sum5) break; - } - } - } - else { // relerr != DBL_EPSILON, compute exp(-a2*(n*n)) on the fly - const double exp2ax = exp((2*a)*x), expm2ax = 1 / exp2ax; - if (x < 5e-4) { // compute sum4 and sum5 together as sum5-sum4 - const double x2 = x*x; - expx2 = 1 - x2 * (1 - 0.5*x2); // exp(-x*x) via Taylor - for (int n = 1; 1; ++n) { - const double coef = exp(-a2*(n*n)) * expx2 / (a2*(n*n) + y*y); - prod2ax *= exp2ax; - prodm2ax *= expm2ax; - sum1 += coef; - sum2 += coef * prodm2ax; - sum3 += coef * prod2ax; - - // really = sum5 - sum4 - sum5 += coef * (2*a) * n * sinh_taylor((2*a)*n*x); - - // test convergence via sum3 - if (coef * prod2ax < relerr * sum3) break; - } - } - else { // x > 5e-4, compute sum4 and sum5 separately - expx2 = exp(-x*x); - for (int n = 1; 1; ++n) { - const double coef = exp(-a2*(n*n)) * expx2 / (a2*(n*n) + y*y); - prod2ax *= exp2ax; - prodm2ax *= expm2ax; - sum1 += coef; - sum2 += coef * prodm2ax; - sum4 += (coef * prodm2ax) * (a*n); - sum3 += coef * prod2ax; - sum5 += (coef * prod2ax) * (a*n); - // test convergence via sum5, since this sum has the slowest decay - if ((coef * prod2ax) * (a*n) < relerr * sum5) break; - } - } - } - const double expx2erfcxy = // avoid spurious overflow for large negative y - y > -6 // for y < -6, erfcx(y) = 2*exp(y*y) to double precision - ? expx2*erfcx(y) : 2*exp(y*y-x*x); - if (y > 5) { // imaginary terms cancel - const double sinxy = sin(x*y); - ret = (expx2erfcxy - c*y*sum1) * cos(2*x*y) - + (c*x*expx2) * sinxy * sinc(x*y, sinxy); - } - else { - double xs = real(z); - const double sinxy = sin(xs*y); - const double sin2xy = sin(2*xs*y), cos2xy = cos(2*xs*y); - const double coef1 = expx2erfcxy - c*y*sum1; - const double coef2 = c*xs*expx2; - ret = std::complex(coef1 * cos2xy + coef2 * sinxy * sinc(xs*y, sinxy), - coef2 * sinc(2*xs*y, sin2xy) - coef1 * sin2xy); - } - } - else { // x large: only sum3 & sum5 contribute (see above note) - if (std::isnan(x)) - return std::complex(x,x); - if (std::isnan(y)) - return std::complex(y,y); + if (ya > 7 || (x > 6 // continued fraction is faster + /* As pointed out by M. Zaghloul, the continued + fraction seems to give a large relative error in + Re w(z) for |x| ~ 6 and small |y|, so use + algorithm 816 in this region: */ + && (ya > 0.1 || (x > 8 && ya > 1e-10) || x > 28))) { + + /* Poppe & Wijers suggest using a number of terms + nu = 3 + 1442 / (26*rho + 77) + where rho = sqrt((x/x0)^2 + (y/y0)^2) where x0=6.3, y0=4.4. + (They only use this expansion for rho >= 1, but rho a little less + than 1 seems okay too.) + Instead, I did my own fit to a slightly different function + that avoids the hypotenuse calculation, using NLopt to minimize + the sum of the squares of the errors in nu with the constraint + that the estimated nu be >= minimum nu to attain machine precision. + I also separate the regions where nu == 2 and nu == 1. */ + const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi) + double xs = y < 0 ? -real(z) : real(z); // compute for -z if y < 0 + if (x + ya > 4000) { // nu <= 2 + if (x + ya > 1e7) { // nu == 1, w(z) = i/sqrt(pi) / z + // scale to avoid overflow + if (x > ya) { + double yax = ya / xs; + double denom = ispi / (xs + yax * ya); + ret = std::complex(denom * yax, denom); + } else if (std::isinf(ya)) + return ( + (std::isnan(x) || y < 0) + ? std::complex( + std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN() + ) + : std::complex(0, 0) + ); + else { + double xya = xs / ya; + double denom = ispi / (xya * xs + ya); + ret = std::complex(denom, denom * xya); + } + } else { // nu == 2, w(z) = i/sqrt(pi) * z / (z*z - 0.5) + double dr = xs * xs - ya * ya - 0.5, di = 2 * xs * ya; + double denom = ispi / (dr * dr + di * di); + ret = std::complex(denom * (xs * di - ya * dr), denom * (xs * dr + ya * di)); + } + } else { // compute nu(z) estimate and do general continued fraction + const double c0 = 3.9, c1 = 11.398, c2 = 0.08254, c3 = 0.1421, c4 = 0.2023; // fit + double nu = floor(c0 + c1 / (c2 * x + c3 * ya + c4)); + double wr = xs, wi = ya; + for (nu = 0.5 * (nu - 1); nu > 0.4; nu -= 0.5) { + // w <- z - nu/w: + double denom = nu / (wr * wr + wi * wi); + wr = xs - wr * denom; + wi = ya + wi * denom; + } + { // w(z) = i/sqrt(pi) / w: + double denom = ispi / (wr * wr + wi * wi); + ret = std::complex(denom * wi, denom * wr); + } + } + if (y < 0) { + // use w(z) = 2.0*exp(-z*z) - w(-z), + // but be careful of overflow in exp(-z*z) + // = exp(-(xs*xs-ya*ya) -2*i*xs*ya) + return 2.0 * exp(std::complex((ya - xs) * (xs + ya), 2 * xs * y)) - ret; + } else + return ret; + } +#else // !USE_CONTINUED_FRACTION + if (x + ya > 1e7) { // w(z) = i/sqrt(pi) / z, to machine precision + const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi) + double xs = y < 0 ? -real(z) : real(z); // compute for -z if y < 0 + // scale to avoid overflow + if (x > ya) { + double yax = ya / xs; + double denom = ispi / (xs + yax * ya); + ret = std::complex(denom * yax, denom); + } else { + double xya = xs / ya; + double denom = ispi / (xya * xs + ya); + ret = std::complex(denom, denom * xya); + } + if (y < 0) { + // use w(z) = 2.0*exp(-z*z) - w(-z), + // but be careful of overflow in exp(-z*z) + // = exp(-(xs*xs-ya*ya) -2*i*xs*ya) + return 2.0 * exp(std::complex((ya - xs) * (xs + ya), 2 * xs * y)) - ret; + } else + return ret; + } +#endif // !USE_CONTINUED_FRACTION + + /* Note: The test that seems to be suggested in the paper is x < + sqrt(-log(DBL_MIN)), about 26.6, since otherwise exp(-x^2) + underflows to zero and sum1,sum2,sum4 are zero. However, long + before this occurs, the sum1,sum2,sum4 contributions are + negligible in double precision; I find that this happens for x > + about 6, for all y. On the other hand, I find that the case + where we compute all of the sums is faster (at least with the + precomputed expa2n2 table) until about x=10. Furthermore, if we + try to compute all of the sums for x > 20, I find that we + sometimes run into numerical problems because underflow/overflow + problems start to appear in the various coefficients of the sums, + below. Therefore, we use x < 10 here. */ + else if (x < 10) { + double prod2ax = 1, prodm2ax = 1; + double expx2; + + if (std::isnan(y)) + return std::complex(y, y); + + /* Somewhat ugly copy-and-paste duplication here, but I see significant + speedups from using the special-case code with the precomputed + exponential, and the x < 5e-4 special case is needed for accuracy. */ + + if (relerr == DBL_EPSILON) { // use precomputed exp(-a2*(n*n)) table + if (x < 5e-4) { // compute sum4 and sum5 together as sum5-sum4 + const double x2 = x * x; + expx2 = 1 - x2 * (1 - 0.5 * x2); // exp(-x*x) via Taylor + // compute exp(2*a*x) and exp(-2*a*x) via Taylor, to double precision + const double ax2 = 1.036642960860171859744 * x; // 2*a*x + const double exp2ax = 1 + ax2 * (1 + ax2 * (0.5 + 0.166666666666666666667 * ax2)); + const double expm2ax = 1 - ax2 * (1 - ax2 * (0.5 - 0.166666666666666666667 * ax2)); + for (int n = 1; 1; ++n) { + const double coef = expa2n2[n - 1] * expx2 / (a2 * (n * n) + y * y); + prod2ax *= exp2ax; + prodm2ax *= expm2ax; + sum1 += coef; + sum2 += coef * prodm2ax; + sum3 += coef * prod2ax; + + // really = sum5 - sum4 + sum5 += coef * (2 * a) * n * sinh_taylor((2 * a) * n * x); + + // test convergence via sum3 + if (coef * prod2ax < relerr * sum3) + break; + } + } else { // x > 5e-4, compute sum4 and sum5 separately + expx2 = exp(-x * x); + const double exp2ax = exp((2 * a) * x), expm2ax = 1 / exp2ax; + for (int n = 1; 1; ++n) { + const double coef = expa2n2[n - 1] * expx2 / (a2 * (n * n) + y * y); + prod2ax *= exp2ax; + prodm2ax *= expm2ax; + sum1 += coef; + sum2 += coef * prodm2ax; + sum4 += (coef * prodm2ax) * (a * n); + sum3 += coef * prod2ax; + sum5 += (coef * prod2ax) * (a * n); + // test convergence via sum5, since this sum has the slowest decay + if ((coef * prod2ax) * (a * n) < relerr * sum5) + break; + } + } + } else { // relerr != DBL_EPSILON, compute exp(-a2*(n*n)) on the fly + const double exp2ax = exp((2 * a) * x), expm2ax = 1 / exp2ax; + if (x < 5e-4) { // compute sum4 and sum5 together as sum5-sum4 + const double x2 = x * x; + expx2 = 1 - x2 * (1 - 0.5 * x2); // exp(-x*x) via Taylor + for (int n = 1; 1; ++n) { + const double coef = exp(-a2 * (n * n)) * expx2 / (a2 * (n * n) + y * y); + prod2ax *= exp2ax; + prodm2ax *= expm2ax; + sum1 += coef; + sum2 += coef * prodm2ax; + sum3 += coef * prod2ax; + + // really = sum5 - sum4 + sum5 += coef * (2 * a) * n * sinh_taylor((2 * a) * n * x); + + // test convergence via sum3 + if (coef * prod2ax < relerr * sum3) + break; + } + } else { // x > 5e-4, compute sum4 and sum5 separately + expx2 = exp(-x * x); + for (int n = 1; 1; ++n) { + const double coef = exp(-a2 * (n * n)) * expx2 / (a2 * (n * n) + y * y); + prod2ax *= exp2ax; + prodm2ax *= expm2ax; + sum1 += coef; + sum2 += coef * prodm2ax; + sum4 += (coef * prodm2ax) * (a * n); + sum3 += coef * prod2ax; + sum5 += (coef * prod2ax) * (a * n); + // test convergence via sum5, since this sum has the slowest decay + if ((coef * prod2ax) * (a * n) < relerr * sum5) + break; + } + } + } + const double expx2erfcxy = // avoid spurious overflow for large negative y + y > -6 // for y < -6, erfcx(y) = 2*exp(y*y) to double precision + ? expx2 * erfcx(y) + : 2 * exp(y * y - x * x); + if (y > 5) { // imaginary terms cancel + const double sinxy = sin(x * y); + ret = (expx2erfcxy - c * y * sum1) * cos(2 * x * y) + (c * x * expx2) * sinxy * sinc(x * y, sinxy); + } else { + double xs = real(z); + const double sinxy = sin(xs * y); + const double sin2xy = sin(2 * xs * y), cos2xy = cos(2 * xs * y); + const double coef1 = expx2erfcxy - c * y * sum1; + const double coef2 = c * xs * expx2; + ret = std::complex( + coef1 * cos2xy + coef2 * sinxy * sinc(xs * y, sinxy), coef2 * sinc(2 * xs * y, sin2xy) - coef1 * sin2xy + ); + } + } else { // x large: only sum3 & sum5 contribute (see above note) + if (std::isnan(x)) + return std::complex(x, x); + if (std::isnan(y)) + return std::complex(y, y); #if USE_CONTINUED_FRACTION - ret = exp(-x*x); // |y| < 1e-10, so we only need exp(-x*x) term + ret = exp(-x * x); // |y| < 1e-10, so we only need exp(-x*x) term #else - if (y < 0) { - /* erfcx(y) ~ 2*exp(y*y) + (< 1) if y < 0, so - erfcx(y)*exp(-x*x) ~ 2*exp(y*y-x*x) term may not be negligible - if y*y - x*x > -36 or so. So, compute this term just in case. - We also need the -exp(-x*x) term to compute Re[w] accurately - in the case where y is very small. */ - ret = polar(2*exp(y*y-x*x) - exp(-x*x), -2*real(z)*y); - } - else - ret = exp(-x*x); // not negligible in real part if y very small + if (y < 0) { + /* erfcx(y) ~ 2*exp(y*y) + (< 1) if y < 0, so + erfcx(y)*exp(-x*x) ~ 2*exp(y*y-x*x) term may not be negligible + if y*y - x*x > -36 or so. So, compute this term just in case. + We also need the -exp(-x*x) term to compute Re[w] accurately + in the case where y is very small. */ + ret = polar(2 * exp(y * y - x * x) - exp(-x * x), -2 * real(z) * y); + } else + ret = exp(-x * x); // not negligible in real part if y very small #endif - // (round instead of ceil as in original paper; note that x/a > 1 here) - double n0 = floor(x/a + 0.5); // sum in both directions, starting at n0 - double dx = a*n0 - x; - sum3 = exp(-dx*dx) / (a2*(n0*n0) + y*y); - sum5 = a*n0 * sum3; - double exp1 = exp(4*a*dx), exp1dn = 1; - int dn; - for (dn = 1; n0 - dn > 0; ++dn) { // loop over n0-dn and n0+dn terms - double np = n0 + dn, nm = n0 - dn; - double tp = exp(-sqr(a*dn+dx)); - double tm = tp * (exp1dn *= exp1); // trick to get tm from tp - tp /= (a2*(np*np) + y*y); - tm /= (a2*(nm*nm) + y*y); - sum3 += tp + tm; - sum5 += a * (np * tp + nm * tm); - if (a * (np * tp + nm * tm) < relerr * sum5) goto finish; - } - while (1) { // loop over n0+dn terms only (since n0-dn <= 0) - double np = n0 + dn++; - double tp = exp(-sqr(a*dn+dx)) / (a2*(np*np) + y*y); - sum3 += tp; - sum5 += a * np * tp; - if (a * np * tp < relerr * sum5) goto finish; - } - } - finish: - return ret + std::complex((0.5*c)*y*(sum2+sum3), - (0.5*c)*std::copysign(sum5-sum4, real(z))); + // (round instead of ceil as in original paper; note that x/a > 1 here) + double n0 = floor(x / a + 0.5); // sum in both directions, starting at n0 + double dx = a * n0 - x; + sum3 = exp(-dx * dx) / (a2 * (n0 * n0) + y * y); + sum5 = a * n0 * sum3; + double exp1 = exp(4 * a * dx), exp1dn = 1; + int dn; + for (dn = 1; n0 - dn > 0; ++dn) { // loop over n0-dn and n0+dn terms + double np = n0 + dn, nm = n0 - dn; + double tp = exp(-sqr(a * dn + dx)); + double tm = tp * (exp1dn *= exp1); // trick to get tm from tp + tp /= (a2 * (np * np) + y * y); + tm /= (a2 * (nm * nm) + y * y); + sum3 += tp + tm; + sum5 += a * (np * tp + nm * tm); + if (a * (np * tp + nm * tm) < relerr * sum5) + goto finish; + } + while (1) { // loop over n0+dn terms only (since n0-dn <= 0) + double np = n0 + dn++; + double tp = exp(-sqr(a * dn + dx)) / (a2 * (np * np) + y * y); + sum3 += tp; + sum5 += a * np * tp; + if (a * np * tp < relerr * sum5) + goto finish; + } + } +finish: + return ret + std::complex((0.5 * c) * y * (sum2 + sum3), (0.5 * c) * std::copysign(sum5 - sum4, real(z))); } - ///////////////////////////////////////////////////////////////////////// /* erfcx(x) = exp(x^2) erfc(x) function, for real x, written by @@ -848,14 +807,14 @@ std::complex w(std::complex z, double relerr) a) It maps x to y = 4 / (4+x) in [0,1]. This simple transformation, inspired by a similar transformation in the octave-forge/specfun - erfcx by Soren Hauberg, results in much faster Chebyshev convergence - than other simple transformations I have examined. + erfcx by Soren Hauberg, results in much faster Chebyshev convergence + than other simple transformations I have examined. b) Instead of using a single Chebyshev polynomial for the entire [0,1] y interval, we break the interval up into 100 equal - subintervals, with a switch/lookup table, and use much lower - degree Chebyshev polynomials in each subinterval. This greatly - improves performance in my tests. + subintervals, with a switch/lookup table, and use much lower + degree Chebyshev polynomials in each subinterval. This greatly + improves performance in my tests. For x < 0, we use the relationship erfcx(-x) = 2 exp(x^2) - erfc(x), with the usual checks for overflow etcetera. @@ -872,442 +831,1138 @@ std::complex w(std::complex z, double relerr) with the help of Maple and a little shell script. This allows the Chebyshev polynomials to be of significantly lower degree (about 1/4) compared to fitting the whole [0,1] interval with a single polynomial. */ -double erfcx_y100(double y100) -{ - switch ((int) y100) { -case 0: { -double t = 2*y100 - 1; -return 0.70878032454106438663e-3 + (0.71234091047026302958e-3 + (0.35779077297597742384e-5 + (0.17403143962587937815e-7 + (0.81710660047307788845e-10 + (0.36885022360434957634e-12 + 0.15917038551111111111e-14 * t) * t) * t) * t) * t) * t; -} -case 1: { -double t = 2*y100 - 3; -return 0.21479143208285144230e-2 + (0.72686402367379996033e-3 + (0.36843175430938995552e-5 + (0.18071841272149201685e-7 + (0.85496449296040325555e-10 + (0.38852037518534291510e-12 + 0.16868473576888888889e-14 * t) * t) * t) * t) * t) * t; -} -case 2: { -double t = 2*y100 - 5; -return 0.36165255935630175090e-2 + (0.74182092323555510862e-3 + (0.37948319957528242260e-5 + (0.18771627021793087350e-7 + (0.89484715122415089123e-10 + (0.40935858517772440862e-12 + 0.17872061464888888889e-14 * t) * t) * t) * t) * t) * t; -} -case 3: { -double t = 2*y100 - 7; -return 0.51154983860031979264e-2 + (0.75722840734791660540e-3 + (0.39096425726735703941e-5 + (0.19504168704300468210e-7 + (0.93687503063178993915e-10 + (0.43143925959079664747e-12 + 0.18939926435555555556e-14 * t) * t) * t) * t) * t) * t; -} -case 4: { -double t = 2*y100 - 9; -return 0.66457513172673049824e-2 + (0.77310406054447454920e-3 + (0.40289510589399439385e-5 + (0.20271233238288381092e-7 + (0.98117631321709100264e-10 + (0.45484207406017752971e-12 + 0.20076352213333333333e-14 * t) * t) * t) * t) * t) * t; -} -case 5: { -double t = 2*y100 - 11; -return 0.82082389970241207883e-2 + (0.78946629611881710721e-3 + (0.41529701552622656574e-5 + (0.21074693344544655714e-7 + (0.10278874108587317989e-9 + (0.47965201390613339638e-12 + 0.21285907413333333333e-14 * t) * t) * t) * t) * t) * t; -} -case 6: { -double t = 2*y100 - 13; -return 0.98039537275352193165e-2 + (0.80633440108342840956e-3 + (0.42819241329736982942e-5 + (0.21916534346907168612e-7 + (0.10771535136565470914e-9 + (0.50595972623692822410e-12 + 0.22573462684444444444e-14 * t) * t) * t) * t) * t) * t; -} -case 7: { -double t = 2*y100 - 15; -return 0.11433927298290302370e-1 + (0.82372858383196561209e-3 + (0.44160495311765438816e-5 + (0.22798861426211986056e-7 + (0.11291291745879239736e-9 + (0.53386189365816880454e-12 + 0.23944209546666666667e-14 * t) * t) * t) * t) * t) * t; -} -case 8: { -double t = 2*y100 - 17; -return 0.13099232878814653979e-1 + (0.84167002467906968214e-3 + (0.45555958988457506002e-5 + (0.23723907357214175198e-7 + (0.11839789326602695603e-9 + (0.56346163067550237877e-12 + 0.25403679644444444444e-14 * t) * t) * t) * t) * t) * t; -} -case 9: { -double t = 2*y100 - 19; -return 0.14800987015587535621e-1 + (0.86018092946345943214e-3 + (0.47008265848816866105e-5 + (0.24694040760197315333e-7 + (0.12418779768752299093e-9 + (0.59486890370320261949e-12 + 0.26957764568888888889e-14 * t) * t) * t) * t) * t) * t; -} -case 10: { -double t = 2*y100 - 21; -return 0.16540351739394069380e-1 + (0.87928458641241463952e-3 + (0.48520195793001753903e-5 + (0.25711774900881709176e-7 + (0.13030128534230822419e-9 + (0.62820097586874779402e-12 + 0.28612737351111111111e-14 * t) * t) * t) * t) * t) * t; -} -case 11: { -double t = 2*y100 - 23; -return 0.18318536789842392647e-1 + (0.89900542647891721692e-3 + (0.50094684089553365810e-5 + (0.26779777074218070482e-7 + (0.13675822186304615566e-9 + (0.66358287745352705725e-12 + 0.30375273884444444444e-14 * t) * t) * t) * t) * t) * t; -} -case 12: { -double t = 2*y100 - 25; -return 0.20136801964214276775e-1 + (0.91936908737673676012e-3 + (0.51734830914104276820e-5 + (0.27900878609710432673e-7 + (0.14357976402809042257e-9 + (0.70114790311043728387e-12 + 0.32252476000000000000e-14 * t) * t) * t) * t) * t) * t; -} -case 13: { -double t = 2*y100 - 27; -return 0.21996459598282740954e-1 + (0.94040248155366777784e-3 + (0.53443911508041164739e-5 + (0.29078085538049374673e-7 + (0.15078844500329731137e-9 + (0.74103813647499204269e-12 + 0.34251892320000000000e-14 * t) * t) * t) * t) * t) * t; -} -case 14: { -double t = 2*y100 - 29; -return 0.23898877187226319502e-1 + (0.96213386835900177540e-3 + (0.55225386998049012752e-5 + (0.30314589961047687059e-7 + (0.15840826497296335264e-9 + (0.78340500472414454395e-12 + 0.36381553564444444445e-14 * t) * t) * t) * t) * t) * t; -} -case 15: { -double t = 2*y100 - 31; -return 0.25845480155298518485e-1 + (0.98459293067820123389e-3 + (0.57082915920051843672e-5 + (0.31613782169164830118e-7 + (0.16646478745529630813e-9 + (0.82840985928785407942e-12 + 0.38649975768888888890e-14 * t) * t) * t) * t) * t) * t; -} -case 16: { -double t = 2*y100 - 33; -return 0.27837754783474696598e-1 + (0.10078108563256892757e-2 + (0.59020366493792212221e-5 + (0.32979263553246520417e-7 + (0.17498524159268458073e-9 + (0.87622459124842525110e-12 + 0.41066206488888888890e-14 * t) * t) * t) * t) * t) * t; -} -case 17: { -double t = 2*y100 - 35; -return 0.29877251304899307550e-1 + (0.10318204245057349310e-2 + (0.61041829697162055093e-5 + (0.34414860359542720579e-7 + (0.18399863072934089607e-9 + (0.92703227366365046533e-12 + 0.43639844053333333334e-14 * t) * t) * t) * t) * t) * t; -} -case 18: { -double t = 2*y100 - 37; -return 0.31965587178596443475e-1 + (0.10566560976716574401e-2 + (0.63151633192414586770e-5 + (0.35924638339521924242e-7 + (0.19353584758781174038e-9 + (0.98102783859889264382e-12 + 0.46381060817777777779e-14 * t) * t) * t) * t) * t) * t; -} -case 19: { -double t = 2*y100 - 39; -return 0.34104450552588334840e-1 + (0.10823541191350532574e-2 + (0.65354356159553934436e-5 + (0.37512918348533521149e-7 + (0.20362979635817883229e-9 + (0.10384187833037282363e-11 + 0.49300625262222222221e-14 * t) * t) * t) * t) * t) * t; -} -case 20: { -double t = 2*y100 - 41; -return 0.36295603928292425716e-1 + (0.11089526167995268200e-2 + (0.67654845095518363577e-5 + (0.39184292949913591646e-7 + (0.21431552202133775150e-9 + (0.10994259106646731797e-11 + 0.52409949102222222221e-14 * t) * t) * t) * t) * t) * t; -} -case 21: { -double t = 2*y100 - 43; -return 0.38540888038840509795e-1 + (0.11364917134175420009e-2 + (0.70058230641246312003e-5 + (0.40943644083718586939e-7 + (0.22563034723692881631e-9 + (0.11642841011361992885e-11 + 0.55721092871111111110e-14 * t) * t) * t) * t) * t) * t; -} -case 22: { -double t = 2*y100 - 45; -return 0.40842225954785960651e-1 + (0.11650136437945673891e-2 + (0.72569945502343006619e-5 + (0.42796161861855042273e-7 + (0.23761401711005024162e-9 + (0.12332431172381557035e-11 + 0.59246802364444444445e-14 * t) * t) * t) * t) * t) * t; -} -case 23: { -double t = 2*y100 - 47; -return 0.43201627431540222422e-1 + (0.11945628793917272199e-2 + (0.75195743532849206263e-5 + (0.44747364553960993492e-7 + (0.25030885216472953674e-9 + (0.13065684400300476484e-11 + 0.63000532853333333334e-14 * t) * t) * t) * t) * t) * t; -} -case 24: { -double t = 2*y100 - 49; -return 0.45621193513810471438e-1 + (0.12251862608067529503e-2 + (0.77941720055551920319e-5 + (0.46803119830954460212e-7 + (0.26375990983978426273e-9 + (0.13845421370977119765e-11 + 0.66996477404444444445e-14 * t) * t) * t) * t) * t) * t; -} -case 25: { -double t = 2*y100 - 51; -return 0.48103121413299865517e-1 + (0.12569331386432195113e-2 + (0.80814333496367673980e-5 + (0.48969667335682018324e-7 + (0.27801515481905748484e-9 + (0.14674637611609884208e-11 + 0.71249589351111111110e-14 * t) * t) * t) * t) * t) * t; -} -case 26: { -double t = 2*y100 - 53; -return 0.50649709676983338501e-1 + (0.12898555233099055810e-2 + (0.83820428414568799654e-5 + (0.51253642652551838659e-7 + (0.29312563849675507232e-9 + (0.15556512782814827846e-11 + 0.75775607822222222221e-14 * t) * t) * t) * t) * t) * t; -} -case 27: { -double t = 2*y100 - 55; -return 0.53263363664388864181e-1 + (0.13240082443256975769e-2 + (0.86967260015007658418e-5 + (0.53662102750396795566e-7 + (0.30914568786634796807e-9 + (0.16494420240828493176e-11 + 0.80591079644444444445e-14 * t) * t) * t) * t) * t) * t; -} -case 28: { -double t = 2*y100 - 57; -return 0.55946601353500013794e-1 + (0.13594491197408190706e-2 + (0.90262520233016380987e-5 + (0.56202552975056695376e-7 + (0.32613310410503135996e-9 + (0.17491936862246367398e-11 + 0.85713381688888888890e-14 * t) * t) * t) * t) * t) * t; -} -case 29: { -double t = 2*y100 - 59; -return 0.58702059496154081813e-1 + (0.13962391363223647892e-2 + (0.93714365487312784270e-5 + (0.58882975670265286526e-7 + (0.34414937110591753387e-9 + (0.18552853109751857859e-11 + 0.91160736711111111110e-14 * t) * t) * t) * t) * t) * t; -} -case 30: { -double t = 2*y100 - 61; -return 0.61532500145144778048e-1 + (0.14344426411912015247e-2 + (0.97331446201016809696e-5 + (0.61711860507347175097e-7 + (0.36325987418295300221e-9 + (0.19681183310134518232e-11 + 0.96952238400000000000e-14 * t) * t) * t) * t) * t) * t; -} -case 31: { -double t = 2*y100 - 63; -return 0.64440817576653297993e-1 + (0.14741275456383131151e-2 + (0.10112293819576437838e-4 + (0.64698236605933246196e-7 + (0.38353412915303665586e-9 + (0.20881176114385120186e-11 + 0.10310784480000000000e-13 * t) * t) * t) * t) * t) * t; -} -case 32: { -double t = 2*y100 - 65; -return 0.67430045633130393282e-1 + (0.15153655418916540370e-2 + (0.10509857606888328667e-4 + (0.67851706529363332855e-7 + (0.40504602194811140006e-9 + (0.22157325110542534469e-11 + 0.10964842115555555556e-13 * t) * t) * t) * t) * t) * t; -} -case 33: { -double t = 2*y100 - 67; -return 0.70503365513338850709e-1 + (0.15582323336495709827e-2 + (0.10926868866865231089e-4 + (0.71182482239613507542e-7 + (0.42787405890153386710e-9 + (0.23514379522274416437e-11 + 0.11659571751111111111e-13 * t) * t) * t) * t) * t) * t; -} -case 34: { -double t = 2*y100 - 69; -return 0.73664114037944596353e-1 + (0.16028078812438820413e-2 + (0.11364423678778207991e-4 + (0.74701423097423182009e-7 + (0.45210162777476488324e-9 + (0.24957355004088569134e-11 + 0.12397238257777777778e-13 * t) * t) * t) * t) * t) * t; -} -case 35: { -double t = 2*y100 - 71; -return 0.76915792420819562379e-1 + (0.16491766623447889354e-2 + (0.11823685320041302169e-4 + (0.78420075993781544386e-7 + (0.47781726956916478925e-9 + (0.26491544403815724749e-11 + 0.13180196462222222222e-13 * t) * t) * t) * t) * t) * t; -} -case 36: { -double t = 2*y100 - 73; -return 0.80262075578094612819e-1 + (0.16974279491709504117e-2 + (0.12305888517309891674e-4 + (0.82350717698979042290e-7 + (0.50511496109857113929e-9 + (0.28122528497626897696e-11 + 0.14010889635555555556e-13 * t) * t) * t) * t) * t) * t; -} -case 37: { -double t = 2*y100 - 75; -return 0.83706822008980357446e-1 + (0.17476561032212656962e-2 + (0.12812343958540763368e-4 + (0.86506399515036435592e-7 + (0.53409440823869467453e-9 + (0.29856186620887555043e-11 + 0.14891851591111111111e-13 * t) * t) * t) * t) * t) * t; -} -case 38: { -double t = 2*y100 - 77; -return 0.87254084284461718231e-1 + (0.17999608886001962327e-2 + (0.13344443080089492218e-4 + (0.90900994316429008631e-7 + (0.56486134972616465316e-9 + (0.31698707080033956934e-11 + 0.15825697795555555556e-13 * t) * t) * t) * t) * t) * t; -} -case 39: { -double t = 2*y100 - 79; -return 0.90908120182172748487e-1 + (0.18544478050657699758e-2 + (0.13903663143426120077e-4 + (0.95549246062549906177e-7 + (0.59752787125242054315e-9 + (0.33656597366099099413e-11 + 0.16815130613333333333e-13 * t) * t) * t) * t) * t) * t; -} -case 40: { -double t = 2*y100 - 81; -return 0.94673404508075481121e-1 + (0.19112284419887303347e-2 + (0.14491572616545004930e-4 + (0.10046682186333613697e-6 + (0.63221272959791000515e-9 + (0.35736693975589130818e-11 + 0.17862931591111111111e-13 * t) * t) * t) * t) * t) * t; -} -case 41: { -double t = 2*y100 - 83; -return 0.98554641648004456555e-1 + (0.19704208544725622126e-2 + (0.15109836875625443935e-4 + (0.10567036667675984067e-6 + (0.66904168640019354565e-9 + (0.37946171850824333014e-11 + 0.18971959040000000000e-13 * t) * t) * t) * t) * t) * t; -} -case 42: { -double t = 2*y100 - 85; -return 0.10255677889470089531e0 + (0.20321499629472857418e-2 + (0.15760224242962179564e-4 + (0.11117756071353507391e-6 + (0.70814785110097658502e-9 + (0.40292553276632563925e-11 + 0.20145143075555555556e-13 * t) * t) * t) * t) * t) * t; -} -case 43: { -double t = 2*y100 - 87; -return 0.10668502059865093318e0 + (0.20965479776148731610e-2 + (0.16444612377624983565e-4 + (0.11700717962026152749e-6 + (0.74967203250938418991e-9 + (0.42783716186085922176e-11 + 0.21385479360000000000e-13 * t) * t) * t) * t) * t) * t; -} -case 44: { -double t = 2*y100 - 89; -return 0.11094484319386444474e0 + (0.21637548491908170841e-2 + (0.17164995035719657111e-4 + (0.12317915750735938089e-6 + (0.79376309831499633734e-9 + (0.45427901763106353914e-11 + 0.22696025653333333333e-13 * t) * t) * t) * t) * t) * t; -} -case 45: { -double t = 2*y100 - 91; -return 0.11534201115268804714e0 + (0.22339187474546420375e-2 + (0.17923489217504226813e-4 + (0.12971465288245997681e-6 + (0.84057834180389073587e-9 + (0.48233721206418027227e-11 + 0.24079890062222222222e-13 * t) * t) * t) * t) * t) * t; -} -case 46: { -double t = 2*y100 - 93; -return 0.11988259392684094740e0 + (0.23071965691918689601e-2 + (0.18722342718958935446e-4 + (0.13663611754337957520e-6 + (0.89028385488493287005e-9 + (0.51210161569225846701e-11 + 0.25540227111111111111e-13 * t) * t) * t) * t) * t) * t; -} -case 47: { -double t = 2*y100 - 95; -return 0.12457298393509812907e0 + (0.23837544771809575380e-2 + (0.19563942105711612475e-4 + (0.14396736847739470782e-6 + (0.94305490646459247016e-9 + (0.54366590583134218096e-11 + 0.27080225920000000000e-13 * t) * t) * t) * t) * t) * t; -} -case 48: { -double t = 2*y100 - 97; -return 0.12941991566142438816e0 + (0.24637684719508859484e-2 + (0.20450821127475879816e-4 + (0.15173366280523906622e-6 + (0.99907632506389027739e-9 + (0.57712760311351625221e-11 + 0.28703099555555555556e-13 * t) * t) * t) * t) * t) * t; -} -case 49: { -double t = 2*y100 - 99; -return 0.13443048593088696613e0 + (0.25474249981080823877e-2 + (0.21385669591362915223e-4 + (0.15996177579900443030e-6 + (0.10585428844575134013e-8 + (0.61258809536787882989e-11 + 0.30412080142222222222e-13 * t) * t) * t) * t) * t) * t; -} -case 50: { -double t = 2*y100 - 101; -return 0.13961217543434561353e0 + (0.26349215871051761416e-2 + (0.22371342712572567744e-4 + (0.16868008199296822247e-6 + (0.11216596910444996246e-8 + (0.65015264753090890662e-11 + 0.32210394506666666666e-13 * t) * t) * t) * t) * t) * t; -} -case 51: { -double t = 2*y100 - 103; -return 0.14497287157673800690e0 + (0.27264675383982439814e-2 + (0.23410870961050950197e-4 + (0.17791863939526376477e-6 + (0.11886425714330958106e-8 + (0.68993039665054288034e-11 + 0.34101266222222222221e-13 * t) * t) * t) * t) * t) * t; -} -case 52: { -double t = 2*y100 - 105; -return 0.15052089272774618151e0 + (0.28222846410136238008e-2 + (0.24507470422713397006e-4 + (0.18770927679626136909e-6 + (0.12597184587583370712e-8 + (0.73203433049229821618e-11 + 0.36087889048888888890e-13 * t) * t) * t) * t) * t) * t; -} -case 53: { -double t = 2*y100 - 107; -return 0.15626501395774612325e0 + (0.29226079376196624949e-2 + (0.25664553693768450545e-4 + (0.19808568415654461964e-6 + (0.13351257759815557897e-8 + (0.77658124891046760667e-11 + 0.38173420035555555555e-13 * t) * t) * t) * t) * t) * t; -} -case 54: { -double t = 2*y100 - 109; -return 0.16221449434620737567e0 + (0.30276865332726475672e-2 + (0.26885741326534564336e-4 + (0.20908350604346384143e-6 + (0.14151148144240728728e-8 + (0.82369170665974313027e-11 + 0.40360957457777777779e-13 * t) * t) * t) * t) * t) * t; -} -case 55: { -double t = 2*y100 - 111; -return 0.16837910595412130659e0 + (0.31377844510793082301e-2 + (0.28174873844911175026e-4 + (0.22074043807045782387e-6 + (0.14999481055996090039e-8 + (0.87348993661930809254e-11 + 0.42653528977777777779e-13 * t) * t) * t) * t) * t) * t; -} -case 56: { -double t = 2*y100 - 113; -return 0.17476916455659369953e0 + (0.32531815370903068316e-2 + (0.29536024347344364074e-4 + (0.23309632627767074202e-6 + (0.15899007843582444846e-8 + (0.92610375235427359475e-11 + 0.45054073102222222221e-13 * t) * t) * t) * t) * t) * t; -} -case 57: { -double t = 2*y100 - 115; -return 0.18139556223643701364e0 + (0.33741744168096996041e-2 + (0.30973511714709500836e-4 + (0.24619326937592290996e-6 + (0.16852609412267750744e-8 + (0.98166442942854895573e-11 + 0.47565418097777777779e-13 * t) * t) * t) * t) * t) * t; -} -case 58: { -double t = 2*y100 - 117; -return 0.18826980194443664549e0 + (0.35010775057740317997e-2 + (0.32491914440014267480e-4 + (0.26007572375886319028e-6 + (0.17863299617388376116e-8 + (0.10403065638343878679e-10 + 0.50190265831111111110e-13 * t) * t) * t) * t) * t) * t; -} -case 59: { -double t = 2*y100 - 119; -return 0.19540403413693967350e0 + (0.36342240767211326315e-2 + (0.34096085096200907289e-4 + (0.27479061117017637474e-6 + (0.18934228504790032826e-8 + (0.11021679075323598664e-10 + 0.52931171733333333334e-13 * t) * t) * t) * t) * t) * t; -} -case 60: { -double t = 2*y100 - 121; -return 0.20281109560651886959e0 + (0.37739673859323597060e-2 + (0.35791165457592409054e-4 + (0.29038742889416172404e-6 + (0.20068685374849001770e-8 + (0.11673891799578381999e-10 + 0.55790523093333333334e-13 * t) * t) * t) * t) * t) * t; -} -case 61: { -double t = 2*y100 - 123; -return 0.21050455062669334978e0 + (0.39206818613925652425e-2 + (0.37582602289680101704e-4 + (0.30691836231886877385e-6 + (0.21270101645763677824e-8 + (0.12361138551062899455e-10 + 0.58770520160000000000e-13 * t) * t) * t) * t) * t) * t; -} -case 62: { -double t = 2*y100 - 125; -return 0.21849873453703332479e0 + (0.40747643554689586041e-2 + (0.39476163820986711501e-4 + (0.32443839970139918836e-6 + (0.22542053491518680200e-8 + (0.13084879235290858490e-10 + 0.61873153262222222221e-13 * t) * t) * t) * t) * t) * t; -} -case 63: { -double t = 2*y100 - 127; -return 0.22680879990043229327e0 + (0.42366354648628516935e-2 + (0.41477956909656896779e-4 + (0.34300544894502810002e-6 + (0.23888264229264067658e-8 + (0.13846596292818514601e-10 + 0.65100183751111111110e-13 * t) * t) * t) * t) * t) * t; -} -case 64: { -double t = 2*y100 - 129; -return 0.23545076536988703937e0 + (0.44067409206365170888e-2 + (0.43594444916224700881e-4 + (0.36268045617760415178e-6 + (0.25312606430853202748e-8 + (0.14647791812837903061e-10 + 0.68453122631111111110e-13 * t) * t) * t) * t) * t) * t; -} -case 65: { -double t = 2*y100 - 131; -return 0.24444156740777432838e0 + (0.45855530511605787178e-2 + (0.45832466292683085475e-4 + (0.38352752590033030472e-6 + (0.26819103733055603460e-8 + (0.15489984390884756993e-10 + 0.71933206364444444445e-13 * t) * t) * t) * t) * t) * t; -} -case 66: { -double t = 2*y100 - 133; -return 0.25379911500634264643e0 + (0.47735723208650032167e-2 + (0.48199253896534185372e-4 + (0.40561404245564732314e-6 + (0.28411932320871165585e-8 + (0.16374705736458320149e-10 + 0.75541379822222222221e-13 * t) * t) * t) * t) * t) * t; -} -case 67: { -double t = 2*y100 - 135; -return 0.26354234756393613032e0 + (0.49713289477083781266e-2 + (0.50702455036930367504e-4 + (0.42901079254268185722e-6 + (0.30095422058900481753e-8 + (0.17303497025347342498e-10 + 0.79278273368888888890e-13 * t) * t) * t) * t) * t) * t; -} -case 68: { -double t = 2*y100 - 137; -return 0.27369129607732343398e0 + (0.51793846023052643767e-2 + (0.53350152258326602629e-4 + (0.45379208848865015485e-6 + (0.31874057245814381257e-8 + (0.18277905010245111046e-10 + 0.83144182364444444445e-13 * t) * t) * t) * t) * t) * t; -} -case 69: { -double t = 2*y100 - 139; -return 0.28426714781640316172e0 + (0.53983341916695141966e-2 + (0.56150884865255810638e-4 + (0.48003589196494734238e-6 + (0.33752476967570796349e-8 + (0.19299477888083469086e-10 + 0.87139049137777777779e-13 * t) * t) * t) * t) * t) * t; -} -case 70: { -double t = 2*y100 - 141; -return 0.29529231465348519920e0 + (0.56288077305420795663e-2 + (0.59113671189913307427e-4 + (0.50782393781744840482e-6 + (0.35735475025851713168e-8 + (0.20369760937017070382e-10 + 0.91262442613333333334e-13 * t) * t) * t) * t) * t) * t; -} -case 71: { -double t = 2*y100 - 143; -return 0.30679050522528838613e0 + (0.58714723032745403331e-2 + (0.62248031602197686791e-4 + (0.53724185766200945789e-6 + (0.37827999418960232678e-8 + (0.21490291930444538307e-10 + 0.95513539182222222221e-13 * t) * t) * t) * t) * t) * t; -} -case 72: { -double t = 2*y100 - 145; -return 0.31878680111173319425e0 + (0.61270341192339103514e-2 + (0.65564012259707640976e-4 + (0.56837930287837738996e-6 + (0.40035151353392378882e-8 + (0.22662596341239294792e-10 + 0.99891109760000000000e-13 * t) * t) * t) * t) * t) * t; -} -case 73: { -double t = 2*y100 - 147; -return 0.33130773722152622027e0 + (0.63962406646798080903e-2 + (0.69072209592942396666e-4 + (0.60133006661885941812e-6 + (0.42362183765883466691e-8 + (0.23888182347073698382e-10 + 0.10439349811555555556e-12 * t) * t) * t) * t) * t) * t; -} -case 74: { -double t = 2*y100 - 149; -return 0.34438138658041336523e0 + (0.66798829540414007258e-2 + (0.72783795518603561144e-4 + (0.63619220443228800680e-6 + (0.44814499336514453364e-8 + (0.25168535651285475274e-10 + 0.10901861383111111111e-12 * t) * t) * t) * t) * t) * t; -} -case 75: { -double t = 2*y100 - 151; -return 0.35803744972380175583e0 + (0.69787978834882685031e-2 + (0.76710543371454822497e-4 + (0.67306815308917386747e-6 + (0.47397647975845228205e-8 + (0.26505114141143050509e-10 + 0.11376390933333333333e-12 * t) * t) * t) * t) * t) * t; -} -case 76: { -double t = 2*y100 - 153; -return 0.37230734890119724188e0 + (0.72938706896461381003e-2 + (0.80864854542670714092e-4 + (0.71206484718062688779e-6 + (0.50117323769745883805e-8 + (0.27899342394100074165e-10 + 0.11862637614222222222e-12 * t) * t) * t) * t) * t) * t; -} -case 77: { -double t = 2*y100 - 155; -return 0.38722432730555448223e0 + (0.76260375162549802745e-2 + (0.85259785810004603848e-4 + (0.75329383305171327677e-6 + (0.52979361368388119355e-8 + (0.29352606054164086709e-10 + 0.12360253370666666667e-12 * t) * t) * t) * t) * t) * t; -} -case 78: { -double t = 2*y100 - 157; -return 0.40282355354616940667e0 + (0.79762880915029728079e-2 + (0.89909077342438246452e-4 + (0.79687137961956194579e-6 + (0.55989731807360403195e-8 + (0.30866246101464869050e-10 + 0.12868841946666666667e-12 * t) * t) * t) * t) * t) * t; -} -case 79: { -double t = 2*y100 - 159; -return 0.41914223158913787649e0 + (0.83456685186950463538e-2 + (0.94827181359250161335e-4 + (0.84291858561783141014e-6 + (0.59154537751083485684e-8 + (0.32441553034347469291e-10 + 0.13387957943111111111e-12 * t) * t) * t) * t) * t) * t; -} -case 80: { -double t = 2*y100 - 161; -return 0.43621971639463786896e0 + (0.87352841828289495773e-2 + (0.10002929142066799966e-3 + (0.89156148280219880024e-6 + (0.62480008150788597147e-8 + (0.34079760983458878910e-10 + 0.13917107176888888889e-12 * t) * t) * t) * t) * t) * t; -} -case 81: { -double t = 2*y100 - 163; -return 0.45409763548534330981e0 + (0.91463027755548240654e-2 + (0.10553137232446167258e-3 + (0.94293113464638623798e-6 + (0.65972492312219959885e-8 + (0.35782041795476563662e-10 + 0.14455745872000000000e-12 * t) * t) * t) * t) * t) * t; -} -case 82: { -double t = 2*y100 - 165; -return 0.47282001668512331468e0 + (0.95799574408860463394e-2 + (0.11135019058000067469e-3 + (0.99716373005509038080e-6 + (0.69638453369956970347e-8 + (0.37549499088161345850e-10 + 0.15003280712888888889e-12 * t) * t) * t) * t) * t) * t; -} -case 83: { -double t = 2*y100 - 167; -return 0.49243342227179841649e0 + (0.10037550043909497071e-1 + (0.11750334542845234952e-3 + (0.10544006716188967172e-5 + (0.73484461168242224872e-8 + (0.39383162326435752965e-10 + 0.15559069118222222222e-12 * t) * t) * t) * t) * t) * t; -} -case 84: { -double t = 2*y100 - 169; -return 0.51298708979209258326e0 + (0.10520454564612427224e-1 + (0.12400930037494996655e-3 + (0.11147886579371265246e-5 + (0.77517184550568711454e-8 + (0.41283980931872622611e-10 + 0.16122419680000000000e-12 * t) * t) * t) * t) * t) * t; -} -case 85: { -double t = 2*y100 - 171; -return 0.53453307979101369843e0 + (0.11030120618800726938e-1 + (0.13088741519572269581e-3 + (0.11784797595374515432e-5 + (0.81743383063044825400e-8 + (0.43252818449517081051e-10 + 0.16692592640000000000e-12 * t) * t) * t) * t) * t) * t; -} -case 86: { -double t = 2*y100 - 173; -return 0.55712643071169299478e0 + (0.11568077107929735233e-1 + (0.13815797838036651289e-3 + (0.12456314879260904558e-5 + (0.86169898078969313597e-8 + (0.45290446811539652525e-10 + 0.17268801084444444444e-12 * t) * t) * t) * t) * t) * t; -} -case 87: { -double t = 2*y100 - 175; -return 0.58082532122519320968e0 + (0.12135935999503877077e-1 + (0.14584223996665838559e-3 + (0.13164068573095710742e-5 + (0.90803643355106020163e-8 + (0.47397540713124619155e-10 + 0.17850211608888888889e-12 * t) * t) * t) * t) * t) * t; -} -case 88: { -double t = 2*y100 - 177; -return 0.60569124025293375554e0 + (0.12735396239525550361e-1 + (0.15396244472258863344e-3 + (0.13909744385382818253e-5 + (0.95651595032306228245e-8 + (0.49574672127669041550e-10 + 0.18435945564444444444e-12 * t) * t) * t) * t) * t) * t; -} -case 89: { -double t = 2*y100 - 179; -return 0.63178916494715716894e0 + (0.13368247798287030927e-1 + (0.16254186562762076141e-3 + (0.14695084048334056083e-5 + (0.10072078109604152350e-7 + (0.51822304995680707483e-10 + 0.19025081422222222222e-12 * t) * t) * t) * t) * t) * t; -} -case 90: { -double t = 2*y100 - 181; -return 0.65918774689725319200e0 + (0.14036375850601992063e-1 + (0.17160483760259706354e-3 + (0.15521885688723188371e-5 + (0.10601827031535280590e-7 + (0.54140790105837520499e-10 + 0.19616655146666666667e-12 * t) * t) * t) * t) * t) * t; -} -case 91: { -double t = 2*y100 - 183; -return 0.68795950683174433822e0 + (0.14741765091365869084e-1 + (0.18117679143520433835e-3 + (0.16392004108230585213e-5 + (0.11155116068018043001e-7 + (0.56530360194925690374e-10 + 0.20209663662222222222e-12 * t) * t) * t) * t) * t) * t; -} -case 92: { -double t = 2*y100 - 185; -return 0.71818103808729967036e0 + (0.15486504187117112279e-1 + (0.19128428784550923217e-3 + (0.17307350969359975848e-5 + (0.11732656736113607751e-7 + (0.58991125287563833603e-10 + 0.20803065333333333333e-12 * t) * t) * t) * t) * t) * t; -} -case 93: { -double t = 2*y100 - 187; -return 0.74993321911726254661e0 + (0.16272790364044783382e-1 + (0.20195505163377912645e-3 + (0.18269894883203346953e-5 + (0.12335161021630225535e-7 + (0.61523068312169087227e-10 + 0.21395783431111111111e-12 * t) * t) * t) * t) * t) * t; -} -case 94: { -double t = 2*y100 - 189; -return 0.78330143531283492729e0 + (0.17102934132652429240e-1 + (0.21321800585063327041e-3 + (0.19281661395543913713e-5 + (0.12963340087354341574e-7 + (0.64126040998066348872e-10 + 0.21986708942222222222e-12 * t) * t) * t) * t) * t) * t; -} -case 95: { -double t = 2*y100 - 191; -return 0.81837581041023811832e0 + (0.17979364149044223802e-1 + (0.22510330592753129006e-3 + (0.20344732868018175389e-5 + (0.13617902941839949718e-7 + (0.66799760083972474642e-10 + 0.22574701262222222222e-12 * t) * t) * t) * t) * t) * t; -} -case 96: { -double t = 2*y100 - 193; -return 0.85525144775685126237e0 + (0.18904632212547561026e-1 + (0.23764237370371255638e-3 + (0.21461248251306387979e-5 + (0.14299555071870523786e-7 + (0.69543803864694171934e-10 + 0.23158593688888888889e-12 * t) * t) * t) * t) * t) * t; -} -case 97: { -double t = 2*y100 - 195; -return 0.89402868170849933734e0 + (0.19881418399127202569e-1 + (0.25086793128395995798e-3 + (0.22633402747585233180e-5 + (0.15008997042116532283e-7 + (0.72357609075043941261e-10 + 0.23737194737777777778e-12 * t) * t) * t) * t) * t) * t; -} -case 98: { -double t = 2*y100 - 197; -return 0.93481333942870796363e0 + (0.20912536329780368893e-1 + (0.26481403465998477969e-3 + (0.23863447359754921676e-5 + (0.15746923065472184451e-7 + (0.75240468141720143653e-10 + 0.24309291271111111111e-12 * t) * t) * t) * t) * t) * t; -} -case 99: { -double t = 2*y100 - 199; -return 0.97771701335885035464e0 + (0.22000938572830479551e-1 + (0.27951610702682383001e-3 + (0.25153688325245314530e-5 + (0.16514019547822821453e-7 + (0.78191526829368231251e-10 + 0.24873652355555555556e-12 * t) * t) * t) * t) * t) * t; -} - } - // we only get here if y = 1, i.e. |x| < 4*eps, in which case - // erfcx is within 1e-15 of 1.. - return 1.0; -} - -double erfcx(double x) -{ - if (x >= 0) { - if (x > 50) { // continued-fraction expansion is faster - const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi) - if (x > 5e7) // 1-term expansion, important to avoid overflow - return ispi / x; - /* 5-term expansion (rely on compiler for CSE), simplified from: - ispi / (x+0.5/(x+1/(x+1.5/(x+2/x)))) */ - return ispi*((x*x) * (x*x+4.5) + 2) / (x * ((x*x) * (x*x+5) + 3.75)); - } - return erfcx_y100(400/(4+x)); - } - else - return x < -26.7 ? HUGE_VAL : (x < -6.1 ? 2*exp(x*x) - : 2*exp(x*x) - erfcx_y100(400/(4-x))); +double erfcx_y100(double y100) { + switch ((int)y100) { + case 0: { + double t = 2 * y100 - 1; + return 0.70878032454106438663e-3 + + (0.71234091047026302958e-3 + + (0.35779077297597742384e-5 + + (0.17403143962587937815e-7 + + (0.81710660047307788845e-10 + (0.36885022360434957634e-12 + 0.15917038551111111111e-14 * t) * t) * t + ) * t) * + t) * + t; + } + case 1: { + double t = 2 * y100 - 3; + return 0.21479143208285144230e-2 + + (0.72686402367379996033e-3 + + (0.36843175430938995552e-5 + + (0.18071841272149201685e-7 + + (0.85496449296040325555e-10 + (0.38852037518534291510e-12 + 0.16868473576888888889e-14 * t) * t) * t + ) * t) * + t) * + t; + } + case 2: { + double t = 2 * y100 - 5; + return 0.36165255935630175090e-2 + + (0.74182092323555510862e-3 + + (0.37948319957528242260e-5 + + (0.18771627021793087350e-7 + + (0.89484715122415089123e-10 + (0.40935858517772440862e-12 + 0.17872061464888888889e-14 * t) * t) * t + ) * t) * + t) * + t; + } + case 3: { + double t = 2 * y100 - 7; + return 0.51154983860031979264e-2 + + (0.75722840734791660540e-3 + + (0.39096425726735703941e-5 + + (0.19504168704300468210e-7 + + (0.93687503063178993915e-10 + (0.43143925959079664747e-12 + 0.18939926435555555556e-14 * t) * t) * t + ) * t) * + t) * + t; + } + case 4: { + double t = 2 * y100 - 9; + return 0.66457513172673049824e-2 + + (0.77310406054447454920e-3 + + (0.40289510589399439385e-5 + + (0.20271233238288381092e-7 + + (0.98117631321709100264e-10 + (0.45484207406017752971e-12 + 0.20076352213333333333e-14 * t) * t) * t + ) * t) * + t) * + t; + } + case 5: { + double t = 2 * y100 - 11; + return 0.82082389970241207883e-2 + + (0.78946629611881710721e-3 + + (0.41529701552622656574e-5 + + (0.21074693344544655714e-7 + + (0.10278874108587317989e-9 + (0.47965201390613339638e-12 + 0.21285907413333333333e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 6: { + double t = 2 * y100 - 13; + return 0.98039537275352193165e-2 + + (0.80633440108342840956e-3 + + (0.42819241329736982942e-5 + + (0.21916534346907168612e-7 + + (0.10771535136565470914e-9 + (0.50595972623692822410e-12 + 0.22573462684444444444e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 7: { + double t = 2 * y100 - 15; + return 0.11433927298290302370e-1 + + (0.82372858383196561209e-3 + + (0.44160495311765438816e-5 + + (0.22798861426211986056e-7 + + (0.11291291745879239736e-9 + (0.53386189365816880454e-12 + 0.23944209546666666667e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 8: { + double t = 2 * y100 - 17; + return 0.13099232878814653979e-1 + + (0.84167002467906968214e-3 + + (0.45555958988457506002e-5 + + (0.23723907357214175198e-7 + + (0.11839789326602695603e-9 + (0.56346163067550237877e-12 + 0.25403679644444444444e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 9: { + double t = 2 * y100 - 19; + return 0.14800987015587535621e-1 + + (0.86018092946345943214e-3 + + (0.47008265848816866105e-5 + + (0.24694040760197315333e-7 + + (0.12418779768752299093e-9 + (0.59486890370320261949e-12 + 0.26957764568888888889e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 10: { + double t = 2 * y100 - 21; + return 0.16540351739394069380e-1 + + (0.87928458641241463952e-3 + + (0.48520195793001753903e-5 + + (0.25711774900881709176e-7 + + (0.13030128534230822419e-9 + (0.62820097586874779402e-12 + 0.28612737351111111111e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 11: { + double t = 2 * y100 - 23; + return 0.18318536789842392647e-1 + + (0.89900542647891721692e-3 + + (0.50094684089553365810e-5 + + (0.26779777074218070482e-7 + + (0.13675822186304615566e-9 + (0.66358287745352705725e-12 + 0.30375273884444444444e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 12: { + double t = 2 * y100 - 25; + return 0.20136801964214276775e-1 + + (0.91936908737673676012e-3 + + (0.51734830914104276820e-5 + + (0.27900878609710432673e-7 + + (0.14357976402809042257e-9 + (0.70114790311043728387e-12 + 0.32252476000000000000e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 13: { + double t = 2 * y100 - 27; + return 0.21996459598282740954e-1 + + (0.94040248155366777784e-3 + + (0.53443911508041164739e-5 + + (0.29078085538049374673e-7 + + (0.15078844500329731137e-9 + (0.74103813647499204269e-12 + 0.34251892320000000000e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 14: { + double t = 2 * y100 - 29; + return 0.23898877187226319502e-1 + + (0.96213386835900177540e-3 + + (0.55225386998049012752e-5 + + (0.30314589961047687059e-7 + + (0.15840826497296335264e-9 + (0.78340500472414454395e-12 + 0.36381553564444444445e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 15: { + double t = 2 * y100 - 31; + return 0.25845480155298518485e-1 + + (0.98459293067820123389e-3 + + (0.57082915920051843672e-5 + + (0.31613782169164830118e-7 + + (0.16646478745529630813e-9 + (0.82840985928785407942e-12 + 0.38649975768888888890e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 16: { + double t = 2 * y100 - 33; + return 0.27837754783474696598e-1 + + (0.10078108563256892757e-2 + + (0.59020366493792212221e-5 + + (0.32979263553246520417e-7 + + (0.17498524159268458073e-9 + (0.87622459124842525110e-12 + 0.41066206488888888890e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 17: { + double t = 2 * y100 - 35; + return 0.29877251304899307550e-1 + + (0.10318204245057349310e-2 + + (0.61041829697162055093e-5 + + (0.34414860359542720579e-7 + + (0.18399863072934089607e-9 + (0.92703227366365046533e-12 + 0.43639844053333333334e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 18: { + double t = 2 * y100 - 37; + return 0.31965587178596443475e-1 + + (0.10566560976716574401e-2 + + (0.63151633192414586770e-5 + + (0.35924638339521924242e-7 + + (0.19353584758781174038e-9 + (0.98102783859889264382e-12 + 0.46381060817777777779e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 19: { + double t = 2 * y100 - 39; + return 0.34104450552588334840e-1 + + (0.10823541191350532574e-2 + + (0.65354356159553934436e-5 + + (0.37512918348533521149e-7 + + (0.20362979635817883229e-9 + (0.10384187833037282363e-11 + 0.49300625262222222221e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 20: { + double t = 2 * y100 - 41; + return 0.36295603928292425716e-1 + + (0.11089526167995268200e-2 + + (0.67654845095518363577e-5 + + (0.39184292949913591646e-7 + + (0.21431552202133775150e-9 + (0.10994259106646731797e-11 + 0.52409949102222222221e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 21: { + double t = 2 * y100 - 43; + return 0.38540888038840509795e-1 + + (0.11364917134175420009e-2 + + (0.70058230641246312003e-5 + + (0.40943644083718586939e-7 + + (0.22563034723692881631e-9 + (0.11642841011361992885e-11 + 0.55721092871111111110e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 22: { + double t = 2 * y100 - 45; + return 0.40842225954785960651e-1 + + (0.11650136437945673891e-2 + + (0.72569945502343006619e-5 + + (0.42796161861855042273e-7 + + (0.23761401711005024162e-9 + (0.12332431172381557035e-11 + 0.59246802364444444445e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 23: { + double t = 2 * y100 - 47; + return 0.43201627431540222422e-1 + + (0.11945628793917272199e-2 + + (0.75195743532849206263e-5 + + (0.44747364553960993492e-7 + + (0.25030885216472953674e-9 + (0.13065684400300476484e-11 + 0.63000532853333333334e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 24: { + double t = 2 * y100 - 49; + return 0.45621193513810471438e-1 + + (0.12251862608067529503e-2 + + (0.77941720055551920319e-5 + + (0.46803119830954460212e-7 + + (0.26375990983978426273e-9 + (0.13845421370977119765e-11 + 0.66996477404444444445e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 25: { + double t = 2 * y100 - 51; + return 0.48103121413299865517e-1 + + (0.12569331386432195113e-2 + + (0.80814333496367673980e-5 + + (0.48969667335682018324e-7 + + (0.27801515481905748484e-9 + (0.14674637611609884208e-11 + 0.71249589351111111110e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 26: { + double t = 2 * y100 - 53; + return 0.50649709676983338501e-1 + + (0.12898555233099055810e-2 + + (0.83820428414568799654e-5 + + (0.51253642652551838659e-7 + + (0.29312563849675507232e-9 + (0.15556512782814827846e-11 + 0.75775607822222222221e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 27: { + double t = 2 * y100 - 55; + return 0.53263363664388864181e-1 + + (0.13240082443256975769e-2 + + (0.86967260015007658418e-5 + + (0.53662102750396795566e-7 + + (0.30914568786634796807e-9 + (0.16494420240828493176e-11 + 0.80591079644444444445e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 28: { + double t = 2 * y100 - 57; + return 0.55946601353500013794e-1 + + (0.13594491197408190706e-2 + + (0.90262520233016380987e-5 + + (0.56202552975056695376e-7 + + (0.32613310410503135996e-9 + (0.17491936862246367398e-11 + 0.85713381688888888890e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 29: { + double t = 2 * y100 - 59; + return 0.58702059496154081813e-1 + + (0.13962391363223647892e-2 + + (0.93714365487312784270e-5 + + (0.58882975670265286526e-7 + + (0.34414937110591753387e-9 + (0.18552853109751857859e-11 + 0.91160736711111111110e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 30: { + double t = 2 * y100 - 61; + return 0.61532500145144778048e-1 + + (0.14344426411912015247e-2 + + (0.97331446201016809696e-5 + + (0.61711860507347175097e-7 + + (0.36325987418295300221e-9 + (0.19681183310134518232e-11 + 0.96952238400000000000e-14 * t) * t) * t) * + t) * + t) * + t; + } + case 31: { + double t = 2 * y100 - 63; + return 0.64440817576653297993e-1 + + (0.14741275456383131151e-2 + + (0.10112293819576437838e-4 + + (0.64698236605933246196e-7 + + (0.38353412915303665586e-9 + (0.20881176114385120186e-11 + 0.10310784480000000000e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 32: { + double t = 2 * y100 - 65; + return 0.67430045633130393282e-1 + + (0.15153655418916540370e-2 + + (0.10509857606888328667e-4 + + (0.67851706529363332855e-7 + + (0.40504602194811140006e-9 + (0.22157325110542534469e-11 + 0.10964842115555555556e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 33: { + double t = 2 * y100 - 67; + return 0.70503365513338850709e-1 + + (0.15582323336495709827e-2 + + (0.10926868866865231089e-4 + + (0.71182482239613507542e-7 + + (0.42787405890153386710e-9 + (0.23514379522274416437e-11 + 0.11659571751111111111e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 34: { + double t = 2 * y100 - 69; + return 0.73664114037944596353e-1 + + (0.16028078812438820413e-2 + + (0.11364423678778207991e-4 + + (0.74701423097423182009e-7 + + (0.45210162777476488324e-9 + (0.24957355004088569134e-11 + 0.12397238257777777778e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 35: { + double t = 2 * y100 - 71; + return 0.76915792420819562379e-1 + + (0.16491766623447889354e-2 + + (0.11823685320041302169e-4 + + (0.78420075993781544386e-7 + + (0.47781726956916478925e-9 + (0.26491544403815724749e-11 + 0.13180196462222222222e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 36: { + double t = 2 * y100 - 73; + return 0.80262075578094612819e-1 + + (0.16974279491709504117e-2 + + (0.12305888517309891674e-4 + + (0.82350717698979042290e-7 + + (0.50511496109857113929e-9 + (0.28122528497626897696e-11 + 0.14010889635555555556e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 37: { + double t = 2 * y100 - 75; + return 0.83706822008980357446e-1 + + (0.17476561032212656962e-2 + + (0.12812343958540763368e-4 + + (0.86506399515036435592e-7 + + (0.53409440823869467453e-9 + (0.29856186620887555043e-11 + 0.14891851591111111111e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 38: { + double t = 2 * y100 - 77; + return 0.87254084284461718231e-1 + + (0.17999608886001962327e-2 + + (0.13344443080089492218e-4 + + (0.90900994316429008631e-7 + + (0.56486134972616465316e-9 + (0.31698707080033956934e-11 + 0.15825697795555555556e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 39: { + double t = 2 * y100 - 79; + return 0.90908120182172748487e-1 + + (0.18544478050657699758e-2 + + (0.13903663143426120077e-4 + + (0.95549246062549906177e-7 + + (0.59752787125242054315e-9 + (0.33656597366099099413e-11 + 0.16815130613333333333e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 40: { + double t = 2 * y100 - 81; + return 0.94673404508075481121e-1 + + (0.19112284419887303347e-2 + + (0.14491572616545004930e-4 + + (0.10046682186333613697e-6 + + (0.63221272959791000515e-9 + (0.35736693975589130818e-11 + 0.17862931591111111111e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 41: { + double t = 2 * y100 - 83; + return 0.98554641648004456555e-1 + + (0.19704208544725622126e-2 + + (0.15109836875625443935e-4 + + (0.10567036667675984067e-6 + + (0.66904168640019354565e-9 + (0.37946171850824333014e-11 + 0.18971959040000000000e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 42: { + double t = 2 * y100 - 85; + return 0.10255677889470089531e0 + + (0.20321499629472857418e-2 + + (0.15760224242962179564e-4 + + (0.11117756071353507391e-6 + + (0.70814785110097658502e-9 + (0.40292553276632563925e-11 + 0.20145143075555555556e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 43: { + double t = 2 * y100 - 87; + return 0.10668502059865093318e0 + + (0.20965479776148731610e-2 + + (0.16444612377624983565e-4 + + (0.11700717962026152749e-6 + + (0.74967203250938418991e-9 + (0.42783716186085922176e-11 + 0.21385479360000000000e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 44: { + double t = 2 * y100 - 89; + return 0.11094484319386444474e0 + + (0.21637548491908170841e-2 + + (0.17164995035719657111e-4 + + (0.12317915750735938089e-6 + + (0.79376309831499633734e-9 + (0.45427901763106353914e-11 + 0.22696025653333333333e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 45: { + double t = 2 * y100 - 91; + return 0.11534201115268804714e0 + + (0.22339187474546420375e-2 + + (0.17923489217504226813e-4 + + (0.12971465288245997681e-6 + + (0.84057834180389073587e-9 + (0.48233721206418027227e-11 + 0.24079890062222222222e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 46: { + double t = 2 * y100 - 93; + return 0.11988259392684094740e0 + + (0.23071965691918689601e-2 + + (0.18722342718958935446e-4 + + (0.13663611754337957520e-6 + + (0.89028385488493287005e-9 + (0.51210161569225846701e-11 + 0.25540227111111111111e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 47: { + double t = 2 * y100 - 95; + return 0.12457298393509812907e0 + + (0.23837544771809575380e-2 + + (0.19563942105711612475e-4 + + (0.14396736847739470782e-6 + + (0.94305490646459247016e-9 + (0.54366590583134218096e-11 + 0.27080225920000000000e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 48: { + double t = 2 * y100 - 97; + return 0.12941991566142438816e0 + + (0.24637684719508859484e-2 + + (0.20450821127475879816e-4 + + (0.15173366280523906622e-6 + + (0.99907632506389027739e-9 + (0.57712760311351625221e-11 + 0.28703099555555555556e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 49: { + double t = 2 * y100 - 99; + return 0.13443048593088696613e0 + + (0.25474249981080823877e-2 + + (0.21385669591362915223e-4 + + (0.15996177579900443030e-6 + + (0.10585428844575134013e-8 + (0.61258809536787882989e-11 + 0.30412080142222222222e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 50: { + double t = 2 * y100 - 101; + return 0.13961217543434561353e0 + + (0.26349215871051761416e-2 + + (0.22371342712572567744e-4 + + (0.16868008199296822247e-6 + + (0.11216596910444996246e-8 + (0.65015264753090890662e-11 + 0.32210394506666666666e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 51: { + double t = 2 * y100 - 103; + return 0.14497287157673800690e0 + + (0.27264675383982439814e-2 + + (0.23410870961050950197e-4 + + (0.17791863939526376477e-6 + + (0.11886425714330958106e-8 + (0.68993039665054288034e-11 + 0.34101266222222222221e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 52: { + double t = 2 * y100 - 105; + return 0.15052089272774618151e0 + + (0.28222846410136238008e-2 + + (0.24507470422713397006e-4 + + (0.18770927679626136909e-6 + + (0.12597184587583370712e-8 + (0.73203433049229821618e-11 + 0.36087889048888888890e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 53: { + double t = 2 * y100 - 107; + return 0.15626501395774612325e0 + + (0.29226079376196624949e-2 + + (0.25664553693768450545e-4 + + (0.19808568415654461964e-6 + + (0.13351257759815557897e-8 + (0.77658124891046760667e-11 + 0.38173420035555555555e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 54: { + double t = 2 * y100 - 109; + return 0.16221449434620737567e0 + + (0.30276865332726475672e-2 + + (0.26885741326534564336e-4 + + (0.20908350604346384143e-6 + + (0.14151148144240728728e-8 + (0.82369170665974313027e-11 + 0.40360957457777777779e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 55: { + double t = 2 * y100 - 111; + return 0.16837910595412130659e0 + + (0.31377844510793082301e-2 + + (0.28174873844911175026e-4 + + (0.22074043807045782387e-6 + + (0.14999481055996090039e-8 + (0.87348993661930809254e-11 + 0.42653528977777777779e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 56: { + double t = 2 * y100 - 113; + return 0.17476916455659369953e0 + + (0.32531815370903068316e-2 + + (0.29536024347344364074e-4 + + (0.23309632627767074202e-6 + + (0.15899007843582444846e-8 + (0.92610375235427359475e-11 + 0.45054073102222222221e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 57: { + double t = 2 * y100 - 115; + return 0.18139556223643701364e0 + + (0.33741744168096996041e-2 + + (0.30973511714709500836e-4 + + (0.24619326937592290996e-6 + + (0.16852609412267750744e-8 + (0.98166442942854895573e-11 + 0.47565418097777777779e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 58: { + double t = 2 * y100 - 117; + return 0.18826980194443664549e0 + + (0.35010775057740317997e-2 + + (0.32491914440014267480e-4 + + (0.26007572375886319028e-6 + + (0.17863299617388376116e-8 + (0.10403065638343878679e-10 + 0.50190265831111111110e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 59: { + double t = 2 * y100 - 119; + return 0.19540403413693967350e0 + + (0.36342240767211326315e-2 + + (0.34096085096200907289e-4 + + (0.27479061117017637474e-6 + + (0.18934228504790032826e-8 + (0.11021679075323598664e-10 + 0.52931171733333333334e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 60: { + double t = 2 * y100 - 121; + return 0.20281109560651886959e0 + + (0.37739673859323597060e-2 + + (0.35791165457592409054e-4 + + (0.29038742889416172404e-6 + + (0.20068685374849001770e-8 + (0.11673891799578381999e-10 + 0.55790523093333333334e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 61: { + double t = 2 * y100 - 123; + return 0.21050455062669334978e0 + + (0.39206818613925652425e-2 + + (0.37582602289680101704e-4 + + (0.30691836231886877385e-6 + + (0.21270101645763677824e-8 + (0.12361138551062899455e-10 + 0.58770520160000000000e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 62: { + double t = 2 * y100 - 125; + return 0.21849873453703332479e0 + + (0.40747643554689586041e-2 + + (0.39476163820986711501e-4 + + (0.32443839970139918836e-6 + + (0.22542053491518680200e-8 + (0.13084879235290858490e-10 + 0.61873153262222222221e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 63: { + double t = 2 * y100 - 127; + return 0.22680879990043229327e0 + + (0.42366354648628516935e-2 + + (0.41477956909656896779e-4 + + (0.34300544894502810002e-6 + + (0.23888264229264067658e-8 + (0.13846596292818514601e-10 + 0.65100183751111111110e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 64: { + double t = 2 * y100 - 129; + return 0.23545076536988703937e0 + + (0.44067409206365170888e-2 + + (0.43594444916224700881e-4 + + (0.36268045617760415178e-6 + + (0.25312606430853202748e-8 + (0.14647791812837903061e-10 + 0.68453122631111111110e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 65: { + double t = 2 * y100 - 131; + return 0.24444156740777432838e0 + + (0.45855530511605787178e-2 + + (0.45832466292683085475e-4 + + (0.38352752590033030472e-6 + + (0.26819103733055603460e-8 + (0.15489984390884756993e-10 + 0.71933206364444444445e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 66: { + double t = 2 * y100 - 133; + return 0.25379911500634264643e0 + + (0.47735723208650032167e-2 + + (0.48199253896534185372e-4 + + (0.40561404245564732314e-6 + + (0.28411932320871165585e-8 + (0.16374705736458320149e-10 + 0.75541379822222222221e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 67: { + double t = 2 * y100 - 135; + return 0.26354234756393613032e0 + + (0.49713289477083781266e-2 + + (0.50702455036930367504e-4 + + (0.42901079254268185722e-6 + + (0.30095422058900481753e-8 + (0.17303497025347342498e-10 + 0.79278273368888888890e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 68: { + double t = 2 * y100 - 137; + return 0.27369129607732343398e0 + + (0.51793846023052643767e-2 + + (0.53350152258326602629e-4 + + (0.45379208848865015485e-6 + + (0.31874057245814381257e-8 + (0.18277905010245111046e-10 + 0.83144182364444444445e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 69: { + double t = 2 * y100 - 139; + return 0.28426714781640316172e0 + + (0.53983341916695141966e-2 + + (0.56150884865255810638e-4 + + (0.48003589196494734238e-6 + + (0.33752476967570796349e-8 + (0.19299477888083469086e-10 + 0.87139049137777777779e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 70: { + double t = 2 * y100 - 141; + return 0.29529231465348519920e0 + + (0.56288077305420795663e-2 + + (0.59113671189913307427e-4 + + (0.50782393781744840482e-6 + + (0.35735475025851713168e-8 + (0.20369760937017070382e-10 + 0.91262442613333333334e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 71: { + double t = 2 * y100 - 143; + return 0.30679050522528838613e0 + + (0.58714723032745403331e-2 + + (0.62248031602197686791e-4 + + (0.53724185766200945789e-6 + + (0.37827999418960232678e-8 + (0.21490291930444538307e-10 + 0.95513539182222222221e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 72: { + double t = 2 * y100 - 145; + return 0.31878680111173319425e0 + + (0.61270341192339103514e-2 + + (0.65564012259707640976e-4 + + (0.56837930287837738996e-6 + + (0.40035151353392378882e-8 + (0.22662596341239294792e-10 + 0.99891109760000000000e-13 * t) * t) * t) * + t) * + t) * + t; + } + case 73: { + double t = 2 * y100 - 147; + return 0.33130773722152622027e0 + + (0.63962406646798080903e-2 + + (0.69072209592942396666e-4 + + (0.60133006661885941812e-6 + + (0.42362183765883466691e-8 + (0.23888182347073698382e-10 + 0.10439349811555555556e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 74: { + double t = 2 * y100 - 149; + return 0.34438138658041336523e0 + + (0.66798829540414007258e-2 + + (0.72783795518603561144e-4 + + (0.63619220443228800680e-6 + + (0.44814499336514453364e-8 + (0.25168535651285475274e-10 + 0.10901861383111111111e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 75: { + double t = 2 * y100 - 151; + return 0.35803744972380175583e0 + + (0.69787978834882685031e-2 + + (0.76710543371454822497e-4 + + (0.67306815308917386747e-6 + + (0.47397647975845228205e-8 + (0.26505114141143050509e-10 + 0.11376390933333333333e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 76: { + double t = 2 * y100 - 153; + return 0.37230734890119724188e0 + + (0.72938706896461381003e-2 + + (0.80864854542670714092e-4 + + (0.71206484718062688779e-6 + + (0.50117323769745883805e-8 + (0.27899342394100074165e-10 + 0.11862637614222222222e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 77: { + double t = 2 * y100 - 155; + return 0.38722432730555448223e0 + + (0.76260375162549802745e-2 + + (0.85259785810004603848e-4 + + (0.75329383305171327677e-6 + + (0.52979361368388119355e-8 + (0.29352606054164086709e-10 + 0.12360253370666666667e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 78: { + double t = 2 * y100 - 157; + return 0.40282355354616940667e0 + + (0.79762880915029728079e-2 + + (0.89909077342438246452e-4 + + (0.79687137961956194579e-6 + + (0.55989731807360403195e-8 + (0.30866246101464869050e-10 + 0.12868841946666666667e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 79: { + double t = 2 * y100 - 159; + return 0.41914223158913787649e0 + + (0.83456685186950463538e-2 + + (0.94827181359250161335e-4 + + (0.84291858561783141014e-6 + + (0.59154537751083485684e-8 + (0.32441553034347469291e-10 + 0.13387957943111111111e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 80: { + double t = 2 * y100 - 161; + return 0.43621971639463786896e0 + + (0.87352841828289495773e-2 + + (0.10002929142066799966e-3 + + (0.89156148280219880024e-6 + + (0.62480008150788597147e-8 + (0.34079760983458878910e-10 + 0.13917107176888888889e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 81: { + double t = 2 * y100 - 163; + return 0.45409763548534330981e0 + + (0.91463027755548240654e-2 + + (0.10553137232446167258e-3 + + (0.94293113464638623798e-6 + + (0.65972492312219959885e-8 + (0.35782041795476563662e-10 + 0.14455745872000000000e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 82: { + double t = 2 * y100 - 165; + return 0.47282001668512331468e0 + + (0.95799574408860463394e-2 + + (0.11135019058000067469e-3 + + (0.99716373005509038080e-6 + + (0.69638453369956970347e-8 + (0.37549499088161345850e-10 + 0.15003280712888888889e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 83: { + double t = 2 * y100 - 167; + return 0.49243342227179841649e0 + + (0.10037550043909497071e-1 + + (0.11750334542845234952e-3 + + (0.10544006716188967172e-5 + + (0.73484461168242224872e-8 + (0.39383162326435752965e-10 + 0.15559069118222222222e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 84: { + double t = 2 * y100 - 169; + return 0.51298708979209258326e0 + + (0.10520454564612427224e-1 + + (0.12400930037494996655e-3 + + (0.11147886579371265246e-5 + + (0.77517184550568711454e-8 + (0.41283980931872622611e-10 + 0.16122419680000000000e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 85: { + double t = 2 * y100 - 171; + return 0.53453307979101369843e0 + + (0.11030120618800726938e-1 + + (0.13088741519572269581e-3 + + (0.11784797595374515432e-5 + + (0.81743383063044825400e-8 + (0.43252818449517081051e-10 + 0.16692592640000000000e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 86: { + double t = 2 * y100 - 173; + return 0.55712643071169299478e0 + + (0.11568077107929735233e-1 + + (0.13815797838036651289e-3 + + (0.12456314879260904558e-5 + + (0.86169898078969313597e-8 + (0.45290446811539652525e-10 + 0.17268801084444444444e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 87: { + double t = 2 * y100 - 175; + return 0.58082532122519320968e0 + + (0.12135935999503877077e-1 + + (0.14584223996665838559e-3 + + (0.13164068573095710742e-5 + + (0.90803643355106020163e-8 + (0.47397540713124619155e-10 + 0.17850211608888888889e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 88: { + double t = 2 * y100 - 177; + return 0.60569124025293375554e0 + + (0.12735396239525550361e-1 + + (0.15396244472258863344e-3 + + (0.13909744385382818253e-5 + + (0.95651595032306228245e-8 + (0.49574672127669041550e-10 + 0.18435945564444444444e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 89: { + double t = 2 * y100 - 179; + return 0.63178916494715716894e0 + + (0.13368247798287030927e-1 + + (0.16254186562762076141e-3 + + (0.14695084048334056083e-5 + + (0.10072078109604152350e-7 + (0.51822304995680707483e-10 + 0.19025081422222222222e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 90: { + double t = 2 * y100 - 181; + return 0.65918774689725319200e0 + + (0.14036375850601992063e-1 + + (0.17160483760259706354e-3 + + (0.15521885688723188371e-5 + + (0.10601827031535280590e-7 + (0.54140790105837520499e-10 + 0.19616655146666666667e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 91: { + double t = 2 * y100 - 183; + return 0.68795950683174433822e0 + + (0.14741765091365869084e-1 + + (0.18117679143520433835e-3 + + (0.16392004108230585213e-5 + + (0.11155116068018043001e-7 + (0.56530360194925690374e-10 + 0.20209663662222222222e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 92: { + double t = 2 * y100 - 185; + return 0.71818103808729967036e0 + + (0.15486504187117112279e-1 + + (0.19128428784550923217e-3 + + (0.17307350969359975848e-5 + + (0.11732656736113607751e-7 + (0.58991125287563833603e-10 + 0.20803065333333333333e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 93: { + double t = 2 * y100 - 187; + return 0.74993321911726254661e0 + + (0.16272790364044783382e-1 + + (0.20195505163377912645e-3 + + (0.18269894883203346953e-5 + + (0.12335161021630225535e-7 + (0.61523068312169087227e-10 + 0.21395783431111111111e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 94: { + double t = 2 * y100 - 189; + return 0.78330143531283492729e0 + + (0.17102934132652429240e-1 + + (0.21321800585063327041e-3 + + (0.19281661395543913713e-5 + + (0.12963340087354341574e-7 + (0.64126040998066348872e-10 + 0.21986708942222222222e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 95: { + double t = 2 * y100 - 191; + return 0.81837581041023811832e0 + + (0.17979364149044223802e-1 + + (0.22510330592753129006e-3 + + (0.20344732868018175389e-5 + + (0.13617902941839949718e-7 + (0.66799760083972474642e-10 + 0.22574701262222222222e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 96: { + double t = 2 * y100 - 193; + return 0.85525144775685126237e0 + + (0.18904632212547561026e-1 + + (0.23764237370371255638e-3 + + (0.21461248251306387979e-5 + + (0.14299555071870523786e-7 + (0.69543803864694171934e-10 + 0.23158593688888888889e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 97: { + double t = 2 * y100 - 195; + return 0.89402868170849933734e0 + + (0.19881418399127202569e-1 + + (0.25086793128395995798e-3 + + (0.22633402747585233180e-5 + + (0.15008997042116532283e-7 + (0.72357609075043941261e-10 + 0.23737194737777777778e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 98: { + double t = 2 * y100 - 197; + return 0.93481333942870796363e0 + + (0.20912536329780368893e-1 + + (0.26481403465998477969e-3 + + (0.23863447359754921676e-5 + + (0.15746923065472184451e-7 + (0.75240468141720143653e-10 + 0.24309291271111111111e-12 * t) * t) * t) * + t) * + t) * + t; + } + case 99: { + double t = 2 * y100 - 199; + return 0.97771701335885035464e0 + + (0.22000938572830479551e-1 + + (0.27951610702682383001e-3 + + (0.25153688325245314530e-5 + + (0.16514019547822821453e-7 + (0.78191526829368231251e-10 + 0.24873652355555555556e-12 * t) * t) * t) * + t) * + t) * + t; + } + } + // we only get here if y = 1, i.e. |x| < 4*eps, in which case + // erfcx is within 1e-15 of 1.. + return 1.0; +} + +double erfcx(double x) { + if (x >= 0) { + if (x > 50) { // continued-fraction expansion is faster + const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi) + if (x > 5e7) // 1-term expansion, important to avoid overflow + return ispi / x; + /* 5-term expansion (rely on compiler for CSE), simplified from: + ispi / (x+0.5/(x+1/(x+1.5/(x+2/x)))) */ + return ispi * ((x * x) * (x * x + 4.5) + 2) / (x * ((x * x) * (x * x + 5) + 3.75)); + } + return erfcx_y100(400 / (4 + x)); + } else + return x < -26.7 ? HUGE_VAL : (x < -6.1 ? 2 * exp(x * x) : 2 * exp(x * x) - erfcx_y100(400 / (4 - x))); } ///////////////////////////////////////////////////////////////////////// -/* Compute a scaled Dawson integral +/* Compute a scaled Dawson integral Faddeeva::w_im(x) = 2*Dawson(x)/sqrt(pi) equivalent to the imaginary part w(x) for real x. Uses methods similar to the erfcx calculation above: continued fractions for large |x|, a lookup table of Chebyshev polynomials for smaller |x|, and finally a Taylor expansion for |x|<0.01. - + Steven G. Johnson, October 2012. */ /* Given y100=100*y, where y = 1/(1+x) for x >= 0, compute w_im(x). @@ -1318,441 +1973,1332 @@ double erfcx(double x) the Chebyshev polynomials to be of significantly lower degree (about 1/30) compared to fitting the whole [0,1] interval with a single polynomial. */ double w_im_y100(double y100, double x) { - switch ((int) y100) { + switch ((int)y100) { case 0: { - double t = 2*y100 - 1; - return 0.28351593328822191546e-2 + (0.28494783221378400759e-2 + (0.14427470563276734183e-4 + (0.10939723080231588129e-6 + (0.92474307943275042045e-9 + (0.89128907666450075245e-11 + 0.92974121935111111110e-13 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 1; + return 0.28351593328822191546e-2 + + (0.28494783221378400759e-2 + + (0.14427470563276734183e-4 + + (0.10939723080231588129e-6 + + (0.92474307943275042045e-9 + (0.89128907666450075245e-11 + 0.92974121935111111110e-13 * t) * t) * t) * + t) * + t) * + t; } case 1: { - double t = 2*y100 - 3; - return 0.85927161243940350562e-2 + (0.29085312941641339862e-2 + (0.15106783707725582090e-4 + (0.11716709978531327367e-6 + (0.10197387816021040024e-8 + (0.10122678863073360769e-10 + 0.10917479678400000000e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 3; + return 0.85927161243940350562e-2 + + (0.29085312941641339862e-2 + + (0.15106783707725582090e-4 + + (0.11716709978531327367e-6 + + (0.10197387816021040024e-8 + (0.10122678863073360769e-10 + 0.10917479678400000000e-12 * t) * t) * t) * + t) * + t) * + t; } case 2: { - double t = 2*y100 - 5; - return 0.14471159831187703054e-1 + (0.29703978970263836210e-2 + (0.15835096760173030976e-4 + (0.12574803383199211596e-6 + (0.11278672159518415848e-8 + (0.11547462300333495797e-10 + 0.12894535335111111111e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 5; + return 0.14471159831187703054e-1 + + (0.29703978970263836210e-2 + + (0.15835096760173030976e-4 + + (0.12574803383199211596e-6 + + (0.11278672159518415848e-8 + (0.11547462300333495797e-10 + 0.12894535335111111111e-12 * t) * t) * t) * + t) * + t) * + t; } case 3: { - double t = 2*y100 - 7; - return 0.20476320420324610618e-1 + (0.30352843012898665856e-2 + (0.16617609387003727409e-4 + (0.13525429711163116103e-6 + (0.12515095552507169013e-8 + (0.13235687543603382345e-10 + 0.15326595042666666667e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 7; + return 0.20476320420324610618e-1 + + (0.30352843012898665856e-2 + + (0.16617609387003727409e-4 + + (0.13525429711163116103e-6 + + (0.12515095552507169013e-8 + (0.13235687543603382345e-10 + 0.15326595042666666667e-12 * t) * t) * t) * + t) * + t) * + t; } case 4: { - double t = 2*y100 - 9; - return 0.26614461952489004566e-1 + (0.31034189276234947088e-2 + (0.17460268109986214274e-4 + (0.14582130824485709573e-6 + (0.13935959083809746345e-8 + (0.15249438072998932900e-10 + 0.18344741882133333333e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 9; + return 0.26614461952489004566e-1 + + (0.31034189276234947088e-2 + + (0.17460268109986214274e-4 + + (0.14582130824485709573e-6 + + (0.13935959083809746345e-8 + (0.15249438072998932900e-10 + 0.18344741882133333333e-12 * t) * t) * t) * + t) * + t) * + t; } case 5: { - double t = 2*y100 - 11; - return 0.32892330248093586215e-1 + (0.31750557067975068584e-2 + (0.18369907582308672632e-4 + (0.15761063702089457882e-6 + (0.15577638230480894382e-8 + (0.17663868462699097951e-10 + (0.22126732680711111111e-12 + 0.30273474177737853668e-14 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 11; + return 0.32892330248093586215e-1 + + (0.31750557067975068584e-2 + + (0.18369907582308672632e-4 + + (0.15761063702089457882e-6 + + (0.15577638230480894382e-8 + + (0.17663868462699097951e-10 + (0.22126732680711111111e-12 + 0.30273474177737853668e-14 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 6: { - double t = 2*y100 - 13; - return 0.39317207681134336024e-1 + (0.32504779701937539333e-2 + (0.19354426046513400534e-4 + (0.17081646971321290539e-6 + (0.17485733959327106250e-8 + (0.20593687304921961410e-10 + (0.26917401949155555556e-12 + 0.38562123837725712270e-14 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 13; + return 0.39317207681134336024e-1 + + (0.32504779701937539333e-2 + + (0.19354426046513400534e-4 + + (0.17081646971321290539e-6 + + (0.17485733959327106250e-8 + + (0.20593687304921961410e-10 + (0.26917401949155555556e-12 + 0.38562123837725712270e-14 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 7: { - double t = 2*y100 - 15; - return 0.45896976511367738235e-1 + (0.33300031273110976165e-2 + (0.20423005398039037313e-4 + (0.18567412470376467303e-6 + (0.19718038363586588213e-8 + (0.24175006536781219807e-10 + (0.33059982791466666666e-12 + 0.49756574284439426165e-14 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 15; + return 0.45896976511367738235e-1 + + (0.33300031273110976165e-2 + + (0.20423005398039037313e-4 + + (0.18567412470376467303e-6 + + (0.19718038363586588213e-8 + + (0.24175006536781219807e-10 + (0.33059982791466666666e-12 + 0.49756574284439426165e-14 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 8: { - double t = 2*y100 - 17; - return 0.52640192524848962855e-1 + (0.34139883358846720806e-2 + (0.21586390240603337337e-4 + (0.20247136501568904646e-6 + (0.22348696948197102935e-8 + (0.28597516301950162548e-10 + (0.41045502119111111110e-12 + 0.65151614515238361946e-14 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 17; + return 0.52640192524848962855e-1 + + (0.34139883358846720806e-2 + + (0.21586390240603337337e-4 + + (0.20247136501568904646e-6 + + (0.22348696948197102935e-8 + + (0.28597516301950162548e-10 + (0.41045502119111111110e-12 + 0.65151614515238361946e-14 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 9: { - double t = 2*y100 - 19; - return 0.59556171228656770456e-1 + (0.35028374386648914444e-2 + (0.22857246150998562824e-4 + (0.22156372146525190679e-6 + (0.25474171590893813583e-8 + (0.34122390890697400584e-10 + (0.51593189879111111110e-12 + 0.86775076853908006938e-14 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 19; + return 0.59556171228656770456e-1 + + (0.35028374386648914444e-2 + + (0.22857246150998562824e-4 + + (0.22156372146525190679e-6 + + (0.25474171590893813583e-8 + + (0.34122390890697400584e-10 + (0.51593189879111111110e-12 + 0.86775076853908006938e-14 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 10: { - double t = 2*y100 - 21; - return 0.66655089485108212551e-1 + (0.35970095381271285568e-2 + (0.24250626164318672928e-4 + (0.24339561521785040536e-6 + (0.29221990406518411415e-8 + (0.41117013527967776467e-10 + (0.65786450716444444445e-12 + 0.11791885745450623331e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 21; + return 0.66655089485108212551e-1 + + (0.35970095381271285568e-2 + + (0.24250626164318672928e-4 + + (0.24339561521785040536e-6 + + (0.29221990406518411415e-8 + + (0.41117013527967776467e-10 + (0.65786450716444444445e-12 + 0.11791885745450623331e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 11: { - double t = 2*y100 - 23; - return 0.73948106345519174661e-1 + (0.36970297216569341748e-2 + (0.25784588137312868792e-4 + (0.26853012002366752770e-6 + (0.33763958861206729592e-8 + (0.50111549981376976397e-10 + (0.85313857496888888890e-12 + 0.16417079927706899860e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 23; + return 0.73948106345519174661e-1 + + (0.36970297216569341748e-2 + + (0.25784588137312868792e-4 + + (0.26853012002366752770e-6 + + (0.33763958861206729592e-8 + + (0.50111549981376976397e-10 + (0.85313857496888888890e-12 + 0.16417079927706899860e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 12: { - double t = 2*y100 - 25; - return 0.81447508065002963203e-1 + (0.38035026606492705117e-2 + (0.27481027572231851896e-4 + (0.29769200731832331364e-6 + (0.39336816287457655076e-8 + (0.61895471132038157624e-10 + (0.11292303213511111111e-11 + 0.23558532213703884304e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 25; + return 0.81447508065002963203e-1 + + (0.38035026606492705117e-2 + + (0.27481027572231851896e-4 + + (0.29769200731832331364e-6 + + (0.39336816287457655076e-8 + + (0.61895471132038157624e-10 + (0.11292303213511111111e-11 + 0.23558532213703884304e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 13: { - double t = 2*y100 - 27; - return 0.89166884027582716628e-1 + (0.39171301322438946014e-2 + (0.29366827260422311668e-4 + (0.33183204390350724895e-6 + (0.46276006281647330524e-8 + (0.77692631378169813324e-10 + (0.15335153258844444444e-11 + 0.35183103415916026911e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 27; + return 0.89166884027582716628e-1 + + (0.39171301322438946014e-2 + + (0.29366827260422311668e-4 + + (0.33183204390350724895e-6 + + (0.46276006281647330524e-8 + + (0.77692631378169813324e-10 + (0.15335153258844444444e-11 + 0.35183103415916026911e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 14: { - double t = 2*y100 - 29; - return 0.97121342888032322019e-1 + (0.40387340353207909514e-2 + (0.31475490395950776930e-4 + (0.37222714227125135042e-6 + (0.55074373178613809996e-8 + (0.99509175283990337944e-10 + (0.21552645758222222222e-11 + 0.55728651431872687605e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 29; + return 0.97121342888032322019e-1 + + (0.40387340353207909514e-2 + + (0.31475490395950776930e-4 + + (0.37222714227125135042e-6 + + (0.55074373178613809996e-8 + + (0.99509175283990337944e-10 + (0.21552645758222222222e-11 + 0.55728651431872687605e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 15: { - double t = 2*y100 - 31; - return 0.10532778218603311137e0 + (0.41692873614065380607e-2 + (0.33849549774889456984e-4 + (0.42064596193692630143e-6 + (0.66494579697622432987e-8 + (0.13094103581931802337e-9 + (0.31896187409777777778e-11 + 0.97271974184476560742e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 31; + return 0.10532778218603311137e0 + + (0.41692873614065380607e-2 + + (0.33849549774889456984e-4 + + (0.42064596193692630143e-6 + + (0.66494579697622432987e-8 + + (0.13094103581931802337e-9 + (0.31896187409777777778e-11 + 0.97271974184476560742e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 16: { - double t = 2*y100 - 33; - return 0.11380523107427108222e0 + (0.43099572287871821013e-2 + (0.36544324341565929930e-4 + (0.47965044028581857764e-6 + (0.81819034238463698796e-8 + (0.17934133239549647357e-9 + (0.50956666166186293627e-11 + (0.18850487318190638010e-12 + 0.79697813173519853340e-14 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 33; + return 0.11380523107427108222e0 + + (0.43099572287871821013e-2 + + (0.36544324341565929930e-4 + + (0.47965044028581857764e-6 + + (0.81819034238463698796e-8 + + (0.17934133239549647357e-9 + + (0.50956666166186293627e-11 + (0.18850487318190638010e-12 + 0.79697813173519853340e-14 * t) * t) * t + ) * t) * + t) * + t) * + t) * + t; } case 17: { - double t = 2*y100 - 35; - return 0.12257529703447467345e0 + (0.44621675710026986366e-2 + (0.39634304721292440285e-4 + (0.55321553769873381819e-6 + (0.10343619428848520870e-7 + (0.26033830170470368088e-9 + (0.87743837749108025357e-11 + (0.34427092430230063401e-12 + 0.10205506615709843189e-13 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 35; + return 0.12257529703447467345e0 + + (0.44621675710026986366e-2 + + (0.39634304721292440285e-4 + + (0.55321553769873381819e-6 + + (0.10343619428848520870e-7 + + (0.26033830170470368088e-9 + + (0.87743837749108025357e-11 + (0.34427092430230063401e-12 + 0.10205506615709843189e-13 * t) * t) * t + ) * t) * + t) * + t) * + t) * + t; } case 18: { - double t = 2*y100 - 37; - return 0.13166276955656699478e0 + (0.46276970481783001803e-2 + (0.43225026380496399310e-4 + (0.64799164020016902656e-6 + (0.13580082794704641782e-7 + (0.39839800853954313927e-9 + (0.14431142411840000000e-10 + 0.42193457308830027541e-12 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 37; + return 0.13166276955656699478e0 + + (0.46276970481783001803e-2 + + (0.43225026380496399310e-4 + + (0.64799164020016902656e-6 + + (0.13580082794704641782e-7 + + (0.39839800853954313927e-9 + (0.14431142411840000000e-10 + 0.42193457308830027541e-12 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 19: { - double t = 2*y100 - 39; - return 0.14109647869803356475e0 + (0.48088424418545347758e-2 + (0.47474504753352150205e-4 + (0.77509866468724360352e-6 + (0.18536851570794291724e-7 + (0.60146623257887570439e-9 + (0.18533978397305276318e-10 + (0.41033845938901048380e-13 - 0.46160680279304825485e-13 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 39; + return 0.14109647869803356475e0 + + (0.48088424418545347758e-2 + + (0.47474504753352150205e-4 + + (0.77509866468724360352e-6 + + (0.18536851570794291724e-7 + + (0.60146623257887570439e-9 + + (0.18533978397305276318e-10 + (0.41033845938901048380e-13 - 0.46160680279304825485e-13 * t) * t) * t + ) * t) * + t) * + t) * + t) * + t; } case 20: { - double t = 2*y100 - 41; - return 0.15091057940548936603e0 + (0.50086864672004685703e-2 + (0.52622482832192230762e-4 + (0.95034664722040355212e-6 + (0.25614261331144718769e-7 + (0.80183196716888606252e-9 + (0.12282524750534352272e-10 + (-0.10531774117332273617e-11 - 0.86157181395039646412e-13 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 41; + return 0.15091057940548936603e0 + + (0.50086864672004685703e-2 + + (0.52622482832192230762e-4 + + (0.95034664722040355212e-6 + + (0.25614261331144718769e-7 + + (0.80183196716888606252e-9 + + (0.12282524750534352272e-10 + (-0.10531774117332273617e-11 - 0.86157181395039646412e-13 * t) * t) * + t) * + t) * + t) * + t) * + t) * + t; } case 21: { - double t = 2*y100 - 43; - return 0.16114648116017010770e0 + (0.52314661581655369795e-2 + (0.59005534545908331315e-4 + (0.11885518333915387760e-5 + (0.33975801443239949256e-7 + (0.82111547144080388610e-9 + (-0.12357674017312854138e-10 + (-0.24355112256914479176e-11 - 0.75155506863572930844e-13 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 43; + return 0.16114648116017010770e0 + + (0.52314661581655369795e-2 + + (0.59005534545908331315e-4 + + (0.11885518333915387760e-5 + + (0.33975801443239949256e-7 + + (0.82111547144080388610e-9 + + (-0.12357674017312854138e-10 + (-0.24355112256914479176e-11 - 0.75155506863572930844e-13 * t) * t) * + t) * + t) * + t) * + t) * + t) * + t; } case 22: { - double t = 2*y100 - 45; - return 0.17185551279680451144e0 + (0.54829002967599420860e-2 + (0.67013226658738082118e-4 + (0.14897400671425088807e-5 + (0.40690283917126153701e-7 + (0.44060872913473778318e-9 + (-0.52641873433280000000e-10 - 0.30940587864543343124e-11 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 45; + return 0.17185551279680451144e0 + + (0.54829002967599420860e-2 + + (0.67013226658738082118e-4 + + (0.14897400671425088807e-5 + + (0.40690283917126153701e-7 + + (0.44060872913473778318e-9 + (-0.52641873433280000000e-10 - 0.30940587864543343124e-11 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 23: { - double t = 2*y100 - 47; - return 0.18310194559815257381e0 + (0.57701559375966953174e-2 + (0.76948789401735193483e-4 + (0.18227569842290822512e-5 + (0.41092208344387212276e-7 + (-0.44009499965694442143e-9 + (-0.92195414685628803451e-10 + (-0.22657389705721753299e-11 + 0.10004784908106839254e-12 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 47; + return 0.18310194559815257381e0 + + (0.57701559375966953174e-2 + + (0.76948789401735193483e-4 + + (0.18227569842290822512e-5 + + (0.41092208344387212276e-7 + + (-0.44009499965694442143e-9 + + (-0.92195414685628803451e-10 + (-0.22657389705721753299e-11 + 0.10004784908106839254e-12 * t) * t) * + t) * + t) * + t) * + t) * + t) * + t; } case 24: { - double t = 2*y100 - 49; - return 0.19496527191546630345e0 + (0.61010853144364724856e-2 + (0.88812881056342004864e-4 + (0.21180686746360261031e-5 + (0.30652145555130049203e-7 + (-0.16841328574105890409e-8 + (-0.11008129460612823934e-9 + (-0.12180794204544515779e-12 + 0.15703325634590334097e-12 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 49; + return 0.19496527191546630345e0 + + (0.61010853144364724856e-2 + + (0.88812881056342004864e-4 + + (0.21180686746360261031e-5 + + (0.30652145555130049203e-7 + + (-0.16841328574105890409e-8 + + (-0.11008129460612823934e-9 + (-0.12180794204544515779e-12 + 0.15703325634590334097e-12 * t) * t) * + t) * + t) * + t) * + t) * + t) * + t; } case 25: { - double t = 2*y100 - 51; - return 0.20754006813966575720e0 + (0.64825787724922073908e-2 + (0.10209599627522311893e-3 + (0.22785233392557600468e-5 + (0.73495224449907568402e-8 + (-0.29442705974150112783e-8 + (-0.94082603434315016546e-10 + (0.23609990400179321267e-11 + 0.14141908654269023788e-12 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 51; + return 0.20754006813966575720e0 + + (0.64825787724922073908e-2 + + (0.10209599627522311893e-3 + + (0.22785233392557600468e-5 + + (0.73495224449907568402e-8 + + (-0.29442705974150112783e-8 + + (-0.94082603434315016546e-10 + (0.23609990400179321267e-11 + 0.14141908654269023788e-12 * t) * t) * + t) * + t) * + t) * + t) * + t) * + t; } case 26: { - double t = 2*y100 - 53; - return 0.22093185554845172146e0 + (0.69182878150187964499e-2 + (0.11568723331156335712e-3 + (0.22060577946323627739e-5 + (-0.26929730679360840096e-7 + (-0.38176506152362058013e-8 + (-0.47399503861054459243e-10 + (0.40953700187172127264e-11 + 0.69157730376118511127e-13 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 53; + return 0.22093185554845172146e0 + + (0.69182878150187964499e-2 + + (0.11568723331156335712e-3 + + (0.22060577946323627739e-5 + + (-0.26929730679360840096e-7 + + (-0.38176506152362058013e-8 + + (-0.47399503861054459243e-10 + (0.40953700187172127264e-11 + 0.69157730376118511127e-13 * t) * t) * + t) * + t) * + t) * + t) * + t) * + t; } case 27: { - double t = 2*y100 - 55; - return 0.23524827304057813918e0 + (0.74063350762008734520e-2 + (0.12796333874615790348e-3 + (0.18327267316171054273e-5 + (-0.66742910737957100098e-7 + (-0.40204740975496797870e-8 + (0.14515984139495745330e-10 + (0.44921608954536047975e-11 - 0.18583341338983776219e-13 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 55; + return 0.23524827304057813918e0 + + (0.74063350762008734520e-2 + + (0.12796333874615790348e-3 + + (0.18327267316171054273e-5 + + (-0.66742910737957100098e-7 + + (-0.40204740975496797870e-8 + + (0.14515984139495745330e-10 + (0.44921608954536047975e-11 - 0.18583341338983776219e-13 * t) * t) * t + ) * t) * + t) * + t) * + t) * + t; } case 28: { - double t = 2*y100 - 57; - return 0.25058626331812744775e0 + (0.79377285151602061328e-2 + (0.13704268650417478346e-3 + (0.11427511739544695861e-5 + (-0.10485442447768377485e-6 + (-0.34850364756499369763e-8 + (0.72656453829502179208e-10 + (0.36195460197779299406e-11 - 0.84882136022200714710e-13 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 57; + return 0.25058626331812744775e0 + + (0.79377285151602061328e-2 + + (0.13704268650417478346e-3 + + (0.11427511739544695861e-5 + + (-0.10485442447768377485e-6 + + (-0.34850364756499369763e-8 + + (0.72656453829502179208e-10 + (0.36195460197779299406e-11 - 0.84882136022200714710e-13 * t) * t) * t + ) * t) * + t) * + t) * + t) * + t; } case 29: { - double t = 2*y100 - 59; - return 0.26701724900280689785e0 + (0.84959936119625864274e-2 + (0.14112359443938883232e-3 + (0.17800427288596909634e-6 + (-0.13443492107643109071e-6 + (-0.23512456315677680293e-8 + (0.11245846264695936769e-9 + (0.19850501334649565404e-11 - 0.11284666134635050832e-12 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 59; + return 0.26701724900280689785e0 + + (0.84959936119625864274e-2 + + (0.14112359443938883232e-3 + + (0.17800427288596909634e-6 + + (-0.13443492107643109071e-6 + + (-0.23512456315677680293e-8 + + (0.11245846264695936769e-9 + (0.19850501334649565404e-11 - 0.11284666134635050832e-12 * t) * t) * t + ) * t) * + t) * + t) * + t) * + t; } case 30: { - double t = 2*y100 - 61; - return 0.28457293586253654144e0 + (0.90581563892650431899e-2 + (0.13880520331140646738e-3 + (-0.97262302362522896157e-6 + (-0.15077100040254187366e-6 + (-0.88574317464577116689e-9 + (0.12760311125637474581e-9 + (0.20155151018282695055e-12 - 0.10514169375181734921e-12 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 61; + return 0.28457293586253654144e0 + + (0.90581563892650431899e-2 + + (0.13880520331140646738e-3 + + (-0.97262302362522896157e-6 + + (-0.15077100040254187366e-6 + + (-0.88574317464577116689e-9 + + (0.12760311125637474581e-9 + (0.20155151018282695055e-12 - 0.10514169375181734921e-12 * t) * t) * t + ) * t) * + t) * + t) * + t) * + t; } case 31: { - double t = 2*y100 - 63; - return 0.30323425595617385705e0 + (0.95968346790597422934e-2 + (0.12931067776725883939e-3 + (-0.21938741702795543986e-5 + (-0.15202888584907373963e-6 + (0.61788350541116331411e-9 + (0.11957835742791248256e-9 + (-0.12598179834007710908e-11 - 0.75151817129574614194e-13 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 63; + return 0.30323425595617385705e0 + + (0.95968346790597422934e-2 + + (0.12931067776725883939e-3 + + (-0.21938741702795543986e-5 + + (-0.15202888584907373963e-6 + + (0.61788350541116331411e-9 + + (0.11957835742791248256e-9 + (-0.12598179834007710908e-11 - 0.75151817129574614194e-13 * t) * t) * t + ) * t) * + t) * + t) * + t) * + t; } case 32: { - double t = 2*y100 - 65; - return 0.32292521181517384379e0 + (0.10082957727001199408e-1 + (0.11257589426154962226e-3 + (-0.33670890319327881129e-5 + (-0.13910529040004008158e-6 + (0.19170714373047512945e-8 + (0.94840222377720494290e-10 + (-0.21650018351795353201e-11 - 0.37875211678024922689e-13 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 65; + return 0.32292521181517384379e0 + + (0.10082957727001199408e-1 + + (0.11257589426154962226e-3 + + (-0.33670890319327881129e-5 + + (-0.13910529040004008158e-6 + + (0.19170714373047512945e-8 + + (0.94840222377720494290e-10 + (-0.21650018351795353201e-11 - 0.37875211678024922689e-13 * t) * t) * + t) * + t) * + t) * + t) * + t) * + t; } case 33: { - double t = 2*y100 - 67; - return 0.34351233557911753862e0 + (0.10488575435572745309e-1 + (0.89209444197248726614e-4 + (-0.43893459576483345364e-5 + (-0.11488595830450424419e-6 + (0.28599494117122464806e-8 + (0.61537542799857777779e-10 - 0.24935749227658002212e-11 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 67; + return 0.34351233557911753862e0 + + (0.10488575435572745309e-1 + + (0.89209444197248726614e-4 + + (-0.43893459576483345364e-5 + + (-0.11488595830450424419e-6 + + (0.28599494117122464806e-8 + (0.61537542799857777779e-10 - 0.24935749227658002212e-11 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 34: { - double t = 2*y100 - 69; - return 0.36480946642143669093e0 + (0.10789304203431861366e-1 + (0.60357993745283076834e-4 + (-0.51855862174130669389e-5 + (-0.83291664087289801313e-7 + (0.33898011178582671546e-8 + (0.27082948188277716482e-10 + (-0.23603379397408694974e-11 + 0.19328087692252869842e-13 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 69; + return 0.36480946642143669093e0 + + (0.10789304203431861366e-1 + + (0.60357993745283076834e-4 + + (-0.51855862174130669389e-5 + + (-0.83291664087289801313e-7 + + (0.33898011178582671546e-8 + + (0.27082948188277716482e-10 + (-0.23603379397408694974e-11 + 0.19328087692252869842e-13 * t) * t) * + t) * + t) * + t) * + t) * + t) * + t; } case 35: { - double t = 2*y100 - 71; - return 0.38658679935694939199e0 + (0.10966119158288804999e-1 + (0.27521612041849561426e-4 + (-0.57132774537670953638e-5 + (-0.48404772799207914899e-7 + (0.35268354132474570493e-8 + (-0.32383477652514618094e-11 + (-0.19334202915190442501e-11 + 0.32333189861286460270e-13 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 71; + return 0.38658679935694939199e0 + + (0.10966119158288804999e-1 + + (0.27521612041849561426e-4 + + (-0.57132774537670953638e-5 + + (-0.48404772799207914899e-7 + + (0.35268354132474570493e-8 + + (-0.32383477652514618094e-11 + (-0.19334202915190442501e-11 + 0.32333189861286460270e-13 * t) * t) * + t) * + t) * + t) * + t) * + t) * + t; } case 36: { - double t = 2*y100 - 73; - return 0.40858275583808707870e0 + (0.11006378016848466550e-1 + (-0.76396376685213286033e-5 + (-0.59609835484245791439e-5 + (-0.13834610033859313213e-7 + (0.33406952974861448790e-8 + (-0.26474915974296612559e-10 + (-0.13750229270354351983e-11 + 0.36169366979417390637e-13 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 73; + return 0.40858275583808707870e0 + + (0.11006378016848466550e-1 + + (-0.76396376685213286033e-5 + + (-0.59609835484245791439e-5 + + (-0.13834610033859313213e-7 + + (0.33406952974861448790e-8 + + (-0.26474915974296612559e-10 + (-0.13750229270354351983e-11 + 0.36169366979417390637e-13 * t) * t) * + t) * + t) * + t) * + t) * + t) * + t; } case 37: { - double t = 2*y100 - 75; - return 0.43051714914006682977e0 + (0.10904106549500816155e-1 + (-0.43477527256787216909e-4 + (-0.59429739547798343948e-5 + (0.17639200194091885949e-7 + (0.29235991689639918688e-8 + (-0.41718791216277812879e-10 + (-0.81023337739508049606e-12 + 0.33618915934461994428e-13 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 75; + return 0.43051714914006682977e0 + + (0.10904106549500816155e-1 + + (-0.43477527256787216909e-4 + + (-0.59429739547798343948e-5 + + (0.17639200194091885949e-7 + + (0.29235991689639918688e-8 + + (-0.41718791216277812879e-10 + (-0.81023337739508049606e-12 + 0.33618915934461994428e-13 * t) * t) * + t) * + t) * + t) * + t) * + t) * + t; } case 38: { - double t = 2*y100 - 77; - return 0.45210428135559607406e0 + (0.10659670756384400554e-1 + (-0.78488639913256978087e-4 + (-0.56919860886214735936e-5 + (0.44181850467477733407e-7 + (0.23694306174312688151e-8 + (-0.49492621596685443247e-10 + (-0.31827275712126287222e-12 + 0.27494438742721623654e-13 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 77; + return 0.45210428135559607406e0 + + (0.10659670756384400554e-1 + + (-0.78488639913256978087e-4 + + (-0.56919860886214735936e-5 + + (0.44181850467477733407e-7 + + (0.23694306174312688151e-8 + + (-0.49492621596685443247e-10 + (-0.31827275712126287222e-12 + 0.27494438742721623654e-13 * t) * t) * + t) * + t) * + t) * + t) * + t) * + t; } case 39: { - double t = 2*y100 - 79; - return 0.47306491195005224077e0 + (0.10279006119745977570e-1 + (-0.11140268171830478306e-3 + (-0.52518035247451432069e-5 + (0.64846898158889479518e-7 + (0.17603624837787337662e-8 + (-0.51129481592926104316e-10 + (0.62674584974141049511e-13 + 0.20055478560829935356e-13 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 79; + return 0.47306491195005224077e0 + + (0.10279006119745977570e-1 + + (-0.11140268171830478306e-3 + + (-0.52518035247451432069e-5 + + (0.64846898158889479518e-7 + + (0.17603624837787337662e-8 + + (-0.51129481592926104316e-10 + (0.62674584974141049511e-13 + 0.20055478560829935356e-13 * t) * t) * + t) * + t) * + t) * + t) * + t) * + t; } case 40: { - double t = 2*y100 - 81; - return 0.49313638965719857647e0 + (0.97725799114772017662e-2 + (-0.14122854267291533334e-3 + (-0.46707252568834951907e-5 + (0.79421347979319449524e-7 + (0.11603027184324708643e-8 + (-0.48269605844397175946e-10 + (0.32477251431748571219e-12 + 0.12831052634143527985e-13 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 81; + return 0.49313638965719857647e0 + + (0.97725799114772017662e-2 + + (-0.14122854267291533334e-3 + + (-0.46707252568834951907e-5 + + (0.79421347979319449524e-7 + + (0.11603027184324708643e-8 + + (-0.48269605844397175946e-10 + (0.32477251431748571219e-12 + 0.12831052634143527985e-13 * t) * t) * + t) * + t) * + t) * + t) * + t) * + t; } case 41: { - double t = 2*y100 - 83; - return 0.51208057433416004042e0 + (0.91542422354009224951e-2 + (-0.16726530230228647275e-3 + (-0.39964621752527649409e-5 + (0.88232252903213171454e-7 + (0.61343113364949928501e-9 + (-0.42516755603130443051e-10 + (0.47910437172240209262e-12 + 0.66784341874437478953e-14 * t) * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 83; + return 0.51208057433416004042e0 + + (0.91542422354009224951e-2 + + (-0.16726530230228647275e-3 + + (-0.39964621752527649409e-5 + + (0.88232252903213171454e-7 + + (0.61343113364949928501e-9 + + (-0.42516755603130443051e-10 + (0.47910437172240209262e-12 + 0.66784341874437478953e-14 * t) * t) * + t) * + t) * + t) * + t) * + t) * + t; } case 42: { - double t = 2*y100 - 85; - return 0.52968945458607484524e0 + (0.84400880445116786088e-2 + (-0.18908729783854258774e-3 + (-0.32725905467782951931e-5 + (0.91956190588652090659e-7 + (0.14593989152420122909e-9 + (-0.35239490687644444445e-10 + 0.54613829888448694898e-12 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 85; + return 0.52968945458607484524e0 + + (0.84400880445116786088e-2 + + (-0.18908729783854258774e-3 + + (-0.32725905467782951931e-5 + + (0.91956190588652090659e-7 + + (0.14593989152420122909e-9 + (-0.35239490687644444445e-10 + 0.54613829888448694898e-12 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 43: { - double t = 2*y100 - 87; - return 0.54578857454330070965e0 + (0.76474155195880295311e-2 + (-0.20651230590808213884e-3 + (-0.25364339140543131706e-5 + (0.91455367999510681979e-7 + (-0.23061359005297528898e-9 + (-0.27512928625244444444e-10 + 0.54895806008493285579e-12 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 87; + return 0.54578857454330070965e0 + + (0.76474155195880295311e-2 + + (-0.20651230590808213884e-3 + + (-0.25364339140543131706e-5 + + (0.91455367999510681979e-7 + + (-0.23061359005297528898e-9 + (-0.27512928625244444444e-10 + 0.54895806008493285579e-12 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 44: { - double t = 2*y100 - 89; - return 0.56023851910298493910e0 + (0.67938321739997196804e-2 + (-0.21956066613331411760e-3 + (-0.18181127670443266395e-5 + (0.87650335075416845987e-7 + (-0.51548062050366615977e-9 + (-0.20068462174044444444e-10 + 0.50912654909758187264e-12 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 89; + return 0.56023851910298493910e0 + + (0.67938321739997196804e-2 + + (-0.21956066613331411760e-3 + + (-0.18181127670443266395e-5 + + (0.87650335075416845987e-7 + + (-0.51548062050366615977e-9 + (-0.20068462174044444444e-10 + 0.50912654909758187264e-12 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 45: { - double t = 2*y100 - 91; - return 0.57293478057455721150e0 + (0.58965321010394044087e-2 + (-0.22841145229276575597e-3 + (-0.11404605562013443659e-5 + (0.81430290992322326296e-7 + (-0.71512447242755357629e-9 + (-0.13372664928000000000e-10 + 0.44461498336689298148e-12 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 91; + return 0.57293478057455721150e0 + + (0.58965321010394044087e-2 + + (-0.22841145229276575597e-3 + + (-0.11404605562013443659e-5 + + (0.81430290992322326296e-7 + + (-0.71512447242755357629e-9 + (-0.13372664928000000000e-10 + 0.44461498336689298148e-12 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 46: { - double t = 2*y100 - 93; - return 0.58380635448407827360e0 + (0.49717469530842831182e-2 + (-0.23336001540009645365e-3 + (-0.51952064448608850822e-6 + (0.73596577815411080511e-7 + (-0.84020916763091566035e-9 + (-0.76700972702222222221e-11 + 0.36914462807972467044e-12 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 93; + return 0.58380635448407827360e0 + + (0.49717469530842831182e-2 + + (-0.23336001540009645365e-3 + + (-0.51952064448608850822e-6 + + (0.73596577815411080511e-7 + + (-0.84020916763091566035e-9 + (-0.76700972702222222221e-11 + 0.36914462807972467044e-12 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 47: { - double t = 2*y100 - 95; - return 0.59281340237769489597e0 + (0.40343592069379730568e-2 + (-0.23477963738658326185e-3 + (0.34615944987790224234e-7 + (0.64832803248395814574e-7 + (-0.90329163587627007971e-9 + (-0.30421940400000000000e-11 + 0.29237386653743536669e-12 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 95; + return 0.59281340237769489597e0 + + (0.40343592069379730568e-2 + + (-0.23477963738658326185e-3 + + (0.34615944987790224234e-7 + + (0.64832803248395814574e-7 + + (-0.90329163587627007971e-9 + (-0.30421940400000000000e-11 + 0.29237386653743536669e-12 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 48: { - double t = 2*y100 - 97; - return 0.59994428743114271918e0 + (0.30976579788271744329e-2 + (-0.23308875765700082835e-3 + (0.51681681023846925160e-6 + (0.55694594264948268169e-7 + (-0.91719117313243464652e-9 + (0.53982743680000000000e-12 + 0.22050829296187771142e-12 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 97; + return 0.59994428743114271918e0 + + (0.30976579788271744329e-2 + + (-0.23308875765700082835e-3 + + (0.51681681023846925160e-6 + + (0.55694594264948268169e-7 + + (-0.91719117313243464652e-9 + (0.53982743680000000000e-12 + 0.22050829296187771142e-12 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 49: { - double t = 2*y100 - 99; - return 0.60521224471819875444e0 + (0.21732138012345456060e-2 + (-0.22872428969625997456e-3 + (0.92588959922653404233e-6 + (0.46612665806531930684e-7 + (-0.89393722514414153351e-9 + (0.31718550353777777778e-11 + 0.15705458816080549117e-12 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 99; + return 0.60521224471819875444e0 + + (0.21732138012345456060e-2 + + (-0.22872428969625997456e-3 + + (0.92588959922653404233e-6 + + (0.46612665806531930684e-7 + + (-0.89393722514414153351e-9 + (0.31718550353777777778e-11 + 0.15705458816080549117e-12 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 50: { - double t = 2*y100 - 101; - return 0.60865189969791123620e0 + (0.12708480848877451719e-2 + (-0.22212090111534847166e-3 + (0.12636236031532793467e-5 + (0.37904037100232937574e-7 + (-0.84417089968101223519e-9 + (0.49843180828444444445e-11 + 0.10355439441049048273e-12 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 101; + return 0.60865189969791123620e0 + + (0.12708480848877451719e-2 + + (-0.22212090111534847166e-3 + + (0.12636236031532793467e-5 + + (0.37904037100232937574e-7 + + (-0.84417089968101223519e-9 + (0.49843180828444444445e-11 + 0.10355439441049048273e-12 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 51: { - double t = 2*y100 - 103; - return 0.61031580103499200191e0 + (0.39867436055861038223e-3 + (-0.21369573439579869291e-3 + (0.15339402129026183670e-5 + (0.29787479206646594442e-7 + (-0.77687792914228632974e-9 + (0.61192452741333333334e-11 + 0.60216691829459295780e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 103; + return 0.61031580103499200191e0 + + (0.39867436055861038223e-3 + + (-0.21369573439579869291e-3 + + (0.15339402129026183670e-5 + + (0.29787479206646594442e-7 + + (-0.77687792914228632974e-9 + (0.61192452741333333334e-11 + 0.60216691829459295780e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 52: { - double t = 2*y100 - 105; - return 0.61027109047879835868e0 + (-0.43680904508059878254e-3 + (-0.20383783788303894442e-3 + (0.17421743090883439959e-5 + (0.22400425572175715576e-7 + (-0.69934719320045128997e-9 + (0.67152759655111111110e-11 + 0.26419960042578359995e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 105; + return 0.61027109047879835868e0 + + (-0.43680904508059878254e-3 + + (-0.20383783788303894442e-3 + + (0.17421743090883439959e-5 + + (0.22400425572175715576e-7 + + (-0.69934719320045128997e-9 + (0.67152759655111111110e-11 + 0.26419960042578359995e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 53: { - double t = 2*y100 - 107; - return 0.60859639489217430521e0 + (-0.12305921390962936873e-2 + (-0.19290150253894682629e-3 + (0.18944904654478310128e-5 + (0.15815530398618149110e-7 + (-0.61726850580964876070e-9 + 0.68987888999111111110e-11 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 107; + return 0.60859639489217430521e0 + + (-0.12305921390962936873e-2 + + (-0.19290150253894682629e-3 + + (0.18944904654478310128e-5 + + (0.15815530398618149110e-7 + (-0.61726850580964876070e-9 + 0.68987888999111111110e-11 * t) * t) * t) * + t) * + t) * + t; } case 54: { - double t = 2*y100 - 109; - return 0.60537899426486075181e0 + (-0.19790062241395705751e-2 + (-0.18120271393047062253e-3 + (0.19974264162313241405e-5 + (0.10055795094298172492e-7 + (-0.53491997919318263593e-9 + (0.67794550295111111110e-11 - 0.17059208095741511603e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 109; + return 0.60537899426486075181e0 + + (-0.19790062241395705751e-2 + + (-0.18120271393047062253e-3 + + (0.19974264162313241405e-5 + + (0.10055795094298172492e-7 + + (-0.53491997919318263593e-9 + (0.67794550295111111110e-11 - 0.17059208095741511603e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 55: { - double t = 2*y100 - 111; - return 0.60071229457904110537e0 + (-0.26795676776166354354e-2 + (-0.16901799553627508781e-3 + (0.20575498324332621581e-5 + (0.51077165074461745053e-8 + (-0.45536079828057221858e-9 + (0.64488005516444444445e-11 - 0.29311677573152766338e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 111; + return 0.60071229457904110537e0 + + (-0.26795676776166354354e-2 + + (-0.16901799553627508781e-3 + + (0.20575498324332621581e-5 + + (0.51077165074461745053e-8 + + (-0.45536079828057221858e-9 + (0.64488005516444444445e-11 - 0.29311677573152766338e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 56: { - double t = 2*y100 - 113; - return 0.59469361520112714738e0 + (-0.33308208190600993470e-2 + (-0.15658501295912405679e-3 + (0.20812116912895417272e-5 + (0.93227468760614182021e-9 + (-0.38066673740116080415e-9 + (0.59806790359111111110e-11 - 0.36887077278950440597e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 113; + return 0.59469361520112714738e0 + + (-0.33308208190600993470e-2 + + (-0.15658501295912405679e-3 + + (0.20812116912895417272e-5 + + (0.93227468760614182021e-9 + + (-0.38066673740116080415e-9 + (0.59806790359111111110e-11 - 0.36887077278950440597e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 57: { - double t = 2*y100 - 115; - return 0.58742228631775388268e0 + (-0.39321858196059227251e-2 + (-0.14410441141450122535e-3 + (0.20743790018404020716e-5 + (-0.25261903811221913762e-8 + (-0.31212416519526924318e-9 + (0.54328422462222222221e-11 - 0.40864152484979815972e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 115; + return 0.58742228631775388268e0 + + (-0.39321858196059227251e-2 + + (-0.14410441141450122535e-3 + + (0.20743790018404020716e-5 + + (-0.25261903811221913762e-8 + + (-0.31212416519526924318e-9 + (0.54328422462222222221e-11 - 0.40864152484979815972e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 58: { - double t = 2*y100 - 117; - return 0.57899804200033018447e0 + (-0.44838157005618913447e-2 + (-0.13174245966501437965e-3 + (0.20425306888294362674e-5 + (-0.53330296023875447782e-8 + (-0.25041289435539821014e-9 + (0.48490437205333333334e-11 - 0.42162206939169045177e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 117; + return 0.57899804200033018447e0 + + (-0.44838157005618913447e-2 + + (-0.13174245966501437965e-3 + + (0.20425306888294362674e-5 + + (-0.53330296023875447782e-8 + + (-0.25041289435539821014e-9 + (0.48490437205333333334e-11 - 0.42162206939169045177e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 59: { - double t = 2*y100 - 119; - return 0.56951968796931245974e0 + (-0.49864649488074868952e-2 + (-0.11963416583477567125e-3 + (0.19906021780991036425e-5 + (-0.75580140299436494248e-8 + (-0.19576060961919820491e-9 + (0.42613011928888888890e-11 - 0.41539443304115604377e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 119; + return 0.56951968796931245974e0 + + (-0.49864649488074868952e-2 + + (-0.11963416583477567125e-3 + + (0.19906021780991036425e-5 + + (-0.75580140299436494248e-8 + + (-0.19576060961919820491e-9 + (0.42613011928888888890e-11 - 0.41539443304115604377e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 60: { - double t = 2*y100 - 121; - return 0.55908401930063918964e0 + (-0.54413711036826877753e-2 + (-0.10788661102511914628e-3 + (0.19229663322982839331e-5 + (-0.92714731195118129616e-8 + (-0.14807038677197394186e-9 + (0.36920870298666666666e-11 - 0.39603726688419162617e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 121; + return 0.55908401930063918964e0 + + (-0.54413711036826877753e-2 + + (-0.10788661102511914628e-3 + + (0.19229663322982839331e-5 + + (-0.92714731195118129616e-8 + + (-0.14807038677197394186e-9 + (0.36920870298666666666e-11 - 0.39603726688419162617e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 61: { - double t = 2*y100 - 123; - return 0.54778496152925675315e0 + (-0.58501497933213396670e-2 + (-0.96582314317855227421e-4 + (0.18434405235069270228e-5 + (-0.10541580254317078711e-7 + (-0.10702303407788943498e-9 + (0.31563175582222222222e-11 - 0.36829748079110481422e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 123; + return 0.54778496152925675315e0 + + (-0.58501497933213396670e-2 + + (-0.96582314317855227421e-4 + + (0.18434405235069270228e-5 + + (-0.10541580254317078711e-7 + + (-0.10702303407788943498e-9 + (0.31563175582222222222e-11 - 0.36829748079110481422e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 62: { - double t = 2*y100 - 125; - return 0.53571290831682823999e0 + (-0.62147030670760791791e-2 + (-0.85782497917111760790e-4 + (0.17553116363443470478e-5 + (-0.11432547349815541084e-7 + (-0.72157091369041330520e-10 + (0.26630811607111111111e-11 - 0.33578660425893164084e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 125; + return 0.53571290831682823999e0 + + (-0.62147030670760791791e-2 + + (-0.85782497917111760790e-4 + + (0.17553116363443470478e-5 + + (-0.11432547349815541084e-7 + + (-0.72157091369041330520e-10 + (0.26630811607111111111e-11 - 0.33578660425893164084e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 63: { - double t = 2*y100 - 127; - return 0.52295422962048434978e0 + (-0.65371404367776320720e-2 + (-0.75530164941473343780e-4 + (0.16613725797181276790e-5 + (-0.12003521296598910761e-7 + (-0.42929753689181106171e-10 + (0.22170894940444444444e-11 - 0.30117697501065110505e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 127; + return 0.52295422962048434978e0 + + (-0.65371404367776320720e-2 + + (-0.75530164941473343780e-4 + + (0.16613725797181276790e-5 + + (-0.12003521296598910761e-7 + + (-0.42929753689181106171e-10 + (0.22170894940444444444e-11 - 0.30117697501065110505e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 64: { - double t = 2*y100 - 129; - return 0.50959092577577886140e0 + (-0.68197117603118591766e-2 + (-0.65852936198953623307e-4 + (0.15639654113906716939e-5 + (-0.12308007991056524902e-7 + (-0.18761997536910939570e-10 + (0.18198628922666666667e-11 - 0.26638355362285200932e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 129; + return 0.50959092577577886140e0 + + (-0.68197117603118591766e-2 + + (-0.65852936198953623307e-4 + + (0.15639654113906716939e-5 + + (-0.12308007991056524902e-7 + + (-0.18761997536910939570e-10 + (0.18198628922666666667e-11 - 0.26638355362285200932e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 65: { - double t = 2*y100 - 131; - return 0.49570040481823167970e0 + (-0.70647509397614398066e-2 + (-0.56765617728962588218e-4 + (0.14650274449141448497e-5 + (-0.12393681471984051132e-7 + (0.92904351801168955424e-12 + (0.14706755960177777778e-11 - 0.23272455351266325318e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 131; + return 0.49570040481823167970e0 + + (-0.70647509397614398066e-2 + + (-0.56765617728962588218e-4 + + (0.14650274449141448497e-5 + + (-0.12393681471984051132e-7 + + (0.92904351801168955424e-12 + (0.14706755960177777778e-11 - 0.23272455351266325318e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 66: { - double t = 2*y100 - 133; - return 0.48135536250935238066e0 + (-0.72746293327402359783e-2 + (-0.48272489495730030780e-4 + (0.13661377309113939689e-5 + (-0.12302464447599382189e-7 + (0.16707760028737074907e-10 + (0.11672928324444444444e-11 - 0.20105801424709924499e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 133; + return 0.48135536250935238066e0 + + (-0.72746293327402359783e-2 + + (-0.48272489495730030780e-4 + + (0.13661377309113939689e-5 + + (-0.12302464447599382189e-7 + + (0.16707760028737074907e-10 + (0.11672928324444444444e-11 - 0.20105801424709924499e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 67: { - double t = 2*y100 - 135; - return 0.46662374675511439448e0 + (-0.74517177649528487002e-2 + (-0.40369318744279128718e-4 + (0.12685621118898535407e-5 + (-0.12070791463315156250e-7 + (0.29105507892605823871e-10 + (0.90653314645333333334e-12 - 0.17189503312102982646e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 135; + return 0.46662374675511439448e0 + + (-0.74517177649528487002e-2 + + (-0.40369318744279128718e-4 + + (0.12685621118898535407e-5 + + (-0.12070791463315156250e-7 + + (0.29105507892605823871e-10 + (0.90653314645333333334e-12 - 0.17189503312102982646e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 68: { - double t = 2*y100 - 137; - return 0.45156879030168268778e0 + (-0.75983560650033817497e-2 + (-0.33045110380705139759e-4 + (0.11732956732035040896e-5 + (-0.11729986947158201869e-7 + (0.38611905704166441308e-10 + (0.68468768305777777779e-12 - 0.14549134330396754575e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 137; + return 0.45156879030168268778e0 + + (-0.75983560650033817497e-2 + + (-0.33045110380705139759e-4 + + (0.11732956732035040896e-5 + + (-0.11729986947158201869e-7 + + (0.38611905704166441308e-10 + (0.68468768305777777779e-12 - 0.14549134330396754575e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 69: { - double t = 2*y100 - 139; - return 0.43624909769330896904e0 + (-0.77168291040309554679e-2 + (-0.26283612321339907756e-4 + (0.10811018836893550820e-5 + (-0.11306707563739851552e-7 + (0.45670446788529607380e-10 + (0.49782492549333333334e-12 - 0.12191983967561779442e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 139; + return 0.43624909769330896904e0 + + (-0.77168291040309554679e-2 + + (-0.26283612321339907756e-4 + + (0.10811018836893550820e-5 + + (-0.11306707563739851552e-7 + + (0.45670446788529607380e-10 + (0.49782492549333333334e-12 - 0.12191983967561779442e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 70: { - double t = 2*y100 - 141; - return 0.42071877443548481181e0 + (-0.78093484015052730097e-2 + (-0.20064596897224934705e-4 + (0.99254806680671890766e-6 + (-0.10823412088884741451e-7 + (0.50677203326904716247e-10 + (0.34200547594666666666e-12 - 0.10112698698356194618e-13 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 141; + return 0.42071877443548481181e0 + + (-0.78093484015052730097e-2 + + (-0.20064596897224934705e-4 + + (0.99254806680671890766e-6 + + (-0.10823412088884741451e-7 + + (0.50677203326904716247e-10 + (0.34200547594666666666e-12 - 0.10112698698356194618e-13 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 71: { - double t = 2*y100 - 143; - return 0.40502758809710844280e0 + (-0.78780384460872937555e-2 + (-0.14364940764532853112e-4 + (0.90803709228265217384e-6 + (-0.10298832847014466907e-7 + (0.53981671221969478551e-10 + (0.21342751381333333333e-12 - 0.82975901848387729274e-14 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 143; + return 0.40502758809710844280e0 + + (-0.78780384460872937555e-2 + + (-0.14364940764532853112e-4 + + (0.90803709228265217384e-6 + + (-0.10298832847014466907e-7 + + (0.53981671221969478551e-10 + (0.21342751381333333333e-12 - 0.82975901848387729274e-14 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 72: { - double t = 2*y100 - 145; - return 0.38922115269731446690e0 + (-0.79249269708242064120e-2 + (-0.91595258799106970453e-5 + (0.82783535102217576495e-6 + (-0.97484311059617744437e-8 + (0.55889029041660225629e-10 + (0.10851981336888888889e-12 - 0.67278553237853459757e-14 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 145; + return 0.38922115269731446690e0 + + (-0.79249269708242064120e-2 + + (-0.91595258799106970453e-5 + + (0.82783535102217576495e-6 + + (-0.97484311059617744437e-8 + + (0.55889029041660225629e-10 + (0.10851981336888888889e-12 - 0.67278553237853459757e-14 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 73: { - double t = 2*y100 - 147; - return 0.37334112915460307335e0 + (-0.79519385109223148791e-2 + (-0.44219833548840469752e-5 + (0.75209719038240314732e-6 + (-0.91848251458553190451e-8 + (0.56663266668051433844e-10 + (0.23995894257777777778e-13 - 0.53819475285389344313e-14 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 147; + return 0.37334112915460307335e0 + + (-0.79519385109223148791e-2 + + (-0.44219833548840469752e-5 + + (0.75209719038240314732e-6 + + (-0.91848251458553190451e-8 + + (0.56663266668051433844e-10 + (0.23995894257777777778e-13 - 0.53819475285389344313e-14 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 74: { - double t = 2*y100 - 149; - return 0.35742543583374223085e0 + (-0.79608906571527956177e-2 + (-0.12530071050975781198e-6 + (0.68088605744900552505e-6 + (-0.86181844090844164075e-8 + (0.56530784203816176153e-10 + (-0.43120012248888888890e-13 - 0.42372603392496813810e-14 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 149; + return 0.35742543583374223085e0 + + (-0.79608906571527956177e-2 + + (-0.12530071050975781198e-6 + + (0.68088605744900552505e-6 + + (-0.86181844090844164075e-8 + + (0.56530784203816176153e-10 + (-0.43120012248888888890e-13 - 0.42372603392496813810e-14 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 75: { - double t = 2*y100 - 151; - return 0.34150846431979618536e0 + (-0.79534924968773806029e-2 + (0.37576885610891515813e-5 + (0.61419263633090524326e-6 + (-0.80565865409945960125e-8 + (0.55684175248749269411e-10 + (-0.95486860764444444445e-13 - 0.32712946432984510595e-14 * t) * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 151; + return 0.34150846431979618536e0 + + (-0.79534924968773806029e-2 + + (0.37576885610891515813e-5 + + (0.61419263633090524326e-6 + + (-0.80565865409945960125e-8 + + (0.55684175248749269411e-10 + (-0.95486860764444444445e-13 - 0.32712946432984510595e-14 * t) * t) * t + ) * t) * + t) * + t) * + t; } case 76: { - double t = 2*y100 - 153; - return 0.32562129649136346824e0 + (-0.79313448067948884309e-2 + (0.72539159933545300034e-5 + (0.55195028297415503083e-6 + (-0.75063365335570475258e-8 + (0.54281686749699595941e-10 - 0.13545424295111111111e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 153; + return 0.32562129649136346824e0 + + (-0.79313448067948884309e-2 + + (0.72539159933545300034e-5 + + (0.55195028297415503083e-6 + + (-0.75063365335570475258e-8 + (0.54281686749699595941e-10 - 0.13545424295111111111e-12 * t) * t) * t + ) * t) * + t) * + t; } case 77: { - double t = 2*y100 - 155; - return 0.30979191977078391864e0 + (-0.78959416264207333695e-2 + (0.10389774377677210794e-4 + (0.49404804463196316464e-6 + (-0.69722488229411164685e-8 + (0.52469254655951393842e-10 - 0.16507860650666666667e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 155; + return 0.30979191977078391864e0 + + (-0.78959416264207333695e-2 + + (0.10389774377677210794e-4 + + (0.49404804463196316464e-6 + + (-0.69722488229411164685e-8 + (0.52469254655951393842e-10 - 0.16507860650666666667e-12 * t) * t) * t + ) * t) * + t) * + t; } case 78: { - double t = 2*y100 - 157; - return 0.29404543811214459904e0 + (-0.78486728990364155356e-2 + (0.13190885683106990459e-4 + (0.44034158861387909694e-6 + (-0.64578942561562616481e-8 + (0.50354306498006928984e-10 - 0.18614473550222222222e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 157; + return 0.29404543811214459904e0 + + (-0.78486728990364155356e-2 + + (0.13190885683106990459e-4 + + (0.44034158861387909694e-6 + + (-0.64578942561562616481e-8 + (0.50354306498006928984e-10 - 0.18614473550222222222e-12 * t) * t) * t + ) * t) * + t) * + t; } case 79: { - double t = 2*y100 - 159; - return 0.27840427686253660515e0 + (-0.77908279176252742013e-2 + (0.15681928798708548349e-4 + (0.39066226205099807573e-6 + (-0.59658144820660420814e-8 + (0.48030086420373141763e-10 - 0.20018995173333333333e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 159; + return 0.27840427686253660515e0 + + (-0.77908279176252742013e-2 + + (0.15681928798708548349e-4 + + (0.39066226205099807573e-6 + + (-0.59658144820660420814e-8 + (0.48030086420373141763e-10 - 0.20018995173333333333e-12 * t) * t) * t + ) * t) * + t) * + t; } case 80: { - double t = 2*y100 - 161; - return 0.26288838011163800908e0 + (-0.77235993576119469018e-2 + (0.17886516796198660969e-4 + (0.34482457073472497720e-6 + (-0.54977066551955420066e-8 + (0.45572749379147269213e-10 - 0.20852924954666666667e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 161; + return 0.26288838011163800908e0 + + (-0.77235993576119469018e-2 + + (0.17886516796198660969e-4 + + (0.34482457073472497720e-6 + + (-0.54977066551955420066e-8 + (0.45572749379147269213e-10 - 0.20852924954666666667e-12 * t) * t) * t + ) * t) * + t) * + t; } case 81: { - double t = 2*y100 - 163; - return 0.24751539954181029717e0 + (-0.76480877165290370975e-2 + (0.19827114835033977049e-4 + (0.30263228619976332110e-6 + (-0.50545814570120129947e-8 + (0.43043879374212005966e-10 - 0.21228012028444444444e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 163; + return 0.24751539954181029717e0 + + (-0.76480877165290370975e-2 + + (0.19827114835033977049e-4 + + (0.30263228619976332110e-6 + + (-0.50545814570120129947e-8 + (0.43043879374212005966e-10 - 0.21228012028444444444e-12 * t) * t) * t + ) * t) * + t) * + t; } case 82: { - double t = 2*y100 - 165; - return 0.23230087411688914593e0 + (-0.75653060136384041587e-2 + (0.21524991113020016415e-4 + (0.26388338542539382413e-6 + (-0.46368974069671446622e-8 + (0.40492715758206515307e-10 - 0.21238627815111111111e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 165; + return 0.23230087411688914593e0 + + (-0.75653060136384041587e-2 + + (0.21524991113020016415e-4 + + (0.26388338542539382413e-6 + + (-0.46368974069671446622e-8 + (0.40492715758206515307e-10 - 0.21238627815111111111e-12 * t) * t) * t + ) * t) * + t) * + t; } case 83: { - double t = 2*y100 - 167; - return 0.21725840021297341931e0 + (-0.74761846305979730439e-2 + (0.23000194404129495243e-4 + (0.22837400135642906796e-6 + (-0.42446743058417541277e-8 + (0.37958104071765923728e-10 - 0.20963978568888888889e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 167; + return 0.21725840021297341931e0 + + (-0.74761846305979730439e-2 + + (0.23000194404129495243e-4 + + (0.22837400135642906796e-6 + + (-0.42446743058417541277e-8 + (0.37958104071765923728e-10 - 0.20963978568888888889e-12 * t) * t) * t + ) * t) * + t) * + t; } case 84: { - double t = 2*y100 - 169; - return 0.20239979200788191491e0 + (-0.73815761980493466516e-2 + (0.24271552727631854013e-4 + (0.19590154043390012843e-6 + (-0.38775884642456551753e-8 + (0.35470192372162901168e-10 - 0.20470131678222222222e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 169; + return 0.20239979200788191491e0 + + (-0.73815761980493466516e-2 + + (0.24271552727631854013e-4 + + (0.19590154043390012843e-6 + + (-0.38775884642456551753e-8 + (0.35470192372162901168e-10 - 0.20470131678222222222e-12 * t) * t) * t + ) * t) * + t) * + t; } case 85: { - double t = 2*y100 - 171; - return 0.18773523211558098962e0 + (-0.72822604530339834448e-2 + (0.25356688567841293697e-4 + (0.16626710297744290016e-6 + (-0.35350521468015310830e-8 + (0.33051896213898864306e-10 - 0.19811844544000000000e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 171; + return 0.18773523211558098962e0 + + (-0.72822604530339834448e-2 + + (0.25356688567841293697e-4 + + (0.16626710297744290016e-6 + + (-0.35350521468015310830e-8 + (0.33051896213898864306e-10 - 0.19811844544000000000e-12 * t) * t) * t + ) * t) * + t) * + t; } case 86: { - double t = 2*y100 - 173; - return 0.17327341258479649442e0 + (-0.71789490089142761950e-2 + (0.26272046822383820476e-4 + (0.13927732375657362345e-6 + (-0.32162794266956859603e-8 + (0.30720156036105652035e-10 - 0.19034196304000000000e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 173; + return 0.17327341258479649442e0 + + (-0.71789490089142761950e-2 + + (0.26272046822383820476e-4 + + (0.13927732375657362345e-6 + + (-0.32162794266956859603e-8 + (0.30720156036105652035e-10 - 0.19034196304000000000e-12 * t) * t) * t + ) * t) * + t) * + t; } case 87: { - double t = 2*y100 - 175; - return 0.15902166648328672043e0 + (-0.70722899934245504034e-2 + (0.27032932310132226025e-4 + (0.11474573347816568279e-6 + (-0.29203404091754665063e-8 + (0.28487010262547971859e-10 - 0.18174029063111111111e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 175; + return 0.15902166648328672043e0 + + (-0.70722899934245504034e-2 + + (0.27032932310132226025e-4 + + (0.11474573347816568279e-6 + + (-0.29203404091754665063e-8 + (0.28487010262547971859e-10 - 0.18174029063111111111e-12 * t) * t) * t + ) * t) * + t) * + t; } case 88: { - double t = 2*y100 - 177; - return 0.14498609036610283865e0 + (-0.69628725220045029273e-2 + (0.27653554229160596221e-4 + (0.92493727167393036470e-7 + (-0.26462055548683583849e-8 + (0.26360506250989943739e-10 - 0.17261211260444444444e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 177; + return 0.14498609036610283865e0 + + (-0.69628725220045029273e-2 + + (0.27653554229160596221e-4 + + (0.92493727167393036470e-7 + + (-0.26462055548683583849e-8 + (0.26360506250989943739e-10 - 0.17261211260444444444e-12 * t) * t) * t + ) * t) * + t) * + t; } case 89: { - double t = 2*y100 - 179; - return 0.13117165798208050667e0 + (-0.68512309830281084723e-2 + (0.28147075431133863774e-4 + (0.72351212437979583441e-7 + (-0.23927816200314358570e-8 + (0.24345469651209833155e-10 - 0.16319736960000000000e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 179; + return 0.13117165798208050667e0 + + (-0.68512309830281084723e-2 + + (0.28147075431133863774e-4 + + (0.72351212437979583441e-7 + + (-0.23927816200314358570e-8 + (0.24345469651209833155e-10 - 0.16319736960000000000e-12 * t) * t) * t + ) * t) * + t) * + t; } case 90: { - double t = 2*y100 - 181; - return 0.11758232561160626306e0 + (-0.67378491192463392927e-2 + (0.28525664781722907847e-4 + (0.54156999310046790024e-7 + (-0.21589405340123827823e-8 + (0.22444150951727334619e-10 - 0.15368675584000000000e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 181; + return 0.11758232561160626306e0 + + (-0.67378491192463392927e-2 + + (0.28525664781722907847e-4 + + (0.54156999310046790024e-7 + + (-0.21589405340123827823e-8 + (0.22444150951727334619e-10 - 0.15368675584000000000e-12 * t) * t) * t + ) * t) * + t) * + t; } case 91: { - double t = 2*y100 - 183; - return 0.10422112945361673560e0 + (-0.66231638959845581564e-2 + (0.28800551216363918088e-4 + (0.37758983397952149613e-7 + (-0.19435423557038933431e-8 + (0.20656766125421362458e-10 - 0.14422990012444444444e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 183; + return 0.10422112945361673560e0 + + (-0.66231638959845581564e-2 + + (0.28800551216363918088e-4 + + (0.37758983397952149613e-7 + + (-0.19435423557038933431e-8 + (0.20656766125421362458e-10 - 0.14422990012444444444e-12 * t) * t) * t + ) * t) * + t) * + t; } case 92: { - double t = 2*y100 - 185; - return 0.91090275493541084785e-1 + (-0.65075691516115160062e-2 + (0.28982078385527224867e-4 + (0.23014165807643012781e-7 + (-0.17454532910249875958e-8 + (0.18981946442680092373e-10 - 0.13494234691555555556e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 185; + return 0.91090275493541084785e-1 + + (-0.65075691516115160062e-2 + + (0.28982078385527224867e-4 + + (0.23014165807643012781e-7 + + (-0.17454532910249875958e-8 + (0.18981946442680092373e-10 - 0.13494234691555555556e-12 * t) * t) * t + ) * t) * + t) * + t; } case 93: { - double t = 2*y100 - 187; - return 0.78191222288771379358e-1 + (-0.63914190297303976434e-2 + (0.29079759021299682675e-4 + (0.97885458059415717014e-8 + (-0.15635596116134296819e-8 + (0.17417110744051331974e-10 - 0.12591151763555555556e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 187; + return 0.78191222288771379358e-1 + + (-0.63914190297303976434e-2 + + (0.29079759021299682675e-4 + + (0.97885458059415717014e-8 + + (-0.15635596116134296819e-8 + (0.17417110744051331974e-10 - 0.12591151763555555556e-12 * t) * t) * t + ) * t) * + t) * + t; } case 94: { - double t = 2*y100 - 189; - return 0.65524757106147402224e-1 + (-0.62750311956082444159e-2 + (0.29102328354323449795e-4 + (-0.20430838882727954582e-8 + (-0.13967781903855367270e-8 + (0.15958771833747057569e-10 - 0.11720175765333333333e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 189; + return 0.65524757106147402224e-1 + + (-0.62750311956082444159e-2 + + (0.29102328354323449795e-4 + + (-0.20430838882727954582e-8 + + (-0.13967781903855367270e-8 + (0.15958771833747057569e-10 - 0.11720175765333333333e-12 * t) * t) * t + ) * t) * + t) * + t; } case 95: { - double t = 2*y100 - 191; - return 0.53091065838453612773e-1 + (-0.61586898417077043662e-2 + (0.29057796072960100710e-4 + (-0.12597414620517987536e-7 + (-0.12440642607426861943e-8 + (0.14602787128447932137e-10 - 0.10885859114666666667e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 191; + return 0.53091065838453612773e-1 + + (-0.61586898417077043662e-2 + + (0.29057796072960100710e-4 + + (-0.12597414620517987536e-7 + + (-0.12440642607426861943e-8 + (0.14602787128447932137e-10 - 0.10885859114666666667e-12 * t) * t) * t + ) * t) * + t) * + t; } case 96: { - double t = 2*y100 - 193; - return 0.40889797115352738582e-1 + (-0.60426484889413678200e-2 + (0.28953496450191694606e-4 + (-0.21982952021823718400e-7 + (-0.11044169117553026211e-8 + (0.13344562332430552171e-10 - 0.10091231402844444444e-12 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 193; + return 0.40889797115352738582e-1 + + (-0.60426484889413678200e-2 + + (0.28953496450191694606e-4 + + (-0.21982952021823718400e-7 + + (-0.11044169117553026211e-8 + (0.13344562332430552171e-10 - 0.10091231402844444444e-12 * t) * t) * t + ) * t) * + t) * + t; } case 97: { - double t = 2*y100 - 195; - return 0.28920121009594899986e-1 + (-0.59271325915413781788e-2 + (0.28796136372768177423e-4 + (-0.30300382596279568642e-7 + (-0.97688275022802329749e-9 + (0.12179215701512592356e-10 - 0.93380988481777777779e-13 * t) * t) * t) * t) * t) * t; + double t = 2 * y100 - 195; + return 0.28920121009594899986e-1 + + (-0.59271325915413781788e-2 + + (0.28796136372768177423e-4 + + (-0.30300382596279568642e-7 + + (-0.97688275022802329749e-9 + (0.12179215701512592356e-10 - 0.93380988481777777779e-13 * t) * t) * t + ) * t) * + t) * + t; } case 98: { - double t = 2*y100 - 197; - return 0.17180782722617876655e-1 + (-0.58123419543161127769e-2 + (0.28591841095380959666e-4 + (-0.37642963496443667043e-7 + (-0.86055809047367300024e-9 + (0.11101709356762665578e-10 - 0.86272947493333333334e-13 * t) * t) * t) * t) * t) * t; - } - case 99: case 100: { // use Taylor expansion for small x (|x| <= 0.010101...) - // (2/sqrt(pi)) * (x - 2/3 x^3 + 4/15 x^5 - 8/105 x^7) - double x2 = x*x; - return x * (1.1283791670955125739 - - x2 * (0.75225277806367504925 - - x2 * (0.30090111122547001970 - - x2 * 0.085971746064420005629))); - } - } - /* Since 0 <= y100 < 101, this is only reached if x is NaN, - in which case we should return NaN. */ - return std::numeric_limits::quiet_NaN(); -} - -double w_im(double x) -{ - if (x >= 0) { - if (x > 45) { // continued-fraction expansion is faster - const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi) - if (x > 5e7) // 1-term expansion, important to avoid overflow - return ispi / x; - /* 5-term expansion (rely on compiler for CSE), simplified from: - ispi / (x-0.5/(x-1/(x-1.5/(x-2/x)))) */ - return ispi*((x*x) * (x*x-4.5) + 2) / (x * ((x*x) * (x*x-5) + 3.75)); - } - return w_im_y100(100/(1+x), x); - } - else { // = -Faddeeva::w_im(-x) - if (x < -45) { // continued-fraction expansion is faster - const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi) - if (x < -5e7) // 1-term expansion, important to avoid overflow - return ispi / x; - /* 5-term expansion (rely on compiler for CSE), simplified from: - ispi / (x+0.5/(x+1/(x+1.5/(x+2/x)))) */ - return ispi*((x*x) * (x*x-4.5) + 2) / (x * ((x*x) * (x*x-5) + 3.75)); - } - return -w_im_y100(100/(1-x), -x); - } -} - -} \ No newline at end of file + double t = 2 * y100 - 197; + return 0.17180782722617876655e-1 + + (-0.58123419543161127769e-2 + + (0.28591841095380959666e-4 + + (-0.37642963496443667043e-7 + + (-0.86055809047367300024e-9 + (0.11101709356762665578e-10 - 0.86272947493333333334e-13 * t) * t) * t + ) * t) * + t) * + t; + } + case 99: + case 100: { // use Taylor expansion for small x (|x| <= 0.010101...) + // (2/sqrt(pi)) * (x - 2/3 x^3 + 4/15 x^5 - 8/105 x^7) + double x2 = x * x; + return x * (1.1283791670955125739 - + x2 * (0.75225277806367504925 - x2 * (0.30090111122547001970 - x2 * 0.085971746064420005629))); + } + } + /* Since 0 <= y100 < 101, this is only reached if x is NaN, + in which case we should return NaN. */ + return std::numeric_limits::quiet_NaN(); +} + +double w_im(double x) { + if (x >= 0) { + if (x > 45) { // continued-fraction expansion is faster + const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi) + if (x > 5e7) // 1-term expansion, important to avoid overflow + return ispi / x; + /* 5-term expansion (rely on compiler for CSE), simplified from: + ispi / (x-0.5/(x-1/(x-1.5/(x-2/x)))) */ + return ispi * ((x * x) * (x * x - 4.5) + 2) / (x * ((x * x) * (x * x - 5) + 3.75)); + } + return w_im_y100(100 / (1 + x), x); + } else { // = -Faddeeva::w_im(-x) + if (x < -45) { // continued-fraction expansion is faster + const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi) + if (x < -5e7) // 1-term expansion, important to avoid overflow + return ispi / x; + /* 5-term expansion (rely on compiler for CSE), simplified from: + ispi / (x+0.5/(x+1/(x+1.5/(x+2/x)))) */ + return ispi * ((x * x) * (x * x - 4.5) + 2) / (x * ((x * x) * (x * x - 5) + 3.75)); + } + return -w_im_y100(100 / (1 - x), -x); + } +} + +} // namespace Faddeeva diff --git a/include/xsf/fp_error_metrics.h b/include/xsf/fp_error_metrics.h index a04b3e0..4fa73fe 100644 --- a/include/xsf/fp_error_metrics.h +++ b/include/xsf/fp_error_metrics.h @@ -3,93 +3,94 @@ namespace xsf { template -XSF_HOST_DEVICE typename std::enable_if::value, T>::type extended_absolute_error(T actual, T desired) { +XSF_HOST_DEVICE typename std::enable_if::value, T>::type +extended_absolute_error(T actual, T desired) { if (actual == desired || std::isnan(actual) && std::isnan(desired)) { - return T(0); + return T(0); } if (std::isnan(desired) || std::isnan(actual)) { - /* If expected nan but got non-NaN or expected non-NaN but got NaN - * we consider this to be an infinite error. */ - return std::numeric_limits::infinity(); + /* If expected nan but got non-NaN or expected non-NaN but got NaN + * we consider this to be an infinite error. */ + return std::numeric_limits::infinity(); } if (std::isinf(actual)) { - /* We don't want to penalize early overflow too harshly, so instead - * compare with the mythical value nextafter(max_float). */ - T sgn = std::copysign(1.0, actual); - T max_float = std::numeric_limits::max(); - // max_float * 2**-(mantissa_bits + 1) = ulp(max_float) - T ulp = std::pow(2, -std::numeric_limits::digits) * max_float; - return std::abs((sgn * std::numeric_limits::max() - desired) + sgn * ulp); + /* We don't want to penalize early overflow too harshly, so instead + * compare with the mythical value nextafter(max_float). */ + T sgn = std::copysign(1.0, actual); + T max_float = std::numeric_limits::max(); + // max_float * 2**-(mantissa_bits + 1) = ulp(max_float) + T ulp = std::pow(2, -std::numeric_limits::digits) * max_float; + return std::abs((sgn * std::numeric_limits::max() - desired) + sgn * ulp); } if (std::isinf(desired)) { - T sgn = std::copysign(1.0, desired); - T max_float = std::numeric_limits::max(); - // max_float * 2**-(mantissa_bits + 1) = ulp(max_float) - T ulp = std::pow(2, -std::numeric_limits::digits) * max_float; - return std::abs((sgn * std::numeric_limits::max() - actual) + sgn * ulp); + T sgn = std::copysign(1.0, desired); + T max_float = std::numeric_limits::max(); + // max_float * 2**-(mantissa_bits + 1) = ulp(max_float) + T ulp = std::pow(2, -std::numeric_limits::digits) * max_float; + return std::abs((sgn * std::numeric_limits::max() - actual) + sgn * ulp); } return std::abs(actual - desired); } - template XSF_HOST_DEVICE T extended_absolute_error(std::complex actual, std::complex desired) { - return std::hypot(extended_absolute_error(actual.real(), desired.real()), extended_absolute_error(actual.imag(), desired.imag())); + return std::hypot( + extended_absolute_error(actual.real(), desired.real()), extended_absolute_error(actual.imag(), desired.imag()) + ); } - template -XSF_HOST_DEVICE typename std::enable_if::value, T>::type extended_relative_error(T actual, T desired) { +XSF_HOST_DEVICE typename std::enable_if::value, T>::type +extended_relative_error(T actual, T desired) { T abs_error = extended_absolute_error(actual, desired); T abs_desired = std::abs(desired); if (desired == 0.0) { - /* If the desired result is 0.0, normalize by smallest subnormal instead - * of zero. */ - abs_desired = std::numeric_limits::denorm_min(); + /* If the desired result is 0.0, normalize by smallest subnormal instead + * of zero. */ + abs_desired = std::numeric_limits::denorm_min(); } else if (std::isinf(desired)) { - abs_desired = std::numeric_limits::max(); + abs_desired = std::numeric_limits::max(); } else if (std::isnan(desired)) { - /* This ensures extended_relative_error(nan, nan) = 0 but - * extended_relative_error(x0, x1) is infinite if one but not both of - * x0 and x1 equals NaN */ - abs_desired = T(1); + /* This ensures extended_relative_error(nan, nan) = 0 but + * extended_relative_error(x0, x1) is infinite if one but not both of + * x0 and x1 equals NaN */ + abs_desired = T(1); } return abs_error / abs_desired; } - template XSF_HOST_DEVICE T extended_relative_error(std::complex actual, std::complex desired) { T abs_error = extended_absolute_error(actual, desired); if (desired.real() == 0.0) { - desired.real(std::copysign(std::numeric_limits::denorm_min(), desired.real())); + desired.real(std::copysign(std::numeric_limits::denorm_min(), desired.real())); } else if (std::isinf(desired.real())) { - desired.real(std::copysign(std::numeric_limits::max(), desired.real())); + desired.real(std::copysign(std::numeric_limits::max(), desired.real())); } else if (std::isnan(desired.real())) { - /* In this case, the value used for desired doesn't matter. If desired.real() is NaN - * but actual.real() isn't NaN, then the extended_absolute_error will be inf already - * anyway. */ - desired.real(1.0); + /* In this case, the value used for desired doesn't matter. If desired.real() is NaN + * but actual.real() isn't NaN, then the extended_absolute_error will be inf already + * anyway. */ + desired.real(1.0); } if (desired.imag() == 0.0) { - desired.imag(std::copysign(std::numeric_limits::denorm_min(), desired.imag())); + desired.imag(std::copysign(std::numeric_limits::denorm_min(), desired.imag())); } else if (std::isinf(desired.imag())) { - desired.imag(std::copysign(std::numeric_limits::max(), desired.imag())); + desired.imag(std::copysign(std::numeric_limits::max(), desired.imag())); } else if (std::isnan(desired.imag())) { - /* In this case, the value used for desired doesn't matter. If desired.imag() is NaN - * but actual.imag() isn't NaN, then the extended_absolute_error will be inf already - * anyway. */ - desired.imag(1.0); + /* In this case, the value used for desired doesn't matter. If desired.imag() is NaN + * but actual.imag() isn't NaN, then the extended_absolute_error will be inf already + * anyway. */ + desired.imag(1.0); } if (!(std::isinf(desired.real()) || std::isinf(desired.imag())) && std::isinf(std::abs(desired))) { - /* Rescale to avoid overflow */ - return (abs_error / 2.0) / (std::abs(desired / 2.0)); + /* Rescale to avoid overflow */ + return (abs_error / 2.0) / (std::abs(desired / 2.0)); } return abs_error / abs(desired); } -} +} // namespace xsf diff --git a/include/xsf/fresnel.h b/include/xsf/fresnel.h index 094ba03..06f1311 100644 --- a/include/xsf/fresnel.h +++ b/include/xsf/fresnel.h @@ -237,7 +237,7 @@ namespace detail { fi0 = pp2 * (0.5 - s1); f.imag(pow(-1, ks) * fi0); } else if (xa < 5.5) { - int m = (int) (42 + 1.75 * x2); + int m = (int)(42 + 1.75 * x2); xsu = 0.0; xc = 0.0; xs = 0.0; diff --git a/include/xsf/hyp2f1.h b/include/xsf/hyp2f1.h index e3c3c6d..bdecebf 100644 --- a/include/xsf/hyp2f1.h +++ b/include/xsf/hyp2f1.h @@ -45,9 +45,9 @@ #include "binom.h" #include "cephes/gamma.h" +#include "cephes/hyp2f1.h" #include "cephes/lanczos.h" #include "cephes/poch.h" -#include "cephes/hyp2f1.h" #include "digamma.h" namespace xsf { @@ -267,9 +267,8 @@ namespace detail { /* 1 - z transform in limit as c - a - b approaches an integer m. */ public: XSF_HOST_DEVICE Hyp2f1Transform1LimitSeriesGenerator(double a, double b, double m, std::complex z) - : d1_(xsf::digamma(a)), d2_(xsf::digamma(b)), d3_(xsf::digamma(1 + m)), - d4_(xsf::digamma(1.0)), a_(a), b_(b), m_(m), z_(z), log_1_z_(std::log(1.0 - z)), - factor_(cephes::rgamma(m + 1)), k_(0) {} + : d1_(xsf::digamma(a)), d2_(xsf::digamma(b)), d3_(xsf::digamma(1 + m)), d4_(xsf::digamma(1.0)), a_(a), + b_(b), m_(m), z_(z), log_1_z_(std::log(1.0 - z)), factor_(cephes::rgamma(m + 1)), k_(0) {} XSF_HOST_DEVICE std::complex operator()() { std::complex term_ = (d1_ + d2_ - d3_ - d4_ + log_1_z_) * factor_; @@ -311,13 +310,11 @@ namespace detail { /* 1/z transform in limit as a - b approaches a non-negative integer m. (Can swap a and b to * handle the m a negative integer case. */ public: - XSF_HOST_DEVICE Hyp2f1Transform2LimitSeriesGenerator(double a, double b, double c, double m, - std::complex z) - : d1_(xsf::digamma(1.0)), d2_(xsf::digamma(1 + m)), d3_(xsf::digamma(a)), - d4_(xsf::digamma(c - a)), a_(a), b_(b), c_(c), m_(m), z_(z), log_neg_z_(std::log(-z)), - factor_(xsf::cephes::poch(b, m) * xsf::cephes::poch(1 - c + b, m) * - xsf::cephes::rgamma(m + 1)), - k_(0) {} + XSF_HOST_DEVICE + Hyp2f1Transform2LimitSeriesGenerator(double a, double b, double c, double m, std::complex z) + : d1_(xsf::digamma(1.0)), d2_(xsf::digamma(1 + m)), d3_(xsf::digamma(a)), d4_(xsf::digamma(c - a)), a_(a), + b_(b), c_(c), m_(m), z_(z), log_neg_z_(std::log(-z)), + factor_(xsf::cephes::poch(b, m) * xsf::cephes::poch(1 - c + b, m) * xsf::cephes::rgamma(m + 1)), k_(0) {} XSF_HOST_DEVICE std::complex operator()() { std::complex term = (d1_ + d2_ - d3_ - d4_ + log_neg_z_) * factor_; @@ -341,13 +338,12 @@ namespace detail { /* 1/z transform in limit as a - b approaches a non-negative integer m, and c - a approaches * a positive integer n. */ public: - XSF_HOST_DEVICE Hyp2f1Transform2LimitSeriesCminusAIntGenerator(double a, double b, double c, double m, - double n, std::complex z) - : d1_(xsf::digamma(1.0)), d2_(xsf::digamma(1 + m)), d3_(xsf::digamma(a)), - d4_(xsf::digamma(n)), a_(a), b_(b), c_(c), m_(m), n_(n), z_(z), log_neg_z_(std::log(-z)), - factor_(xsf::cephes::poch(b, m) * xsf::cephes::poch(1 - c + b, m) * - xsf::cephes::rgamma(m + 1)), - k_(0) {} + XSF_HOST_DEVICE Hyp2f1Transform2LimitSeriesCminusAIntGenerator( + double a, double b, double c, double m, double n, std::complex z + ) + : d1_(xsf::digamma(1.0)), d2_(xsf::digamma(1 + m)), d3_(xsf::digamma(a)), d4_(xsf::digamma(n)), a_(a), + b_(b), c_(c), m_(m), n_(n), z_(z), log_neg_z_(std::log(-z)), + factor_(xsf::cephes::poch(b, m) * xsf::cephes::poch(1 - c + b, m) * xsf::cephes::rgamma(m + 1)), k_(0) {} XSF_HOST_DEVICE std::complex operator()() { std::complex term; @@ -394,8 +390,8 @@ namespace detail { * (-1)**(a - b + k) * gamma(c - b) * (-1)**(k + a - c + 1)(k + a - c)! * = (-1)**(c - b - 1)*Gamma(k + a - c + 1) */ - factor_ = std::pow(-1, m_ + n_) * xsf::binom(c_ - 1, b_ - 1) * - xsf::cephes::poch(c_ - a_ + 1, m_ - 1) / std::pow(z_, static_cast(k_)); + factor_ = std::pow(-1, m_ + n_) * xsf::binom(c_ - 1, b_ - 1) * xsf::cephes::poch(c_ - a_ + 1, m_ - 1) / + std::pow(z_, static_cast(k_)); } term = factor_; factor_ *= (b_ + m_ + k_) * (k_ + a_ - c_ + 1) / ((k_ + 1) * (m_ + k_ + 1)) / z_; @@ -414,8 +410,7 @@ namespace detail { * for the 1 - z transform also has an initial finite sum, but it is a standard hypergeometric * series. */ public: - XSF_HOST_DEVICE Hyp2f1Transform2LimitFinitePartGenerator(double b, double c, double m, - std::complex z) + XSF_HOST_DEVICE Hyp2f1Transform2LimitFinitePartGenerator(double b, double c, double m, std::complex z) : b_(b), c_(c), m_(m), z_(z), term_(cephes::Gamma(m) * cephes::rgamma(c - b)), k_(0) {} XSF_HOST_DEVICE std::complex operator()() { @@ -463,52 +458,57 @@ namespace detail { std::complex z_, Z_; }; - XSF_HOST_DEVICE std::complex hyp2f1_transform1_limiting_case(double a, double b, double c, double m, - std::complex z) { + XSF_HOST_DEVICE std::complex + hyp2f1_transform1_limiting_case(double a, double b, double c, double m, std::complex z) { /* 1 - z transform in limiting case where c - a - b approaches an integer m. */ std::complex result = 0.0; if (m >= 0) { if (m != 0) { auto series_generator = HypergeometricSeriesGenerator(a, b, 1 - m, 1.0 - z); - result += four_gammas(m, c, a + m, b + m) * series_eval_fixed_length(series_generator, - std::complex{0.0, 0.0}, - static_cast(m)); + result += four_gammas(m, c, a + m, b + m) * + series_eval_fixed_length( + series_generator, std::complex{0.0, 0.0}, static_cast(m) + ); } std::complex prefactor = std::pow(-1.0, m + 1) * xsf::cephes::Gamma(c) / - (xsf::cephes::Gamma(a) * xsf::cephes::Gamma(b)) * - std::pow(1.0 - z, m); + (xsf::cephes::Gamma(a) * xsf::cephes::Gamma(b)) * std::pow(1.0 - z, m); auto series_generator = Hyp2f1Transform1LimitSeriesGenerator(a + m, b + m, m, z); - result += prefactor * series_eval(series_generator, std::complex{0.0, 0.0}, hyp2f1_EPS, - hyp2f1_MAXITER, "hyp2f1"); + result += + prefactor * + series_eval(series_generator, std::complex{0.0, 0.0}, hyp2f1_EPS, hyp2f1_MAXITER, "hyp2f1"); return result; } else { result = four_gammas(-m, c, a, b) * std::pow(1.0 - z, m); auto series_generator1 = HypergeometricSeriesGenerator(a + m, b + m, 1 + m, 1.0 - z); - result *= series_eval_fixed_length(series_generator1, std::complex{0.0, 0.0}, - static_cast(-m)); + result *= series_eval_fixed_length( + series_generator1, std::complex{0.0, 0.0}, static_cast(-m) + ); double prefactor = std::pow(-1.0, m + 1) * xsf::cephes::Gamma(c) * (xsf::cephes::rgamma(a + m) * xsf::cephes::rgamma(b + m)); auto series_generator2 = Hyp2f1Transform1LimitSeriesGenerator(a, b, -m, z); - result += prefactor * series_eval(series_generator2, std::complex{0.0, 0.0}, hyp2f1_EPS, - hyp2f1_MAXITER, "hyp2f1"); + result += + prefactor * + series_eval(series_generator2, std::complex{0.0, 0.0}, hyp2f1_EPS, hyp2f1_MAXITER, "hyp2f1"); return result; } } - XSF_HOST_DEVICE std::complex hyp2f1_transform2_limiting_case(double a, double b, double c, double m, - std::complex z) { + XSF_HOST_DEVICE std::complex + hyp2f1_transform2_limiting_case(double a, double b, double c, double m, std::complex z) { /* 1 / z transform in limiting case where a - b approaches a non-negative integer m. Negative integer case * can be handled by swapping a and b. */ auto series_generator1 = Hyp2f1Transform2LimitFinitePartGenerator(b, c, m, z); std::complex result = cephes::Gamma(c) * cephes::rgamma(a) * std::pow(-z, -b); result *= series_eval_fixed_length(series_generator1, std::complex{0.0, 0.0}, static_cast(m)); - std::complex prefactor = cephes::Gamma(c) * (cephes::rgamma(a) * cephes::rgamma(c - b) * std::pow(-z, -a)); + std::complex prefactor = + cephes::Gamma(c) * (cephes::rgamma(a) * cephes::rgamma(c - b) * std::pow(-z, -a)); double n = c - a; if (abs(n - std::round(n)) < hyp2f1_EPS) { auto series_generator2 = Hyp2f1Transform2LimitSeriesCminusAIntGenerator(a, b, c, m, n, z); - result += prefactor * series_eval(series_generator2, std::complex{0.0, 0.0}, hyp2f1_EPS, - hyp2f1_MAXITER, "hyp2f1"); + result += + prefactor * + series_eval(series_generator2, std::complex{0.0, 0.0}, hyp2f1_EPS, hyp2f1_MAXITER, "hyp2f1"); return result; } auto series_generator2 = Hyp2f1Transform2LimitSeriesGenerator(a, b, c, m, z); @@ -562,13 +562,14 @@ XSF_HOST_DEVICE inline std::complex hyp2f1(double a, double b, double c, } else { max_degree = std::abs(b); } - if (max_degree <= (double) UINT64_MAX) { + if (max_degree <= (double)UINT64_MAX) { auto series_generator = detail::HypergeometricSeriesGenerator(a, b, c, z); return detail::series_eval_fixed_length(series_generator, std::complex{0.0, 0.0}, max_degree + 1); } else { set_error("hyp2f1", SF_ERROR_NO_RESULT, NULL); - return std::complex{std::numeric_limits::quiet_NaN(), - std::numeric_limits::quiet_NaN()}; + return std::complex{ + std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN() + }; } } // Kummer's Theorem for z = -1; c = 1 + a - b (DLMF 15.4.26) @@ -583,7 +584,7 @@ XSF_HOST_DEVICE inline std::complex hyp2f1(double a, double b, double c, * (DLMF 15.8.1) */ if (c_minus_a_neg_int || c_minus_b_neg_int) { max_degree = c_minus_b_neg_int ? std::abs(c - b) : std::abs(c - a); - if (max_degree <= (double) UINT64_MAX) { + if (max_degree <= (double)UINT64_MAX) { result = std::pow(1.0 - z, c - a - b); auto series_generator = detail::HypergeometricSeriesGenerator(c - a, c - b, c, z); result *= @@ -591,8 +592,9 @@ XSF_HOST_DEVICE inline std::complex hyp2f1(double a, double b, double c, return result; } else { set_error("hyp2f1", SF_ERROR_NO_RESULT, NULL); - return std::complex{std::numeric_limits::quiet_NaN(), - std::numeric_limits::quiet_NaN()}; + return std::complex{ + std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN() + }; } } /* Diverges as real(z) -> 1 when c <= a + b. @@ -616,13 +618,15 @@ XSF_HOST_DEVICE inline std::complex hyp2f1(double a, double b, double c, if (c - a < a && c - b < b) { result = std::pow(1.0 - z, c - a - b); auto series_generator = detail::HypergeometricSeriesGenerator(c - a, c - b, c, z); - result *= detail::series_eval(series_generator, std::complex{0.0, 0.0}, detail::hyp2f1_EPS, - detail::hyp2f1_MAXITER, "hyp2f1"); + result *= detail::series_eval( + series_generator, std::complex{0.0, 0.0}, detail::hyp2f1_EPS, detail::hyp2f1_MAXITER, "hyp2f1" + ); return result; } auto series_generator = detail::HypergeometricSeriesGenerator(a, b, c, z); - return detail::series_eval(series_generator, std::complex{0.0, 0.0}, detail::hyp2f1_EPS, - detail::hyp2f1_MAXITER, "hyp2f1"); + return detail::series_eval( + series_generator, std::complex{0.0, 0.0}, detail::hyp2f1_EPS, detail::hyp2f1_MAXITER, "hyp2f1" + ); } /* Points near exp(iπ/3), exp(-iπ/3) not handled by any of the standard * transformations. Use series of López and Temme [5]. These regions @@ -636,13 +640,15 @@ XSF_HOST_DEVICE inline std::complex hyp2f1(double a, double b, double c, if ((c - a <= a && c - b < b) || (c - a < a && c - b <= b)) { auto series_generator = detail::LopezTemmeSeriesGenerator(c - a, c - b, c, z); result = std::pow(1.0 - 0.5 * z, a - c); // Lopez-Temme prefactor - result *= detail::series_eval(series_generator, std::complex{0.0, 0.0}, detail::hyp2f1_EPS, - detail::hyp2f1_MAXITER, "hyp2f1"); + result *= detail::series_eval( + series_generator, std::complex{0.0, 0.0}, detail::hyp2f1_EPS, detail::hyp2f1_MAXITER, "hyp2f1" + ); return std::pow(1.0 - z, c - a - b) * result; // Euler transform prefactor. } auto series_generator = detail::LopezTemmeSeriesGenerator(a, b, c, z); - result = detail::series_eval(series_generator, std::complex{0.0, 0.0}, detail::hyp2f1_EPS, - detail::hyp2f1_MAXITER, "hyp2f1"); + result = detail::series_eval( + series_generator, std::complex{0.0, 0.0}, detail::hyp2f1_EPS, detail::hyp2f1_MAXITER, "hyp2f1" + ); return std::pow(1.0 - 0.5 * z, -a) * result; // Lopez-Temme prefactor. } /* z/(z - 1) transformation (DLMF 15.8.1). Avoids cancellation issues that @@ -653,8 +659,10 @@ XSF_HOST_DEVICE inline std::complex hyp2f1(double a, double b, double c, std::swap(a, b); } auto series_generator = detail::HypergeometricSeriesGenerator(a, c - b, c, z / (z - 1.0)); - return std::pow(1.0 - z, -a) * detail::series_eval(series_generator, std::complex{0.0, 0.0}, - detail::hyp2f1_EPS, detail::hyp2f1_MAXITER, "hyp2f1"); + return std::pow(1.0 - z, -a) * detail::series_eval( + series_generator, std::complex{0.0, 0.0}, detail::hyp2f1_EPS, + detail::hyp2f1_MAXITER, "hyp2f1" + ); } /* 1 - z transformation (DLMF 15.8.4). */ if (0.9 <= z_abs && z_abs < 1.1) { @@ -664,8 +672,9 @@ XSF_HOST_DEVICE inline std::complex hyp2f1(double a, double b, double c, return detail::hyp2f1_transform1_limiting_case(a, b, c, m, z); } auto series_generator = detail::Hyp2f1Transform1Generator(a, b, c, z); - return detail::series_eval(series_generator, std::complex{0.0, 0.0}, detail::hyp2f1_EPS, - detail::hyp2f1_MAXITER, "hyp2f1"); + return detail::series_eval( + series_generator, std::complex{0.0, 0.0}, detail::hyp2f1_EPS, detail::hyp2f1_MAXITER, "hyp2f1" + ); } /* 1/z transformation (DLMF 15.8.2). */ if (std::abs(a - b - std::round(a - b)) < detail::hyp2f1_EPS) { @@ -676,13 +685,15 @@ XSF_HOST_DEVICE inline std::complex hyp2f1(double a, double b, double c, return detail::hyp2f1_transform2_limiting_case(a, b, c, m, z); } auto series_generator = detail::Hyp2f1Transform2Generator(a, b, c, z); - return detail::series_eval(series_generator, std::complex{0.0, 0.0}, detail::hyp2f1_EPS, - detail::hyp2f1_MAXITER, "hyp2f1"); + return detail::series_eval( + series_generator, std::complex{0.0, 0.0}, detail::hyp2f1_EPS, detail::hyp2f1_MAXITER, "hyp2f1" + ); } XSF_HOST_DEVICE inline std::complex hyp2f1(float a, float b, float c, std::complex x) { - return static_cast>(hyp2f1(static_cast(a), static_cast(b), - static_cast(c), static_cast>(x))); + return static_cast>(hyp2f1( + static_cast(a), static_cast(b), static_cast(c), static_cast>(x) + )); } XSF_HOST_DEVICE inline double hyp2f1(double a, double b, double c, double x) { return cephes::hyp2f1(a, b, c, x); } diff --git a/include/xsf/iv_ratio.h b/include/xsf/iv_ratio.h index e5dc871..c507963 100644 --- a/include/xsf/iv_ratio.h +++ b/include/xsf/iv_ratio.h @@ -2,10 +2,10 @@ #pragma once +#include "cephes/dd_real.h" #include "config.h" -#include "tools.h" #include "error.h" -#include "cephes/dd_real.h" +#include "tools.h" namespace xsf { @@ -33,9 +33,9 @@ template struct IvRatioCFTailGenerator { XSF_HOST_DEVICE IvRatioCFTailGenerator(T vc, T xc, T c) noexcept { - a0_ = -(2*vc-c)*xc; - as_ = -2*c*xc; - b0_ = 2*(vc+xc); + a0_ = -(2 * vc - c) * xc; + as_ = -2 * c * xc; + b0_ = 2 * (vc + xc); bs_ = c; k_ = 0; } @@ -43,13 +43,12 @@ struct IvRatioCFTailGenerator { XSF_HOST_DEVICE std::pair operator()() noexcept { using std::fma; ++k_; - return {fma(static_cast(k_), as_, a0_), - fma(static_cast(k_), bs_, b0_)}; + return {fma(static_cast(k_), as_, a0_), fma(static_cast(k_), bs_, b0_)}; } -private: - T a0_, as_; // a[k] == a0 + as*k, k >= 1 - T b0_, bs_; // b[k] == b0 + bs*k, k >= 1 + private: + T a0_, as_; // a[k] == a0 + as*k, k >= 1 + T b0_, bs_; // b[k] == b0 + bs*k, k >= 1 std::uint64_t k_; // current index }; @@ -59,21 +58,18 @@ struct IvRatioCFTailGenerator { // calculations in a higher precision, such as double-double, even if // the return type is hardcoded to be double. template -XSF_HOST_DEVICE inline std::pair -_iv_ratio_cf(double v, double x, bool complement) { +XSF_HOST_DEVICE inline std::pair _iv_ratio_cf(double v, double x, bool complement) { int e; std::frexp(std::fmax(v, x), &e); - T c = T(std::ldexp(1, 2-e)); // rescaling multiplier + T c = T(std::ldexp(1, 2 - e)); // rescaling multiplier T vc = v * c; T xc = x * c; IvRatioCFTailGenerator cf(vc, xc, c); auto [fc, terms] = detail::series_eval_kahan( - detail::continued_fraction_series(cf), - T(std::numeric_limits::epsilon()), - 1000, - 2*vc); + detail::continued_fraction_series(cf), T(std::numeric_limits::epsilon()), 1000, 2 * vc + ); T ret = (complement ? fc : xc) / (xc + fc); return {static_cast(ret), terms}; @@ -161,7 +157,7 @@ XSF_HOST_DEVICE inline double iv_ratio_c(double v, double x) { } else { // The previous branch (v > 0.5) also works for v == 0.5, but // the closed-form formula "1 - tanh(x)" is more efficient. - double t = std::exp(-2*x); + double t = std::exp(-2 * x); return (2 * t) / (1 + t); } } diff --git a/include/xsf/kelvin.h b/include/xsf/kelvin.h index 7da98d0..84e7af0 100644 --- a/include/xsf/kelvin.h +++ b/include/xsf/kelvin.h @@ -182,7 +182,7 @@ namespace detail { fac = 1.0; for (int k = 1; k <= km; k++) { fac = -fac; - xt = 0.25 * k * pi - (int) (0.125 * k) * 2.0 * pi; + xt = 0.25 * k * pi - (int)(0.125 * k) * 2.0 * pi; cs = cos(xt); ss = sin(xt); r1 = 0.125 * r1 * (4.0 - pow(2.0 * k - 1.0, 2)) / (k * x); diff --git a/include/xsf/lambertw.h b/include/xsf/lambertw.h index 9eb1882..eeeca8a 100644 --- a/include/xsf/lambertw.h +++ b/include/xsf/lambertw.h @@ -143,8 +143,8 @@ XSF_HOST_DEVICE inline std::complex lambertw(std::complex z, lon } XSF_HOST_DEVICE inline std::complex lambertw(std::complex z, long k, float tol) { - return static_cast>( - lambertw(static_cast>(z), k, static_cast(tol))); + return static_cast>(lambertw(static_cast>(z), k, static_cast(tol)) + ); } } // namespace xsf diff --git a/include/xsf/legendre.h b/include/xsf/legendre.h index 6565ed5..41d45cf 100644 --- a/include/xsf/legendre.h +++ b/include/xsf/legendre.h @@ -798,7 +798,7 @@ void lqn(std::complex z, OutputVec1 cqn, OutputVec2 cqd) { if (abs(z) > 1.1) { km = 40 + n; } else { - km = (int) ((40 + n) * floor(-1.0 - 1.8 * log(abs(z - static_cast(1))))); + km = (int)((40 + n) * floor(-1.0 - 1.8 * log(abs(z - static_cast(1))))); } cqf2 = 0.0; @@ -877,7 +877,7 @@ void lqmn(T x, OutputMat1 qm, OutputMat2 qd) { if (fabs(x) > 1.1) { km = 40 + m + n; } else { - km = (40 + m + n) * ((int) (-1. - 1.8 * log(x - 1.))); + km = (40 + m + n) * ((int)(-1. - 1.8 * log(x - 1.))); } qf2 = 0.0; qf1 = 1.0; @@ -1003,7 +1003,7 @@ void lqmn(std::complex z, OutputMat1 cqm, OutputMat2 cqd) { if (xc > 1.1) { km = 40 + m + n; } else { - km = (40 + m + n) * ((int) (-1.0 - 1.8 * log(xc - 1.))); + km = (40 + m + n) * ((int)(-1.0 - 1.8 * log(xc - 1.))); } cqf2 = 0.0; cqf1 = 1.0; diff --git a/include/xsf/log_exp.h b/include/xsf/log_exp.h index 2f9e901..5eb5842 100644 --- a/include/xsf/log_exp.h +++ b/include/xsf/log_exp.h @@ -34,10 +34,9 @@ T logit(T x) { // log1p(2*(x - 0.5)) - log1p(-2*(x - 0.5)) around p=0.5, which // provides very good precision in this interval. if (x < 0.3 || x > 0.65) { - return std::log(x/(1 - x)); - } - else { - T s = 2*(x - 0.5); + return std::log(x / (1 - x)); + } else { + T s = 2 * (x - 0.5); return std::log1p(s) - std::log1p(-s); } }; @@ -66,20 +65,19 @@ T log_expit(T x) { return -std::log1p(std::exp(-x)); }; - /* Compute log(1 - exp(x)). */ template T log1mexp(T x) { if (x > 0) { - set_error("_log1mexp", SF_ERROR_DOMAIN, NULL); - return std::numeric_limits::quiet_NaN(); + set_error("_log1mexp", SF_ERROR_DOMAIN, NULL); + return std::numeric_limits::quiet_NaN(); } if (x == 0) { - set_error("_log1mexp", SF_ERROR_SINGULAR, NULL); - return -std::numeric_limits::infinity(); + set_error("_log1mexp", SF_ERROR_SINGULAR, NULL); + return -std::numeric_limits::infinity(); } if (x < -1) { - return std::log1p(-std::exp(x)); + return std::log1p(-std::exp(x)); } return std::log(-std::expm1(x)); } diff --git a/include/xsf/loggamma.h b/include/xsf/loggamma.h index 3d98078..2394a65 100644 --- a/include/xsf/loggamma.h +++ b/include/xsf/loggamma.h @@ -85,13 +85,14 @@ namespace detail { * where gamma is the Euler-Mascheroni constant. */ - double coeffs[] = { - -4.3478266053040259361E-2, 4.5454556293204669442E-2, -4.7619070330142227991E-2, 5.000004769810169364E-2, - -5.2631679379616660734E-2, 5.5555767627403611102E-2, -5.8823978658684582339E-2, 6.2500955141213040742E-2, - -6.6668705882420468033E-2, 7.1432946295361336059E-2, -7.6932516411352191473E-2, 8.3353840546109004025E-2, - -9.0954017145829042233E-2, 1.0009945751278180853E-1, -1.1133426586956469049E-1, 1.2550966952474304242E-1, - -1.4404989676884611812E-1, 1.6955717699740818995E-1, -2.0738555102867398527E-1, 2.7058080842778454788E-1, - -4.0068563438653142847E-1, 8.2246703342411321824E-1, -5.7721566490153286061E-1}; + double coeffs[] = {-4.3478266053040259361E-2, 4.5454556293204669442E-2, -4.7619070330142227991E-2, + 5.000004769810169364E-2, -5.2631679379616660734E-2, 5.5555767627403611102E-2, + -5.8823978658684582339E-2, 6.2500955141213040742E-2, -6.6668705882420468033E-2, + 7.1432946295361336059E-2, -7.6932516411352191473E-2, 8.3353840546109004025E-2, + -9.0954017145829042233E-2, 1.0009945751278180853E-1, -1.1133426586956469049E-1, + 1.2550966952474304242E-1, -1.4404989676884611812E-1, 1.6955717699740818995E-1, + -2.0738555102867398527E-1, 2.7058080842778454788E-1, -4.0068563438653142847E-1, + 8.2246703342411321824E-1, -5.7721566490153286061E-1}; z -= 1.0; return z * cevalpoly(coeffs, 22, z); diff --git a/include/xsf/mathieu.h b/include/xsf/mathieu.h index a74b6ee..2431dde 100644 --- a/include/xsf/mathieu.h +++ b/include/xsf/mathieu.h @@ -21,7 +21,7 @@ T cem_cva(T m, T q) { set_error("mathieu_a", SF_ERROR_DOMAIN, NULL); return std::numeric_limits::quiet_NaN(); } - int_m = (int) m; + int_m = (int)m; if (q < 0) { /* https://dlmf.nist.gov/28.2#E26 */ if (int_m % 2 == 0) { @@ -45,7 +45,7 @@ T sem_cva(T m, T q) { set_error("mathieu_b", SF_ERROR_DOMAIN, NULL); return std::numeric_limits::quiet_NaN(); } - int_m = (int) m; + int_m = (int)m; if (q < 0) { /* https://dlmf.nist.gov/28.2#E26 */ if (int_m % 2 == 0) { @@ -70,7 +70,7 @@ void cem(T m, T q, T x, T &csf, T &csd) { csd = std::numeric_limits::quiet_NaN(); set_error("mathieu_cem", SF_ERROR_DOMAIN, NULL); } else { - int_m = (int) m; + int_m = (int)m; if (q < 0) { /* https://dlmf.nist.gov/28.2#E34 */ if (int_m % 2 == 0) { @@ -91,8 +91,7 @@ void cem(T m, T q, T x, T &csf, T &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; + sf_error_t sf_error = status == Status::NoMemory ? SF_ERROR_MEMORY : SF_ERROR_OTHER; set_error("mathieu_cem", sf_error, NULL); } } @@ -108,7 +107,7 @@ void sem(T m, T q, T x, T &csf, T &csd) { csd = std::numeric_limits::quiet_NaN(); set_error("mathieu_sem", SF_ERROR_DOMAIN, NULL); } else { - int_m = (int) m; + int_m = (int)m; if (int_m == 0) { csf = 0; csd = 0; @@ -131,8 +130,7 @@ void sem(T m, T q, T x, T &csf, T &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; + sf_error_t sf_error = status == Status::NoMemory ? SF_ERROR_MEMORY : SF_ERROR_OTHER; set_error("mathieu_sem", sf_error, NULL); } } @@ -150,13 +148,12 @@ void mcm1(T m, T q, T x, T &f1r, T &d1r) { set_error("mathieu_modcem1", SF_ERROR_DOMAIN, NULL); } else { using specfun::Status; - int_m = (int) m; + 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; + sf_error_t sf_error = status == Status::NoMemory ? SF_ERROR_MEMORY : SF_ERROR_OTHER; set_error("mathieu_modcem1", sf_error, NULL); } } @@ -173,13 +170,12 @@ void msm1(T m, T q, T x, T &f1r, T &d1r) { set_error("mathieu_modsem1", SF_ERROR_DOMAIN, NULL); } else { using specfun::Status; - int_m = (int) m; + 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; + sf_error_t sf_error = status == Status::NoMemory ? SF_ERROR_MEMORY : SF_ERROR_OTHER; set_error("mathieu_modsem1", sf_error, NULL); } } @@ -196,13 +192,12 @@ void mcm2(T m, T q, T x, T &f2r, T &d2r) { set_error("mathieu_modcem2", SF_ERROR_DOMAIN, NULL); } else { using specfun::Status; - int_m = (int) m; + 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; + sf_error_t sf_error = status == Status::NoMemory ? SF_ERROR_MEMORY : SF_ERROR_OTHER; set_error("mathieu_modcem2", sf_error, NULL); } } @@ -219,13 +214,12 @@ void msm2(T m, T q, T x, T &f2r, T &d2r) { set_error("mathieu_modsem2", SF_ERROR_DOMAIN, NULL); } else { using specfun::Status; - int_m = (int) m; + 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; + sf_error_t sf_error = status == Status::NoMemory ? SF_ERROR_MEMORY : SF_ERROR_OTHER; set_error("mathieu_modsem2", sf_error, NULL); } } diff --git a/include/xsf/numpy.h b/include/xsf/numpy.h index 1e37caf..e1153ee 100644 --- a/include/xsf/numpy.h +++ b/include/xsf/numpy.h @@ -33,19 +33,19 @@ namespace xsf { namespace numpy { void set_error_check_fpe(const char *func_name) { - int status = wrap_PyUFunc_getfperr(); - if (status & NPY_FPE_DIVIDEBYZERO) { - xsf::set_error(func_name, SF_ERROR_SINGULAR, "floating point division by zero"); - } - if (status & NPY_FPE_OVERFLOW) { - xsf::set_error(func_name, SF_ERROR_UNDERFLOW, "floating point underflow"); - } - if (status & NPY_FPE_UNDERFLOW) { - xsf::set_error(func_name, SF_ERROR_OVERFLOW, "floating point overflow"); - } - if (status & NPY_FPE_INVALID) { - xsf::set_error(func_name, SF_ERROR_DOMAIN, "floating point invalid value"); - } + int status = wrap_PyUFunc_getfperr(); + if (status & NPY_FPE_DIVIDEBYZERO) { + xsf::set_error(func_name, SF_ERROR_SINGULAR, "floating point division by zero"); + } + if (status & NPY_FPE_OVERFLOW) { + xsf::set_error(func_name, SF_ERROR_UNDERFLOW, "floating point underflow"); + } + if (status & NPY_FPE_UNDERFLOW) { + xsf::set_error(func_name, SF_ERROR_OVERFLOW, "floating point overflow"); + } + if (status & NPY_FPE_INVALID) { + xsf::set_error(func_name, SF_ERROR_DOMAIN, "floating point invalid value"); + } } namespace detail { @@ -202,8 +202,8 @@ namespace numpy { using ld_d = double (*)(long int, double); using lF_F = cfloat (*)(long int, cfloat); using lD_D = cdouble (*)(long int, cdouble); - using Dd_D = cdouble (*) (cdouble, double); - using Ff_F = cfloat (*) (cfloat, float); + using Dd_D = cdouble (*)(cdouble, double); + using Ff_F = cfloat (*)(cfloat, float); // autodiff, 2 inputs, 1 output using autodiff0_if_f = autodiff0_float (*)(int, autodiff0_float); @@ -793,9 +793,11 @@ namespace numpy { Func func = static_cast *>(data)->func; for (npy_intp i = 0; i < dims[0]; ++i) { - Res res = func(npy_traits::get( - args[I], new_dims.data() + ranks_scan[I], steps + ranks_scan[I] + sizeof...(Args) + 1 - )...); + Res res = func( + npy_traits::get( + args[I], new_dims.data() + ranks_scan[I], steps + ranks_scan[I] + sizeof...(Args) + 1 + )... + ); npy_traits::set(args[sizeof...(Args)], res); // assign to the output pointer for (npy_uintp j = 0; j <= sizeof...(Args); ++j) { @@ -804,7 +806,7 @@ namespace numpy { } const char *name = static_cast *>(data)->name; - set_error_check_fpe(name); + set_error_check_fpe(name); } }; @@ -827,9 +829,11 @@ namespace numpy { Func func = static_cast *>(data)->func; for (npy_intp i = 0; i < dims[0]; ++i) { - func(npy_traits::get( - args[I], new_dims.data() + ranks_scan[I], steps + ranks_scan[I] + sizeof...(Args) - )...); + func( + npy_traits::get( + args[I], new_dims.data() + ranks_scan[I], steps + ranks_scan[I] + sizeof...(Args) + )... + ); for (npy_uintp j = 0; j < sizeof...(Args); ++j) { args[j] += steps[j]; @@ -837,7 +841,7 @@ namespace numpy { } const char *name = static_cast *>(data)->name; - set_error_check_fpe(name); + set_error_check_fpe(name); } }; diff --git a/include/xsf/par_cyl.h b/include/xsf/par_cyl.h index 0c6734d..256be6b 100644 --- a/include/xsf/par_cyl.h +++ b/include/xsf/par_cyl.h @@ -34,7 +34,7 @@ namespace detail { pd = ep; } else { if (x == 0.0) { - if ((va0 <= 0.0) && (va0 == (int) va0)) { + if ((va0 <= 0.0) && (va0 == (int)va0)) { pd = 0.0; } else { ga0 = specfun::gamma2(va0); @@ -165,7 +165,7 @@ namespace detail { T va0 = 1.0 + 0.5 * va; if (x == 0.0) { - if (((va0 <= 0.0) && (va0 == (int) va0)) || va == 0.0) { + if (((va0 <= 0.0) && (va0 == (int)va0)) || va == 0.0) { pv = 0.0; } else { vb0 = -0.5 * va; @@ -225,7 +225,7 @@ namespace detail { xa = fabs(x); vh = v; v += copysign(1.0, v); - nv = (int) v; + nv = (int)v; v0 = v - nv; na = abs(nv); ep = exp(-0.25 * x * x); @@ -282,7 +282,7 @@ namespace detail { if (nv == 0) { v2 -= 1.0; } - nk = (int) (-v2); + nk = (int)(-v2); f1 = dvsa(x, v2); v1 = v2 + 1.0; f0 = dvsa(x, v1); @@ -360,7 +360,7 @@ namespace detail { xa = fabs(x); vh = v; v += copysign(1.0, v); - nv = (int) v; + nv = (int)v; v0 = v - nv; na = abs(nv); qe = exp(0.25 * x * x); @@ -415,7 +415,7 @@ namespace detail { } f1 = vvsa(x, v2); v1 = v2 - 1.0; - kv = (int) v2; + kv = (int)v2; f0 = vvsa(x, v1); vv[kv] = f1; vv[kv - 1] = f0; @@ -626,8 +626,8 @@ void pbdv(T v, T x, T &pdf, T &pdd) { pdd = std::numeric_limits::quiet_NaN(); } else { /* NB. Indexing of DV/DP in specfun.f:PBDV starts from 0, hence +2 */ - num = std::abs((int) v) + 2; - dv = (T *) malloc(sizeof(T) * 2 * num); + num = std::abs((int)v) + 2; + dv = (T *)malloc(sizeof(T) * 2 * num); if (dv == NULL) { set_error("pbdv", SF_ERROR_MEMORY, "memory allocation error"); pdf = std::numeric_limits::quiet_NaN(); @@ -651,8 +651,8 @@ void pbvv(T v, T x, T &pvf, T &pvd) { pvd = std::numeric_limits::quiet_NaN(); } else { /* NB. Indexing of DV/DP in specfun.f:PBVV starts from 0, hence +2 */ - num = std::abs((int) v) + 2; - vv = (T *) malloc(sizeof(T) * 2 * num); + num = std::abs((int)v) + 2; + vv = (T *)malloc(sizeof(T) * 2 * num); if (vv == NULL) { set_error("pbvv", SF_ERROR_MEMORY, "memory allocation error"); pvf = std::numeric_limits::quiet_NaN(); diff --git a/include/xsf/sici.h b/include/xsf/sici.h index 94812d1..8191d52 100644 --- a/include/xsf/sici.h +++ b/include/xsf/sici.h @@ -17,42 +17,40 @@ #include "config.h" #include "error.h" -#include "expint.h" #include "cephes/const.h" -#include "cephes/sici.h" #include "cephes/shichi.h" +#include "cephes/sici.h" +#include "expint.h" namespace xsf { namespace detail { - - XSF_HOST_DEVICE inline void sici_power_series(int sgn, std::complex z, - std::complex &s, std::complex &c) { - /* DLMF 6.6.5 and 6.6.6. If sgn = -1 computes si/ci, and if sgn = 1 - * computes shi/chi. - */ - std::complex fac = z; - s = fac; - c = 0; - std::complex term1, term2; - for (int n = 1; n < 100; n++) { - fac *= static_cast(sgn)*z/(2.0*n); - term2 = fac/(2.0*n); - c += term2; - fac *= z/(2.0*n + 1.0); - term1 = fac/(2.0*n + 1.0); - s += term1; - constexpr double tol = std::numeric_limits::epsilon(); - if (std::abs(term1) < tol*std::abs(s) && std::abs(term2) < tol*std::abs(c)) { - break; - } - } + + XSF_HOST_DEVICE inline void + sici_power_series(int sgn, std::complex z, std::complex &s, std::complex &c) { + /* DLMF 6.6.5 and 6.6.6. If sgn = -1 computes si/ci, and if sgn = 1 + * computes shi/chi. + */ + std::complex fac = z; + s = fac; + c = 0; + std::complex term1, term2; + for (int n = 1; n < 100; n++) { + fac *= static_cast(sgn) * z / (2.0 * n); + term2 = fac / (2.0 * n); + c += term2; + fac *= z / (2.0 * n + 1.0); + term1 = fac / (2.0 * n + 1.0); + s += term1; + constexpr double tol = std::numeric_limits::epsilon(); + if (std::abs(term1) < tol * std::abs(s) && std::abs(term2) < tol * std::abs(c)) { + break; + } + } } -} +} // namespace detail - -XSF_HOST_DEVICE inline int sici(std::complex z, - std::complex &si, std::complex &ci) { +XSF_HOST_DEVICE inline int sici(std::complex z, std::complex &si, std::complex &ci) { /* Compute sin/cos integrals at complex arguments. The algorithm * largely follows that of [1]. */ @@ -65,36 +63,36 @@ XSF_HOST_DEVICE inline int sici(std::complex z, return 0; } if (z == -std::numeric_limits::infinity()) { - si = -M_PI_2; + si = -M_PI_2; ci = {0.0, M_PI}; return 0; } if (std::abs(z) < 0.8) { // Use the series to avoid cancellation in si - detail::sici_power_series(-1, z, si, ci); + detail::sici_power_series(-1, z, si, ci); if (z == 0.0) { set_error("sici", SF_ERROR_DOMAIN, NULL); ci = {-std::numeric_limits::infinity(), std::numeric_limits::quiet_NaN()}; } else { ci += EULER + std::log(z); - } + } return 0; } - + // DLMF 6.5.5/6.5.6 plus DLMF 6.4.4/6.4.6/6.4.7 std::complex jz = std::complex(0.0, 1.0) * z; std::complex term1 = expi(jz); std::complex term2 = expi(-jz); - si = std::complex(0.0, -0.5)*(term1 - term2); - ci = 0.5*(term1 + term2); + si = std::complex(0.0, -0.5) * (term1 - term2); + ci = 0.5 * (term1 + term2); if (z.real() == 0) { if (z.imag() > 0) { ci += std::complex(0.0, M_PI_2); - } else if (z.imag() < 0) { + } else if (z.imag() < 0) { ci -= std::complex(0.0, M_PI_2); - } + } } else if (z.real() > 0) { si -= M_PI_2; } else { @@ -103,13 +101,12 @@ XSF_HOST_DEVICE inline int sici(std::complex z, ci += std::complex(0.0, M_PI); } else { ci -= std::complex(0.0, M_PI); - } + } } return 0; } -XSF_HOST_DEVICE inline int sici(std::complex z, - std::complex &si_f, std::complex &ci_f) { +XSF_HOST_DEVICE inline int sici(std::complex z, std::complex &si_f, std::complex &ci_f) { std::complex si; std::complex ci; int res = sici(z, si, ci); @@ -118,8 +115,7 @@ XSF_HOST_DEVICE inline int sici(std::complex z, return res; } -XSF_HOST_DEVICE inline int shichi(std::complex z, - std::complex &shi, std::complex &chi) { +XSF_HOST_DEVICE inline int shichi(std::complex z, std::complex &shi, std::complex &chi) { /* Compute sinh/cosh integrals at complex arguments. The algorithm * largely follows that of [1]. */ @@ -136,34 +132,33 @@ XSF_HOST_DEVICE inline int shichi(std::complex z, } if (std::abs(z) < 0.8) { // Use the series to avoid cancellation in shi - detail::sici_power_series(1, z, shi, chi); + detail::sici_power_series(1, z, shi, chi); if (z == 0.0) { set_error("shichi", SF_ERROR_DOMAIN, NULL); chi = {-std::numeric_limits::infinity(), std::numeric_limits::quiet_NaN()}; } else { chi += EULER + std::log(z); - } - return 0; + } + return 0; } std::complex term1 = expi(z); std::complex term2 = expi(-z); - shi = 0.5*(term1 - term2); - chi = 0.5*(term1 + term2); + shi = 0.5 * (term1 - term2); + chi = 0.5 * (term1 + term2); if (z.imag() > 0) { - shi -= std::complex(0.0, 0.5*M_PI); - chi += std::complex(0.0, 0.5*M_PI); + shi -= std::complex(0.0, 0.5 * M_PI); + chi += std::complex(0.0, 0.5 * M_PI); } else if (z.imag() < 0) { - shi += std::complex(0.0, 0.5*M_PI); - chi -= std::complex(0.0, 0.5*M_PI); + shi += std::complex(0.0, 0.5 * M_PI); + chi -= std::complex(0.0, 0.5 * M_PI); } else if (z.real() < 0) { chi += std::complex(0.0, M_PI); } return 0; } -XSF_HOST_DEVICE inline int shichi(std::complex z, - std::complex &shi_f, std::complex &chi_f) { +XSF_HOST_DEVICE inline int shichi(std::complex z, std::complex &shi_f, std::complex &chi_f) { std::complex shi; std::complex chi; int res = shichi(z, shi, chi); @@ -172,13 +167,9 @@ XSF_HOST_DEVICE inline int shichi(std::complex z, return res; } -XSF_HOST_DEVICE inline int sici(double x, double &si, double &ci) { - return cephes::sici(x, si, ci); -} +XSF_HOST_DEVICE inline int sici(double x, double &si, double &ci) { return cephes::sici(x, si, ci); } -XSF_HOST_DEVICE inline int shichi(double x, double &shi, double &chi) { - return cephes::shichi(x, shi, chi); -} +XSF_HOST_DEVICE inline int shichi(double x, double &shi, double &chi) { return cephes::shichi(x, shi, chi); } XSF_HOST_DEVICE inline int sici(float x, float &si_f, float &ci_f) { double si; @@ -197,4 +188,4 @@ XSF_HOST_DEVICE inline int shichi(float x, float &shi_f, float &chi_f) { chi_f = chi; return res; } -} +} // namespace xsf diff --git a/include/xsf/specfun.h b/include/xsf/specfun.h index 278625a..444b296 100644 --- a/include/xsf/specfun.h +++ b/include/xsf/specfun.h @@ -5,22 +5,22 @@ #define SPECFUN_ZCONVINF(func, z) \ do { \ - if ((double) (z).real() == (double) 1.0e300) { \ + if ((double)(z).real() == (double)1.0e300) { \ set_error(func, SF_ERROR_OVERFLOW, NULL); \ (z).real(std::numeric_limits::infinity()); \ } \ - if ((double) (z).real() == (double) -1.0e300) { \ + if ((double)(z).real() == (double)-1.0e300) { \ set_error(func, SF_ERROR_OVERFLOW, NULL); \ (z).real(-std::numeric_limits::infinity()); \ } \ } while (0) #define SPECFUN_CONVINF(func, x) \ do { \ - if ((double) (x) == (double) 1.0e300) { \ + if ((double)(x) == (double)1.0e300) { \ set_error(func, SF_ERROR_OVERFLOW, NULL); \ (x) = std::numeric_limits::infinity(); \ } \ - if ((double) (x) == (double) -1.0e300) { \ + if ((double)(x) == (double)-1.0e300) { \ set_error(func, SF_ERROR_OVERFLOW, NULL); \ (x) = -std::numeric_limits::infinity(); \ } \ @@ -98,10 +98,10 @@ inline double pmv(double m, double v, double x) { if (m != floor(m)) { return std::numeric_limits::quiet_NaN(); } - int_m = (int) m; + int_m = (int)m; out = specfun::lpmv(x, int_m, v); SPECFUN_CONVINF("pmv", out); return out; } -} // namespace special +} // namespace xsf diff --git a/include/xsf/specfun/specfun.h b/include/xsf/specfun/specfun.h index dd90091..6247601 100644 --- a/include/xsf/specfun/specfun.h +++ b/include/xsf/specfun/specfun.h @@ -70,1788 +70,2001 @@ #pragma once -#include #include "../config.h" +#include namespace xsf { namespace specfun { -// The Status enum is the return type of a few private, low-level functions -// defined here. Currently the only use is by functions that allocate -// memory internally. If the allocation fails, the function returns -// Status::NoMemory. - -enum class Status { - OK = 0, - NoMemory, - Other -}; - -void airyb(double, double*, double*, double*, double*); -void bjndd(double, int, double *, double *, double *); - -void cerzo(int, std::complex *); - -void cyzo(int, int, int, std::complex*, std::complex *); - -void cerf(std::complex, std::complex *, std::complex *); -std::complex cgama(std::complex, int); -double chgubi(double, double, double, int *); -double chguit(double, double, double, int *); -double chgul(double, double, double, int *); -double chgus(double, double, double, int *); -void cpbdn(int, std::complex, std::complex *, std::complex *); -std::complex cpdla(int, std::complex); -std::complex cpdsa(int, std::complex); -double cv0(double, double, double); -double cvf(int, int, double, double, int); -double cvql(int, int, double); -double cvqm(int, double); -double gaih(double); -double gam0(double); -double gamma2(double); - -template -void jynbh(int, int, T, int *, T *, T *); - -void jyndd(int, double, double *, double *, double *, double *, double *, double *); - -double lpmv0(double, int, double); -int msta1(double, int); -int msta2(double, int, int); -double psi_spec(double); -double refine(int, int, double, double); - -template -void sckb(int, int, T, T *, T *); - -template -Status sdmn(int, int, T, T, int, T *); - -template -void sphj(T, int, int *, T *, T *); - -template -void sphy(T, int, int *, T *, T *); - -template -Status aswfa(T x, int m, int n, T c, int kd, T cv, T *s1f, T *s1d) { - - // =========================================================== - // Purpose: Compute the prolate and oblate spheroidal angular - // functions of the first kind and their derivatives - // Input : m --- Mode parameter, m = 0,1,2,... - // n --- Mode parameter, n = m,m+1,... - // c --- Spheroidal parameter - // x --- Argument of angular function, |x| < 1.0 - // KD --- Function code - // KD=1 for prolate; KD=-1 for oblate - // cv --- Characteristic value - // Output: S1F --- Angular function of the first kind - // S1D --- Derivative of the angular function of - // the first kind - // Return value: - // Status::OK - // Normal return. - // Status::NoMemory - // An internal memory allocation failed. - // - // Routine called: - // SDMN for computing expansion coefficients df - // SCKB for computing expansion coefficients ck - // =========================================================== - - int ip, k, nm, nm2; - T a0, d0, d1, r, su1, su2, x0, x1; - auto ck = std::unique_ptr{new (std::nothrow) T[200]()}; - auto df = std::unique_ptr{new (std::nothrow) T[200]()}; - if (ck == nullptr || df == nullptr) { - return Status::NoMemory; - } - const T eps = 1e-14; - x0 = x; - x = fabs(x); - ip = ((n-m) % 2 == 0 ? 0 : 1); - nm = 40 + (int)((n-m)/2 + c); - nm2 = nm/2 - 2; - if (sdmn(m, n, c, cv, kd, df.get()) == Status::NoMemory) { - return Status::NoMemory; - } - sckb(m, n, c, df.get(), ck.get()); - x1 = 1.0 - x*x; - if ((m == 0) && (x1 == 0.0)) { - a0 = 1.0; - } else { - a0 = pow(x1, 0.5*m); - } - su1 = ck[0]; - for (k = 1; k <= nm2; k++) { - r = ck[k]*pow(x1, k); - su1 += r; - if ((k >= 10) && (fabs(r/su1) < eps)) { break; } - } - *s1f = a0*pow(x, ip)*su1; - if (x == 1.0) { - if (m == 0) { - *s1d = ip*ck[0] - 2.0*ck[1]; - } else if (m == 1) { - *s1d = -1e100; - } else if (m == 2) { - *s1d = -2.0*ck[0]; - } else if (m >= 3) { - *s1d = 0.0; - } - } else { - d0 = ip - m/x1*pow(x, ip+1.0); - d1 = -2.0*a0*pow(x, ip+1.0); - su2 = ck[1]; - for (k = 2; k <= nm2; k++) { - r = k*ck[k]*pow(x1, (k-1.0)); - su2 += r; - if ((k >= 10) && (fabs(r/su2) < eps)) { break; } - } - *s1d = d0*a0*su1 + d1*su2; - } - if ((x0 < 0.0) && (ip == 0)) { *s1d = -*s1d; } - if ((x0 < 0.0) && (ip == 1)) { *s1f = -*s1f; } - x = x0; - return Status::OK; -} - - -inline void bernob(int n, double *bn) { - - // ====================================== - // Purpose: Compute Bernoulli number Bn - // Input : n >= 3 --- Serial number - // Output: BN(n) --- Bn - // ====================================== - - int k, m; - double r1, r2, s; - const double tpi = 6.283185307179586; - - bn[0] = 1.0; - bn[1] = -0.5; - bn[2] = 1.0 / 6.0; - r1 = pow(2.0 / tpi, 2); - for ( m = 4; m < (n+1); m += 2) { - r1 = -r1 * (m-1)*m/(tpi*tpi); - r2 = 1.0; - for (k = 2; k < 10001; k++) { - s = pow(1.0/k, m); - r2 += s; - if (s < 1e-15) { break; } - } - bn[m] = r1*r2; + // The Status enum is the return type of a few private, low-level functions + // defined here. Currently the only use is by functions that allocate + // memory internally. If the allocation fails, the function returns + // Status::NoMemory. + + enum class Status { OK = 0, NoMemory, Other }; + + void airyb(double, double *, double *, double *, double *); + void bjndd(double, int, double *, double *, double *); + + void cerzo(int, std::complex *); + + void cyzo(int, int, int, std::complex *, std::complex *); + + void cerf(std::complex, std::complex *, std::complex *); + std::complex cgama(std::complex, int); + double chgubi(double, double, double, int *); + double chguit(double, double, double, int *); + double chgul(double, double, double, int *); + double chgus(double, double, double, int *); + void cpbdn(int, std::complex, std::complex *, std::complex *); + std::complex cpdla(int, std::complex); + std::complex cpdsa(int, std::complex); + double cv0(double, double, double); + double cvf(int, int, double, double, int); + double cvql(int, int, double); + double cvqm(int, double); + double gaih(double); + double gam0(double); + double gamma2(double); + + template + void jynbh(int, int, T, int *, T *, T *); + + void jyndd(int, double, double *, double *, double *, double *, double *, double *); + + double lpmv0(double, int, double); + int msta1(double, int); + int msta2(double, int, int); + double psi_spec(double); + double refine(int, int, double, double); + + template + void sckb(int, int, T, T *, T *); + + template + Status sdmn(int, int, T, T, int, T *); + + template + void sphj(T, int, int *, T *, T *); + + template + void sphy(T, int, int *, T *, T *); + + template + Status aswfa(T x, int m, int n, T c, int kd, T cv, T *s1f, T *s1d) { + + // =========================================================== + // Purpose: Compute the prolate and oblate spheroidal angular + // functions of the first kind and their derivatives + // Input : m --- Mode parameter, m = 0,1,2,... + // n --- Mode parameter, n = m,m+1,... + // c --- Spheroidal parameter + // x --- Argument of angular function, |x| < 1.0 + // KD --- Function code + // KD=1 for prolate; KD=-1 for oblate + // cv --- Characteristic value + // Output: S1F --- Angular function of the first kind + // S1D --- Derivative of the angular function of + // the first kind + // Return value: + // Status::OK + // Normal return. + // Status::NoMemory + // An internal memory allocation failed. + // + // Routine called: + // SDMN for computing expansion coefficients df + // SCKB for computing expansion coefficients ck + // =========================================================== + + int ip, k, nm, nm2; + T a0, d0, d1, r, su1, su2, x0, x1; + auto ck = std::unique_ptr{new (std::nothrow) T[200]()}; + auto df = std::unique_ptr{new (std::nothrow) T[200]()}; + if (ck == nullptr || df == nullptr) { + return Status::NoMemory; + } + const T eps = 1e-14; + x0 = x; + x = fabs(x); + ip = ((n - m) % 2 == 0 ? 0 : 1); + nm = 40 + (int)((n - m) / 2 + c); + nm2 = nm / 2 - 2; + if (sdmn(m, n, c, cv, kd, df.get()) == Status::NoMemory) { + return Status::NoMemory; + } + sckb(m, n, c, df.get(), ck.get()); + x1 = 1.0 - x * x; + if ((m == 0) && (x1 == 0.0)) { + a0 = 1.0; + } else { + a0 = pow(x1, 0.5 * m); + } + su1 = ck[0]; + for (k = 1; k <= nm2; k++) { + r = ck[k] * pow(x1, k); + su1 += r; + if ((k >= 10) && (fabs(r / su1) < eps)) { + break; + } + } + *s1f = a0 * pow(x, ip) * su1; + if (x == 1.0) { + if (m == 0) { + *s1d = ip * ck[0] - 2.0 * ck[1]; + } else if (m == 1) { + *s1d = -1e100; + } else if (m == 2) { + *s1d = -2.0 * ck[0]; + } else if (m >= 3) { + *s1d = 0.0; + } + } else { + d0 = ip - m / x1 * pow(x, ip + 1.0); + d1 = -2.0 * a0 * pow(x, ip + 1.0); + su2 = ck[1]; + for (k = 2; k <= nm2; k++) { + r = k * ck[k] * pow(x1, (k - 1.0)); + su2 += r; + if ((k >= 10) && (fabs(r / su2) < eps)) { + break; + } + } + *s1d = d0 * a0 * su1 + d1 * su2; + } + if ((x0 < 0.0) && (ip == 0)) { + *s1d = -*s1d; + } + if ((x0 < 0.0) && (ip == 1)) { + *s1f = -*s1f; + } + x = x0; + return Status::OK; } - return; -} - -inline void bjndd(double x, int n, double *bj, double *dj, double *fj) { + inline void bernob(int n, double *bn) { - // ===================================================== - // Purpose: Compute Bessel functions Jn(x) and their - // first and second derivatives ( 0 <= n <= 100) - // Input: x --- Argument of Jn(x) ( x ≥ 0 ) - // n --- Order of Jn(x) - // Output: BJ(n+1) --- Jn(x) - // DJ(n+1) --- Jn'(x) - // FJ(n+1) --- Jn"(x) - // ===================================================== + // ====================================== + // Purpose: Compute Bernoulli number Bn + // Input : n >= 3 --- Serial number + // Output: BN(n) --- Bn + // ====================================== - int k, m, mt; - double bs = 0.0, f = 0.0, f0 = 0.0, f1 = 1e-35; + int k, m; + double r1, r2, s; + const double tpi = 6.283185307179586; - for (m = 1; m < 901; m++) { - mt = (int)(0.5*log10(6.28*m)-m*log10(1.36*fabs(x)/m)); - if (mt > 20) { break; } - } - if (m == 901) { m -= 1; } - for (k = m; k > -1; k--) { - f = 2.0*(k+1.0)*f1/x - f0; - if (k <= n) { bj[k] = f; } - if (k % 2 == 0) { bs += 2.0*f; } - f0 = f1; - f1 = f; - } - for (k = 0; k < (n+1); k++) { - bj[k] /= (bs - f); - } - dj[0] = -bj[1]; - fj[0] = -bj[0] - dj[0]/x; - for (k = 1; k < (n+1); k++) { - dj[k] = bj[k-1] - k*bj[k]/x; - fj[k] = (k*k/(x*x)-1.0)*bj[k] - dj[k]/x; + bn[0] = 1.0; + bn[1] = -0.5; + bn[2] = 1.0 / 6.0; + r1 = pow(2.0 / tpi, 2); + for (m = 4; m < (n + 1); m += 2) { + r1 = -r1 * (m - 1) * m / (tpi * tpi); + r2 = 1.0; + for (k = 2; k < 10001; k++) { + s = pow(1.0 / k, m); + r2 += s; + if (s < 1e-15) { + break; + } + } + bn[m] = r1 * r2; + } + return; } - return; -} + inline void bjndd(double x, int n, double *bj, double *dj, double *fj) { -template -Status cbk(int m, int n, T c, T cv, T qt, T *ck, T *bk) { + // ===================================================== + // Purpose: Compute Bessel functions Jn(x) and their + // first and second derivatives ( 0 <= n <= 100) + // Input: x --- Argument of Jn(x) ( x ≥ 0 ) + // n --- Order of Jn(x) + // Output: BJ(n+1) --- Jn(x) + // DJ(n+1) --- Jn'(x) + // FJ(n+1) --- Jn"(x) + // ===================================================== - // ========================================================== - // Return value: - // Status::OK - // Normal return. - // Status::NoMemory - // An internal memory allocation failed. - // ========================================================== + int k, m, mt; + double bs = 0.0, f = 0.0, f0 = 0.0, f1 = 1e-35; - const T eps = 1.0e-14; + for (m = 1; m < 901; m++) { + mt = (int)(0.5 * log10(6.28 * m) - m * log10(1.36 * fabs(x) / m)); + if (mt > 20) { + break; + } + } + if (m == 901) { + m -= 1; + } + for (k = m; k > -1; k--) { + f = 2.0 * (k + 1.0) * f1 / x - f0; + if (k <= n) { + bj[k] = f; + } + if (k % 2 == 0) { + bs += 2.0 * f; + } + f0 = f1; + f1 = f; + } + for (k = 0; k < (n + 1); k++) { + bj[k] /= (bs - f); + } + dj[0] = -bj[1]; + fj[0] = -bj[0] - dj[0] / x; + for (k = 1; k < (n + 1); k++) { + dj[k] = bj[k - 1] - k * bj[k] / x; + fj[k] = (k * k / (x * x) - 1.0) * bj[k] - dj[k] / x; + } + return; + } - int i, i1, ip, j, k, n2, nm; - T r1, s1, sw, t; + template + Status cbk(int m, int n, T c, T cv, T qt, T *ck, T *bk) { - ip = ((n - m) % 2 == 0 ? 0 : 1); - nm = 25 + (int)(0.5 * (n - m) + c); + // ========================================================== + // Return value: + // Status::OK + // Normal return. + // Status::NoMemory + // An internal memory allocation failed. + // ========================================================== - auto u = std::unique_ptr{new (std::nothrow) T[200]()}; - auto v = std::unique_ptr{new (std::nothrow) T[200]()}; - auto w = std::unique_ptr{new (std::nothrow) T[200]()}; - if (u.get() == nullptr || v.get() == nullptr || w.get() == nullptr) { - return Status::NoMemory; - } + const T eps = 1.0e-14; - u[0] = 0.0; - n2 = nm - 2; + int i, i1, ip, j, k, n2, nm; + T r1, s1, sw, t; - for (j = 1; j < n2 + 1; j++) { - u[j] = c * c; - } - for (j = 1; j < n2 + 1; j++) { - v[j - 1] = (2.0 * j - 1.0 - ip) * (2.0 * (j - m) - ip) + m * (m - 1.0) - cv; - } - for (j = 1; j < nm; j++) - w[j - 1] = (2.0 * j - ip) * (2.0 * j + 1.0 - ip); + ip = ((n - m) % 2 == 0 ? 0 : 1); + nm = 25 + (int)(0.5 * (n - m) + c); - if (ip == 0) { - sw = 0.0; - for (k = 0; k < n2; k++) { - s1 = 0.0; - i1 = k - m + 1; + auto u = std::unique_ptr{new (std::nothrow) T[200]()}; + auto v = std::unique_ptr{new (std::nothrow) T[200]()}; + auto w = std::unique_ptr{new (std::nothrow) T[200]()}; + if (u.get() == nullptr || v.get() == nullptr || w.get() == nullptr) { + return Status::NoMemory; + } - for (i = i1; i < nm + 1; i++) { - if (i < 0) { continue; } - r1 = 1.0; - for (j = 1; j <= k; j++) { - r1 = r1*(i + m - j) / (1.0*j); - } - s1 += ck[i] * (2.0 * i + m) * r1; - if (fabs(s1 - sw) < fabs(s1) * eps) { break; } - sw = s1; - } - bk[k] = qt * s1; + u[0] = 0.0; + n2 = nm - 2; + + for (j = 1; j < n2 + 1; j++) { + u[j] = c * c; } - } else if (ip == 1) { - sw = 0.0; - for (k = 0; k < n2; k++) { - s1 = 0.0; - i1 = k - m + 1; + for (j = 1; j < n2 + 1; j++) { + v[j - 1] = (2.0 * j - 1.0 - ip) * (2.0 * (j - m) - ip) + m * (m - 1.0) - cv; + } + for (j = 1; j < nm; j++) + w[j - 1] = (2.0 * j - ip) * (2.0 * j + 1.0 - ip); - for (int i = i1; i < nm + 1; i++) { - if (i < 0) { continue; } - r1 = 1.0; - for (j = 1; j <= k; j++) { - r1 = r1* (i + m - j) / (1.0*j); - } - if (i > 0) { - s1 += ck[i - 1] * (2.0 * i + m - 1) * r1; + if (ip == 0) { + sw = 0.0; + for (k = 0; k < n2; k++) { + s1 = 0.0; + i1 = k - m + 1; + + for (i = i1; i < nm + 1; i++) { + if (i < 0) { + continue; + } + r1 = 1.0; + for (j = 1; j <= k; j++) { + r1 = r1 * (i + m - j) / (1.0 * j); + } + s1 += ck[i] * (2.0 * i + m) * r1; + if (fabs(s1 - sw) < fabs(s1) * eps) { + break; + } + sw = s1; } - s1 -= ck[i] * (2.0 * i + m) * r1; + bk[k] = qt * s1; + } + } else if (ip == 1) { + sw = 0.0; + for (k = 0; k < n2; k++) { + s1 = 0.0; + i1 = k - m + 1; + + for (int i = i1; i < nm + 1; i++) { + if (i < 0) { + continue; + } + r1 = 1.0; + for (j = 1; j <= k; j++) { + r1 = r1 * (i + m - j) / (1.0 * j); + } + if (i > 0) { + s1 += ck[i - 1] * (2.0 * i + m - 1) * r1; + } + s1 -= ck[i] * (2.0 * i + m) * r1; - if (fabs(s1 - sw) < fabs(s1) * eps) { break; } - sw = s1; + if (fabs(s1 - sw) < fabs(s1) * eps) { + break; + } + sw = s1; + } + bk[k] = qt * s1; } - bk[k] = qt * s1; } - } - w[0] /= v[0]; - bk[0] /= v[0]; + w[0] /= v[0]; + bk[0] /= v[0]; - for (k = 2; k <= n2; k++) { - t = v[k - 1] - w[k - 2] * u[k - 1]; - w[k - 1] /= t; - bk[k - 1] = (bk[k - 1] - bk[k - 2] * u[k - 1]) / t; - } + for (k = 2; k <= n2; k++) { + t = v[k - 1] - w[k - 2] * u[k - 1]; + w[k - 1] /= t; + bk[k - 1] = (bk[k - 1] - bk[k - 2] * u[k - 1]) / t; + } - for (k = n2 - 1; k >= 1; k--) { - bk[k - 1] -= w[k - 1] * bk[k]; + for (k = n2 - 1; k >= 1; k--) { + bk[k - 1] -= w[k - 1] * bk[k]; + } + return Status::OK; } - return Status::OK; -} + inline void cerf(std::complex z, std::complex *cer, std::complex *cder) { -inline void cerf(std::complex z, std::complex *cer, std::complex *cder) { + // ========================================================== + // Purpose: Compute complex Error function erf(z) & erf'(z) + // Input: z --- Complex argument of erf(z) + // x --- Real part of z + // y --- Imaginary part of z + // Output: CER --- erf(z) + // CDER --- erf'(z) + // ========================================================== - // ========================================================== - // Purpose: Compute complex Error function erf(z) & erf'(z) - // Input: z --- Complex argument of erf(z) - // x --- Real part of z - // y --- Imaginary part of z - // Output: CER --- erf(z) - // CDER --- erf'(z) - // ========================================================== + int k; + double c0, cs, er0, er, er1, ei1, er2, ei2, err, eri, r, ss, w, w1, w2; + const double eps = 1.0e-12; + const double pi = 3.141592653589793; - int k; - double c0, cs, er0, er, er1, ei1, er2, ei2, err, eri, r, ss, w, w1, w2; - const double eps = 1.0e-12; - const double pi = 3.141592653589793; + double x = z.real(); + double y = z.imag(); + double x2 = x * x; - double x = z.real(); - double y = z.imag(); - double x2 = x * x; + if (x <= 3.5) { + er = 1.0; + r = 1.0; + w = 0.0; - if (x <= 3.5) { - er = 1.0; - r = 1.0; - w = 0.0; + for (k = 1; k <= 100; k++) { + r = r * x2 / (k + 0.5); + er += r; + if (fabs(er - w) <= eps * fabs(er)) + break; + w = er; + } - for (k = 1; k <= 100; k++) { - r = r * x2 / (k + 0.5); - er += r; - if (fabs(er - w) <= eps * fabs(er)) - break; - w = er; - } + c0 = 2.0 / sqrt(pi) * x * exp(-x2); + er0 = c0 * er; + *cer = er0; + } else { + er = 1.0; + r = 1.0; - c0 = 2.0 / sqrt(pi) * x * exp(-x2); - er0 = c0 * er; - *cer = er0; - } else { - er = 1.0; - r = 1.0; + for (k = 1; k <= 12; k++) { + r = -r * (k - 0.5) / x2; + er += r; + } - for (k = 1; k <= 12; k++) { - r = -r * (k - 0.5) / x2; - er += r; + c0 = exp(-x2) / (x * sqrt(pi)); + er0 = 1.0 - c0 * er; + *cer = er0; } - c0 = exp(-x2) / (x * sqrt(pi)); - er0 = 1.0 - c0 * er; - *cer = er0; - } + if (y == 0.0) { + err = cer->real(); + eri = 0.0; + *cer = std::complex(err, eri); + } else { + cs = cos(2.0 * x * y); + ss = sin(2.0 * x * y); + er1 = exp(-x2) * (1.0 - cs) / (2.0 * pi * x); + ei1 = exp(-x2) * ss / (2.0 * pi * x); + er2 = 0.0; + w1 = 0.0; + + for (int n = 1; n <= 100; n++) { + er2 += exp(-0.25 * n * n) / (n * n + 4.0 * x2) * + (2.0 * x - 2.0 * x * cosh(n * y) * cs + n * sinh(n * y) * ss); + if (fabs((er2 - w1) / er2) < eps) + break; + w1 = er2; + } - if (y == 0.0) { - err = cer->real(); - eri = 0.0; - *cer = std::complex(err, eri); - } else { - cs = cos(2.0 * x * y); - ss = sin(2.0 * x * y); - er1 = exp(-x2) * (1.0 - cs) / (2.0 * pi * x); - ei1 = exp(-x2) * ss / (2.0 * pi * x); - er2 = 0.0; - w1 = 0.0; + c0 = 2.0 * exp(-x2) / pi; + err = cer->real() + er1 + c0 * er2; + ei2 = 0.0; + w2 = 0.0; - for (int n = 1; n <= 100; n++) { - er2 += exp(-0.25 * n * n) / (n * n + 4.0 * x2) * (2.0 * x - 2.0 * x * cosh(n * y) * cs + n * sinh(n * y) * ss); - if (fabs((er2 - w1) / er2) < eps) - break; - w1 = er2; + for (int n = 1; n <= 100; n++) { + ei2 += exp(-0.25 * n * n) / (n * n + 4.0 * x2) * (2.0 * x * cosh(n * y) * ss + n * sinh(n * y) * cs); + if (fabs((ei2 - w2) / ei2) < eps) + break; + w2 = ei2; + } + *cer = std::complex(err, ei1 + c0 * ei2); } + *cder = 2.0 / sqrt(pi) * std::exp(-z * z); + } - c0 = 2.0 * exp(-x2) / pi; - err = cer->real() + er1 + c0 * er2; - ei2 = 0.0; - w2 = 0.0; + inline std::complex cerror(std::complex z) { - for (int n = 1; n <= 100; n++) { - ei2 += exp(-0.25 * n * n) / (n * n + 4.0 * x2) * (2.0 * x * cosh(n * y) * ss + n * sinh(n * y) * cs); - if (fabs((ei2 - w2) / ei2) < eps) - break; - w2 = ei2; + // ==================================================== + // Purpose: Compute error function erf(z) for a complex + // argument (z=x+iy) + // Input : z --- Complex argument + // Output: CER --- erf(z) + // ==================================================== + + int k; + std::complex cer, cl, cr, cs, z1; + std::complex c0 = std::exp(-z * z); + const double sqpi = 1.7724538509055160273; + z1 = z; + if (z.real() < 0.0) { + z1 = -z; } - *cer = std::complex(err, ei1 + c0 * ei2); - } - *cder = 2.0 / sqrt(pi) * std::exp(-z*z); - -} - - -inline std::complex cerror(std::complex z) { - - // ==================================================== - // Purpose: Compute error function erf(z) for a complex - // argument (z=x+iy) - // Input : z --- Complex argument - // Output: CER --- erf(z) - // ==================================================== - - int k; - std::complex cer, cl, cr, cs, z1; - std::complex c0 = std::exp(-z*z); - const double sqpi = 1.7724538509055160273; - z1 = z; - if (z.real() < 0.0) { z1 = -z; } - // Cutoff radius R = 4.36; determined by balancing rounding error - // and asymptotic expansion error, see below. - // - // The resulting maximum global accuracy expected is around 1e-8 - // - if (std::abs(z) <= 4.36) { - // Rounding error in the Taylor expansion is roughly - // ~ R*R * EPSILON * R**(2 R**2) / (2 R**2 Gamma(R**2 + 1/2)) - cs = z1; - cr = z1; - for (k = 1; k < 121; k++) { - cr = cr*(z1*z1) / (k+0.5); - cs += cr; - if (std::abs(cr/cs) < 1e-15) { break; } - } - cer = 2.0*c0*cs/sqpi; - } else { - cl = 1.0 / z1; - cr = cl; - // Asymptotic series; maximum K must be at most ~ R^2. + // Cutoff radius R = 4.36; determined by balancing rounding error + // and asymptotic expansion error, see below. // - // The maximum accuracy obtainable from this expansion is roughly + // The resulting maximum global accuracy expected is around 1e-8 // - // ~ Gamma(2R**2 + 2) / ( - // (2 R**2)**(R**2 + 1/2) Gamma(R**2 + 3/2) 2**(R**2 + 1/2)) - for (k = 1; k < 21; k++) { - cr = -cr*(k-0.5) / (z1*z1); - cl += cr; - if (std::abs(cr/cl) < 1e-15) { break; } - } - cer = 1.0 - c0*cl/sqpi; + if (std::abs(z) <= 4.36) { + // Rounding error in the Taylor expansion is roughly + // ~ R*R * EPSILON * R**(2 R**2) / (2 R**2 Gamma(R**2 + 1/2)) + cs = z1; + cr = z1; + for (k = 1; k < 121; k++) { + cr = cr * (z1 * z1) / (k + 0.5); + cs += cr; + if (std::abs(cr / cs) < 1e-15) { + break; + } + } + cer = 2.0 * c0 * cs / sqpi; + } else { + cl = 1.0 / z1; + cr = cl; + // Asymptotic series; maximum K must be at most ~ R^2. + // + // The maximum accuracy obtainable from this expansion is roughly + // + // ~ Gamma(2R**2 + 2) / ( + // (2 R**2)**(R**2 + 1/2) Gamma(R**2 + 3/2) 2**(R**2 + 1/2)) + for (k = 1; k < 21; k++) { + cr = -cr * (k - 0.5) / (z1 * z1); + cl += cr; + if (std::abs(cr / cl) < 1e-15) { + break; + } + } + cer = 1.0 - c0 * cl / sqpi; + } + if (z.real() < 0.0) { + cer = -cer; + } + return cer; + } + + inline void cerzo(int nt, std::complex *zo) { + + // =============================================================== + // Purpose : Evaluate the complex zeros of error function erf(z) + // using the modified Newton's iteration method + // Input : NT --- Total number of zeros + // Output: ZO(L) --- L-th zero of erf(z), L=1,2,...,NT + // Routine called: CERF for computing erf(z) and erf'(z) + // =============================================================== + + int i, j, nr, it = 0; + double pu, pv, px, py, w0; + std::complex z, zf, zd, zp, zw, zq, zfd, zgd; + double w = 0.0; + const double pi = 3.141592653589793; + + for (nr = 1; nr <= nt; nr++) { + pu = sqrt(pi * (4.0 * nr - 0.5)); + pv = pi * sqrt(2.0 * nr - 0.25); + px = 0.5 * pu - 0.5 * log(pv) / pu; + py = 0.5 * pu + 0.5 * log(pv) / pu; + z = std::complex(px, py); + it = 0; + + do { + it++; + cerf(z, &zf, &zd); + zp = 1.0; + + for (i = 1; i < nr; i++) { + zp *= (z - zo[i - 1]); + } + zfd = zf / zp; + zq = 0.0; + for (i = 1; i < nr; i++) { + zw = 1.0; + for (j = 1; j < nr; j++) { + if (j == i) + continue; + zw *= (z - zo[j - 1]); + } + zq += zw; + } + zgd = (zd - zq * zfd) / zp; + z -= zfd / zgd; + w0 = w; + w = std::abs(z); + } while ((it <= 50) && (fabs((w - w0) / w) > 1.0e-11)); + zo[nr - 1] = z; + } + return; } - if (z.real() < 0.0) { cer = -cer; } - return cer; -} - - -inline void cerzo(int nt, std::complex *zo) { - - // =============================================================== - // Purpose : Evaluate the complex zeros of error function erf(z) - // using the modified Newton's iteration method - // Input : NT --- Total number of zeros - // Output: ZO(L) --- L-th zero of erf(z), L=1,2,...,NT - // Routine called: CERF for computing erf(z) and erf'(z) - // =============================================================== - - int i, j, nr, it = 0; - double pu, pv, px, py, w0; - std::complex z, zf, zd, zp, zw, zq, zfd, zgd; - double w = 0.0; - const double pi = 3.141592653589793; - - for (nr = 1; nr <= nt; nr++) { - pu = sqrt(pi * (4.0 * nr - 0.5)); - pv = pi * sqrt(2.0 * nr - 0.25); - px = 0.5 * pu - 0.5 * log(pv) / pu; - py = 0.5 * pu + 0.5 * log(pv) / pu; - z = std::complex(px, py); - it = 0; - - do { - it++; - cerf(z, &zf, &zd); - zp = 1.0; - - for (i = 1; i < nr; i++) { - zp *= (z - zo[i - 1]); - } - zfd = zf / zp; - zq = 0.0; - for (i = 1; i < nr; i++) { - zw = 1.0; - for (j = 1; j < nr; j++) { - if (j == i) continue; - zw *= (z - zo[j - 1]); + + inline std::complex cchg(double a, double b, std::complex z) { + + // =================================================== + // Purpose: Compute confluent hypergeometric function + // M(a,b,z) with real parameters a, b and a + // complex argument z + // Input : a --- Parameter + // b --- Parameter + // z --- Complex argument + // Output: CHG --- M(a,b,z) + // Routine called: CGAMA for computing complex ln[Г(x)] + // =================================================== + + int i, j, k, la, m, n, nl, ns; + double a0, a1, phi, x0, x, y; + std::complex cfac, cg1, cg2, cg3, chg, chg1, chg2, chw, cr, cr1, cr2, cs1, cs2, crg, cy0, cy1, z0; + const double pi = 3.141592653589793; + const std::complex ci(0.0, 1.0); + a0 = a; + a1 = a; + z0 = z; + cy0 = 0.0; + cy1 = 0.0; + if ((b == 0.0) || (b == -(int)fabs(b))) { + return 1e300; + } + if ((a == 0.0) || (z == 0.0)) { + return 1.0; + } + if (a == -1.0) { + return 1.0 - z / b; + } + if (a == b) { + return std::exp(z); + } + if (a - b == 1.0) { + return (1.0 + z / b) * std::exp(z); + } + if ((a == 1.0) && (b == 2.0)) { + return (std::exp(z) - 1.0) / z; + } + if ((a == (int)a) && (a < 0.0)) { + m = (int)(-a); + cr = 1.0; + chg = 1.0; + for (k = 1; k < (m + 1); k++) { + cr = cr * (a + k - 1.0) / static_cast(k) / (b + k - 1.0) * z; + chg += cr; + } + } else { + x0 = z.real(); + if (x0 < 0.0) { + a = b - a; + a0 = a; + z = -z; + } + nl = 0; + la = 0; + if (a >= 2.0) { + nl = 1; + la = (int)a; + a -= la + 1; + } + ns = 0; + for (n = 0; n < (nl + 1); n++) { + if (a0 >= 2.0) { + a += 1.0; } - zq += zw; - } - zgd = (zd - zq * zfd) / zp; - z -= zfd / zgd; - w0 = w; - w = std::abs(z); - } while ((it <= 50) && (fabs((w - w0) / w) > 1.0e-11)); - zo[nr - 1] = z; + if ((std::abs(z) < 20.0 + fabs(b)) || (a < 0.0)) { + chg = 1.0; + chw = 0.0; + crg = 1.0; + for (j = 1; j < 501; j++) { + crg = crg * (a + j - 1.0) / (j * (b + j - 1.0)) * z; + chg += crg; + if (std::abs((chg - chw) / chg) < 1e-15) { + break; + } + chw = chg; + } + } else { + y = 0.0; + cg1 = cgama(a, 0); + cg2 = cgama(b, 0); + cg3 = cgama(b - a, 0); + cs1 = 1.0; + cs2 = 1.0; + cr1 = 1.0; + cr2 = 1.0; + for (i = 1; i <= 8; i++) { + cr1 = -cr1 * (a + i - 1.0) * (a - b + i) / (z * static_cast(i)); + cr2 = cr2 * (b - a + i - 1.0) * (i - a) / (z * static_cast(i)); + cs1 += cr1; + cs2 += cr2; + } + x = z.real(); + y = z.imag(); + if ((x == 0.0) && (y >= 0.0)) { + phi = 0.5 * pi; + } else if ((x == 0.0) && (y <= 0.0)) { + phi = -0.5 * pi; + } else { + phi = atan(y / x); + } + if ((phi > -0.5 * pi) && (phi < 1.5 * pi)) { + ns = 1; + } + if ((phi > -1.5 * pi) && (phi <= -0.5 * pi)) { + ns = -1; + } + cfac = std::exp(static_cast(ns) * ci * pi * a); + if (y == 0.0) { + cfac = cos(pi * a); + } + chg1 = std::exp(cg2 - cg3) * std::pow(z, -a) * cfac * cs1; + chg2 = std::exp(cg2 - cg1 + z) * std::pow(z, a - b) * cs2; + chg = chg1 + chg2; + } + if (n == 0) { + cy0 = chg; + } + if (n == 1) { + cy1 = chg; + } + } + if (a0 >= 2.0) { + for (i = 1; i < la; i++) { + chg = ((2.0 * a - b + z) * cy1 + (b - a) * cy0) / a; + cy0 = cy1; + cy1 = chg; + a += 1.0; + } + } + if (x0 < 0.0) { + chg *= std::exp(-z); + } + } + a = a1; + z = z0; + return chg; + } + + inline std::complex cgama(std::complex z, int kf) { + + // ========================================================= + // Purpose: Compute the gamma function Г(z) or ln[Г(z)] + // for a complex argument + // Input : z --- Complex argument + // kf --- Function code + // kf=0 for ln[Г(z)] + // kf=1 for Г(z) + // Output: g --- ln[Г(z)] or Г(z) + // ======================================================== + + std::complex g, z1; + double az0, az1, gi, gi1, gr, gr1, t, th, th1, th2, sr, si, x0, xx, yy; + int j, k, na; + const double pi = 3.141592653589793; + static const double a[10] = {8.333333333333333e-02, -2.777777777777778e-03, 7.936507936507937e-04, + -5.952380952380952e-04, 8.417508417508418e-04, -1.917526917526918e-03, + 6.410256410256410e-03, -2.955065359477124e-02, 1.796443723688307e-01, + -1.392432216905900e+00}; + xx = z.real(); + yy = z.imag(); + if ((yy == 0.0) && (xx <= 0.0) && (xx == (int)xx)) { + return 1e300; + } else if (xx < 0.0) { + z1 = z; + z = -z; + xx = -xx; + yy = -yy; + } else { + z1 = std::complex(xx, 0.0); + } + x0 = xx; + na = 0; + if (xx <= 7.0) { + na = (int)(7 - xx); + x0 = xx + na; + } + az0 = std::abs(std::complex(x0, yy)); + th = atan(yy / x0); + gr = (x0 - 0.5) * log(az0) - th * yy - x0 + 0.5 * log(2.0 * pi); + gi = th * (x0 - 0.5) + yy * log(az0) - yy; + for (k = 1; k < 11; k++) { + t = pow(az0, 1 - 2 * k); + gr += a[k - 1] * t * cos((2.0 * k - 1.0) * th); + gi += -a[k - 1] * t * sin((2.0 * k - 1.0) * th); + } + if (xx <= 7.0) { + gr1 = 0.0; + gi1 = 0.0; + for (j = 0; j < na; j++) { + gr1 += 0.5 * log(pow(xx + j, 2) + yy * yy); + gi1 += atan(yy / (xx + j)); + } + gr -= gr1; + gi -= gi1; + } + if (z1.real() < 0.0) { + az0 = std::abs(z); + th1 = atan(yy / xx); + sr = -sin(pi * xx) * cosh(pi * yy); + si = -cos(pi * xx) * sinh(pi * yy); + az1 = std::abs(std::complex(sr, si)); + th2 = atan(si / sr); + if (sr < 0.0) { + th2 += pi; + } + gr = log(pi / (az0 * az1)) - gr; + gi = -th1 - th2 - gi; + z = z1; + } + if (kf == 1) { + g = exp(gr) * std::complex(cos(gi), sin(gi)); + } else { + g = std::complex(gr, gi); + } + return g; } - return; -} - -inline std::complex cchg(double a, double b, std::complex z) { - - // =================================================== - // Purpose: Compute confluent hypergeometric function - // M(a,b,z) with real parameters a, b and a - // complex argument z - // Input : a --- Parameter - // b --- Parameter - // z --- Complex argument - // Output: CHG --- M(a,b,z) - // Routine called: CGAMA for computing complex ln[Г(x)] - // =================================================== - - int i, j, k, la, m, n, nl, ns; - double a0, a1, phi, x0, x, y; - std::complex cfac, cg1, cg2, cg3, chg, chg1, chg2, chw, cr, cr1, cr2, cs1, - cs2, crg, cy0, cy1, z0; - const double pi = 3.141592653589793; - const std::complex ci(0.0, 1.0); - a0 = a; - a1 = a; - z0 = z; - cy0 = 0.0; - cy1 = 0.0; - if ((b == 0.0) || (b == -(int)fabs(b))) { return 1e300; } - if ((a == 0.0) || (z == 0.0)) { return 1.0; } - if (a == -1.0) { return 1.0 - z/b; } - if (a == b) { return std::exp(z); } - if (a - b == 1.0) { return (1.0 + z/b)*std::exp(z); } - if ((a == 1.0) && (b == 2.0)) { return (std::exp(z)-1.0) / z; } - if ((a == (int)a) && (a < 0.0)) { - m = (int)(-a); - cr = 1.0; - chg = 1.0; - for (k = 1; k < (m+1); k++) { - cr = cr * (a+k-1.0)/static_cast(k)/(b+k-1.0)*z; - chg += cr; - } - } else { - x0 = z.real(); - if (x0 < 0.0) { - a = b-a; + + inline double chgm(double x, double a, double b) { + + // =================================================== + // Purpose: Compute confluent hypergeometric function + // M(a,b,x) + // Input : a --- Parameter + // b --- Parameter ( b <> 0,-1,-2,... ) + // x --- Argument + // Output: HG --- M(a,b,x) + // Routine called: CGAMA for computing complex ln[Г(x)] + // =================================================== + + int i, j, la, n, nl; + double a0 = a, a1 = a, x0 = x, y0, y1, hg1, hg2, r1, r2, rg, xg, sum1, sum2; + std::complex cta, ctb, ctba; + const double pi = 3.141592653589793; + double hg = 0.0; + + // DLMF 13.2.39 + if (x < 0.0) { + a = b - a; a0 = a; - z = -z; + x = fabs(x); } nl = 0; la = 0; if (a >= 2.0) { + // preparing terms for DLMF 13.3.1 nl = 1; la = (int)a; a -= la + 1; } - ns = 0; - for (n = 0; n < (nl+1); n++) { - if (a0 >= 2.0) { a += 1.0; } - if ((std::abs(z) < 20.0+fabs(b)) || (a < 0.0)) { - chg = 1.0; - chw = 0.0; - crg = 1.0; + y0 = 0.0; + y1 = 0.0; + for (n = 0; n < (nl + 1); n++) { + if (a0 >= 2.0) { + a += 1.0; + } + if ((x <= 30.0 + fabs(b)) || (a < 0.0)) { + hg = 1.0; + rg = 1.0; for (j = 1; j < 501; j++) { - crg = crg * (a+j-1.0)/(j*(b+j-1.0))*z; - chg += crg; - if (std::abs((chg-chw)/chg) < 1e-15) { break; } - chw = chg; + rg = rg * (a + j - 1.0) / (j * (b + j - 1.0)) * x; + hg += rg; + if ((hg != 0.0) && (fabs(rg / hg) < 1e-15)) { + // DLMF 13.2.39 (cf. above) + if (x0 < 0.0) { + hg *= exp(x0); + } + break; + } } } else { - y = 0.0; - cg1 = cgama(a, 0); - cg2 = cgama(b, 0); - cg3 = cgama(b-a, 0); - cs1 = 1.0; - cs2 = 1.0; - cr1 = 1.0; - cr2 = 1.0; - for (i = 1; i <= 8; i++) { - cr1 = -cr1 * (a+i-1.0)*(a-b+i)/(z*static_cast(i)); - cr2 = cr2 * (b-a+i-1.0)*(i-a)/(z*static_cast(i)); - cs1 += cr1; - cs2 += cr2; + // DLMF 13.7.2 & 13.2.4, SUM2 corresponds to first sum + cta = cgama(a, 0); + ctb = cgama(b, 0); + xg = b - a; + ctba = cgama(xg, 0); + sum1 = 1.0; + sum2 = 1.0; + r1 = 1.0; + r2 = 1.0; + for (i = 1; i < 9; i++) { + r1 = -r1 * (a + i - 1.0) * (a - b + i) / (x * i); + r2 = -r2 * (b - a + i - 1.0) * (a - i) / (x * i); + sum1 += r1; + sum2 += r2; } - x = z.real(); - y = z.imag(); - if ((x == 0.0) && (y >= 0.0)) { - phi = 0.5*pi; - } else if ((x == 0.0) && (y <= 0.0)) { - phi = -0.5*pi; + if (x0 >= 0.0) { + hg1 = (std::exp(ctb - ctba)).real() * pow(x, -a) * cos(pi * a) * sum1; + hg2 = (std::exp(ctb - cta + x)).real() * pow(x, a - b) * sum2; } else { - phi = atan(y/x); + // DLMF 13.2.39 (cf. above) + hg1 = (std::exp(ctb - ctba + x0)).real() * pow(x, -a) * cos(pi * a) * sum1; + hg2 = (std::exp(ctb - cta)).real() * pow(x, a - b) * sum2; } - if ((phi > -0.5*pi) && (phi < 1.5*pi)) { ns = 1; } - if ((phi > -1.5*pi) && (phi <= -0.5*pi)) { ns = -1; } - cfac = std::exp(static_cast(ns)*ci*pi*a); - if (y == 0.0) { cfac = cos(pi*a); } - chg1 = std::exp(cg2-cg3)*std::pow(z, -a)*cfac*cs1; - chg2 = std::exp(cg2-cg1+z)*std::pow(z, a-b)*cs2; - chg = chg1 + chg2; + hg = hg1 + hg2; + } + /* 25 */ + if (n == 0) { + y0 = hg; + } + if (n == 1) { + y1 = hg; } - if (n == 0) { cy0 = chg; } - if (n == 1) { cy1 = chg; } } if (a0 >= 2.0) { + // DLMF 13.3.1 for (i = 1; i < la; i++) { - chg = ((2.0*a-b+z)*cy1 + (b-a)*cy0)/a; - cy0 = cy1; - cy1 = chg; + hg = ((2.0 * a - b + x) * y1 + (b - a) * y0) / a; + y0 = y1; + y1 = hg; a += 1.0; } } - if (x0 < 0.0) { chg *= std::exp(-z); } - } - a = a1; - z = z0; - return chg; -} - - -inline std::complex cgama(std::complex z, int kf) { - - // ========================================================= - // Purpose: Compute the gamma function Г(z) or ln[Г(z)] - // for a complex argument - // Input : z --- Complex argument - // kf --- Function code - // kf=0 for ln[Г(z)] - // kf=1 for Г(z) - // Output: g --- ln[Г(z)] or Г(z) - // ======================================================== - - std::complex g, z1; - double az0, az1, gi, gi1, gr, gr1, t, th, th1, th2, sr, si, x0, xx, yy; - int j, k, na; - const double pi = 3.141592653589793; - static const double a[10] = { - 8.333333333333333e-02, -2.777777777777778e-03, - 7.936507936507937e-04, -5.952380952380952e-04, - 8.417508417508418e-04, -1.917526917526918e-03, - 6.410256410256410e-03, -2.955065359477124e-02, - 1.796443723688307e-01, -1.392432216905900e+00 - }; - xx = z.real(); - yy = z.imag(); - if ((yy == 0.0) && (xx <= 0.0) && (xx == (int)xx)) { - return 1e300; - } else if (xx < 0.0) { - z1 = z; - z = -z; - xx = -xx; - yy = -yy; - } else { - z1 = std::complex(xx, 0.0); - } - x0 = xx; - na = 0; - if (xx <= 7.0) { - na = (int)(7 - xx); - x0 = xx + na; - } - az0 = std::abs(std::complex(x0, yy)); - th = atan(yy / x0); - gr = (x0 - 0.5)*log(az0) - th*yy - x0 + 0.5*log(2.0*pi); - gi = th*(x0 - 0.5) + yy*log(az0) - yy; - for (k = 1; k < 11; k++) { - t = pow(az0, 1-2*k); - gr += a[k - 1]*t*cos((2.0*k - 1.0)*th); - gi += -a[k - 1]*t*sin((2.0*k - 1.0)*th); - } - if (xx <= 7.0) { - gr1 = 0.0; - gi1 = 0.0; - for (j = 0; j < na; j++) { - gr1 += 0.5*log(pow(xx + j, 2) + yy*yy); - gi1 += atan(yy/(xx + j)); - } - gr -= gr1; - gi -= gi1; - } - if (z1.real() < 0.0) { - az0 = std::abs(z); - th1 = atan(yy/xx); - sr = -sin(pi*xx)*cosh(pi*yy); - si = -cos(pi*xx)*sinh(pi*yy); - az1 = std::abs(std::complex(sr, si)); - th2 = atan(si/sr); - if (sr < 0.0) { - th2 += pi; - } - gr = log(pi/(az0*az1)) - gr; - gi = - th1 - th2 - gi; - z = z1; - } - if (kf == 1) { - g = exp(gr)*std::complex(cos(gi), sin(gi)); - } else { - g = std::complex(gr, gi); - } - return g; -} - - -inline double chgm(double x, double a, double b) { - - // =================================================== - // Purpose: Compute confluent hypergeometric function - // M(a,b,x) - // Input : a --- Parameter - // b --- Parameter ( b <> 0,-1,-2,... ) - // x --- Argument - // Output: HG --- M(a,b,x) - // Routine called: CGAMA for computing complex ln[Г(x)] - // =================================================== - - int i, j, la, n, nl; - double a0 = a, a1 = a, x0 = x, y0, y1, hg1, hg2, r1, r2, rg, xg, sum1, sum2; - std::complex cta, ctb, ctba; - const double pi = 3.141592653589793; - double hg = 0.0; - - // DLMF 13.2.39 - if (x < 0.0) { - a = b - a; - a0 = a; - x = fabs(x); - } - nl = 0; - la = 0; - if (a >= 2.0) { - // preparing terms for DLMF 13.3.1 - nl = 1; - la = (int)a; - a -= la+1; - } - y0 = 0.0; - y1 = 0.0; - for (n = 0; n < (nl + 1); n++) { - if (a0 >= 2.0) { a += 1.0; } - if ((x <= 30.0 + fabs(b)) || (a < 0.0)) { - hg = 1.0; - rg = 1.0; - for (j = 1; j < 501; j++) { - rg = rg * (a + j - 1.0) / (j*(b + j - 1.0))*x; - hg += rg; - if ((hg != 0.0) && (fabs(rg/hg) < 1e-15)) { - // DLMF 13.2.39 (cf. above) - if (x0 < 0.0) { hg *= exp(x0); } - break; - } + a = a1; + x = x0; + return hg; + } + + inline double chgu(double x, double a, double b, int *md, int *isfer) { + + // ======================================================= + // Purpose: Compute the confluent hypergeometric function + // U(a,b,x) + // Input : a --- Parameter + // b --- Parameter + // x --- Argument ( x > 0 ) + // Output: HU --- U(a,b,x) + // MD --- Method code + // ISFER --- Error flag + // Routines called: + // (1) CHGUS for small x ( MD=1 ) + // (2) CHGUL for large x ( MD=2 ) + // (3) CHGUBI for integer b ( MD=3 ) + // (4) CHGUIT for numerical integration ( MD=4 ) + // ======================================================= + + int il1, il2, il3, bl1, bl2, bl3, bn, id1 = 0, id; + double aa, hu = 0.0, hu1, b00; + + aa = a - b + 1.0; + *isfer = 0; + il1 = (a == (int)a) && (a <= 0.0); + il2 = (aa == (int)aa) && (aa <= 0.0); + il3 = fabs(a * (a - b + 1.0)) / x <= 2.0; + bl1 = (x <= 5.0) || (x <= 10.0 && a <= 2.0); + bl2 = (x > 5.0) && (x <= 12.5) && ((a >= 1.0) && (b >= a + 4.0)); + bl3 = (x > 12.5) && (a >= 5.0) && (b >= a + 5.0); + bn = (b == (int)b) && (b != 0.0); + + id = -100; + hu1 = 0.0; + if (b != (int)b) { + hu = chgus(x, a, b, &id1); + *md = 1; + if (id1 >= 9) { + return hu; } - } else { - // DLMF 13.7.2 & 13.2.4, SUM2 corresponds to first sum - cta = cgama(a, 0); - ctb = cgama(b, 0); - xg = b-a; - ctba = cgama(xg, 0); - sum1 = 1.0; - sum2 = 1.0; - r1 = 1.0; - r2 = 1.0; - for (i = 1; i < 9; i++) { - r1 = -r1*(a+i-1.0)*(a-b+i)/(x*i); - r2 = -r2*(b-a+i-1.0)*(a-i)/(x*i); - sum1 += r1; - sum2 += r2; - } - if (x0 >= 0.0) { - hg1 = (std::exp(ctb-ctba)).real()*pow(x, -a)*cos(pi*a)*sum1; - hg2 = (std::exp(ctb-cta+x)).real()*pow(x, a-b)*sum2; - } else { - // DLMF 13.2.39 (cf. above) - hg1 = (std::exp(ctb-ctba+x0)).real()*pow(x, -a)*cos(pi*a)*sum1; - hg2 = (std::exp(ctb-cta)).real()*pow(x, a-b)*sum2; + hu1 = hu; + } + if (il1 || il2 || il3) { + hu = chgul(x, a, b, &id); + *md = 2; + if (id >= 9) { + return hu; + } + if (id1 > id) { + *md = 1; + id = id1; + hu = hu1; } - hg = hg1 + hg2; } - /* 25 */ - if (n == 0) { y0 = hg; } - if (n == 1) { y1 = hg; } - } - if (a0 >= 2.0) { - // DLMF 13.3.1 - for (i = 1; i < la; i++) { - hg = ((2.0*a - b + x)*y1 + (b - a)*y0) / a; - y0 = y1; - y1 = hg; - a += 1.0; + if (a >= 1.0) { + if (bn && (bl1 || bl2 || bl3)) { + hu = chgubi(x, a, b, &id); + *md = 3; + } else { + hu = chguit(x, a, b, &id); + *md = 4; + } + } else { + if (b <= a) { + b00 = b; + a -= b - 1.0; + b = 2.0 - b; + hu = chguit(x, a, b, &id); + hu *= pow(x, 1.0 - b00); + *md = 4; + } else if (bn && (~il1)) { + hu = chgubi(x, a, b, &id); + *md = 3; + } } - } - a = a1; - x = x0; - return hg; -} - - -inline double chgu(double x, double a, double b, int *md, int *isfer) { - - // ======================================================= - // Purpose: Compute the confluent hypergeometric function - // U(a,b,x) - // Input : a --- Parameter - // b --- Parameter - // x --- Argument ( x > 0 ) - // Output: HU --- U(a,b,x) - // MD --- Method code - // ISFER --- Error flag - // Routines called: - // (1) CHGUS for small x ( MD=1 ) - // (2) CHGUL for large x ( MD=2 ) - // (3) CHGUBI for integer b ( MD=3 ) - // (4) CHGUIT for numerical integration ( MD=4 ) - // ======================================================= - - int il1, il2, il3, bl1, bl2, bl3, bn, id1 = 0, id; - double aa, hu = 0.0, hu1, b00; - - aa = a - b + 1.0; - *isfer = 0; - il1 = (a == (int)a) && (a <= 0.0); - il2 = (aa == (int)aa) && (aa <= 0.0); - il3 = fabs(a*(a-b+1.0))/x <= 2.0; - bl1 = (x <= 5.0) || (x <= 10.0 && a <= 2.0); - bl2 = (x > 5.0) && (x <= 12.5) && ((a >= 1.0) && (b >= a+4.0)); - bl3 = (x > 12.5) && (a >= 5.0) && (b >= a + 5.0); - bn = (b == (int)b) && (b != 0.0); - - id = -100; - hu1 = 0.0; - if (b != (int)b) { - hu = chgus(x, a, b, &id1); - *md = 1; - if (id1 >= 9) { return hu; } - hu1 = hu; - } - if (il1 || il2 || il3) { - hu = chgul(x, a, b, &id); - *md = 2; - if (id >= 9) { return hu; } - if (id1 > id) { - *md = 1; - id = id1; - hu = hu1; + if (id < 6) { + *isfer = 6; + } + return hu; + } + + inline double chgubi(double x, double a, double b, int *id) { + + // ====================================================== + // Purpose: Compute confluent hypergeometric function + // U(a,b,x) with integer b ( b = ±1,±2,... ) + // Input : a --- Parameter + // b --- Parameter + // x --- Argument + // Output: HU --- U(a,b,x) + // ID --- Estimated number of significant digits + // Routines called: + // (1) GAMMA2 for computing gamma function Г(x) + // (2) PSI_SPEC for computing psi function + // ====================================================== + + int id1, id2, j, k, m, n; + double a0, a1, a2, da1, da2, db1, db2, ga, ga1, h0, hm1, hm2, hm3, hmax, hmin, hu, hu1, hu2, hw, ps, r, rn, rn1, + s0, s1, s2, sa, sb, ua, ub; + const double el = 0.5772156649015329; + + *id = -100; + n = (int)fabs(b - 1); + rn1 = 1.0; + rn = 1.0; + for (j = 1; j <= n; j++) { + rn *= j; + if (j == n - 1) { + rn1 = rn; + } } - } - if (a >= 1.0) { - if (bn && (bl1 || bl2 || bl3)) { - hu = chgubi(x, a, b, &id); - *md = 3; + ps = psi_spec(a); + ga = gamma2(a); + if (b > 0.0) { + a0 = a; + a1 = a - n; + a2 = a1; + ga1 = gamma2(a1); + ua = pow(-1, n - 1) / (rn * ga1); + ub = rn1 / ga * pow(x, -n); } else { - hu = chguit(x, a, b, &id); - *md = 4; - } - } else { - if (b <= a) { - b00 = b; - a -= b - 1.0; - b = 2.0 - b; - hu = chguit(x, a, b, &id); - hu *= pow(x, 1.0 - b00); - *md = 4; - } else if (bn && (~il1)) { - hu = chgubi(x, a, b, &id); - *md = 3; - } - } - if (id < 6) { *isfer = 6; } - return hu; -} - - -inline double chgubi(double x, double a, double b, int *id) { - - // ====================================================== - // Purpose: Compute confluent hypergeometric function - // U(a,b,x) with integer b ( b = ±1,±2,... ) - // Input : a --- Parameter - // b --- Parameter - // x --- Argument - // Output: HU --- U(a,b,x) - // ID --- Estimated number of significant digits - // Routines called: - // (1) GAMMA2 for computing gamma function Г(x) - // (2) PSI_SPEC for computing psi function - // ====================================================== - - int id1, id2, j, k, m, n; - double a0, a1, a2, da1, da2, db1, db2, ga, ga1, h0, hm1, hm2, hm3,\ - hmax, hmin, hu, hu1, hu2, hw, ps, r, rn, rn1, s0, s1, s2,\ - sa, sb, ua, ub; - const double el = 0.5772156649015329; - - *id = -100; - n = (int)fabs(b-1); - rn1 = 1.0; - rn = 1.0; - for (j = 1; j <= n; j++) { - rn *= j; - if (j == n-1) { - rn1 = rn; + a0 = a + n; + a1 = a0; + a2 = a; + ga1 = gamma2(a1); + ua = pow(-1, n - 1) / (rn * ga) * pow(x, n); + ub = rn1 / ga1; + } + hm1 = 1.0; + r = 1.0; + hmax = 0.0; + hmin = 1e300; + h0 = 0.0; + for (k = 1; k <= 150; k++) { + r = r * (a0 + k - 1) * x / ((n + k) * k); + hm1 += r; + hu1 = fabs(hm1); + + if (hu1 > hmax) { + hmax = hu1; + } + if (hu1 < hmin) { + hmin = hu1; + } + if (fabs(hm1 - h0) < fabs(hm1) * 1.0e-15) { + break; + } + h0 = hm1; } - } - ps = psi_spec(a); - ga = gamma2(a); - if (b > 0.0) { - a0 = a; - a1 = a - n; - a2 = a1; - ga1 = gamma2(a1); - ua = pow(-1, n-1) / (rn * ga1); - ub = rn1 / ga * pow(x, -n); - } else { - a0 = a + n; - a1 = a0; - a2 = a; - ga1 = gamma2(a1); - ua = pow(-1, n-1) / (rn * ga) * pow(x, n); - ub = rn1 / ga1; - } - hm1 = 1.0; - r = 1.0; - hmax = 0.0; - hmin = 1e300; - h0 = 0.0; - for (k = 1; k <= 150; k++) { - r = r * (a0 + k - 1) * x / ((n + k) * k); - hm1 += r; - hu1 = fabs(hm1); - - if (hu1 > hmax) { - hmax = hu1; - } - if (hu1 < hmin) { - hmin = hu1; - } - if (fabs(hm1 - h0) < fabs(hm1) * 1.0e-15) { break; } - h0 = hm1; - } - da1 = log10(hmax); - da2 = 0; + da1 = log10(hmax); + da2 = 0; - if (hmin != 0) { - da2 = log10(hmin); - } + if (hmin != 0) { + da2 = log10(hmin); + } - *id = 15 - (int)fabs(da1 - da2); - hm1 *= log(x); - s0 = 0; + *id = 15 - (int)fabs(da1 - da2); + hm1 *= log(x); + s0 = 0; - for (m = 1; m <= n; m++) { - if (b >= 0) { - s0 -= 1.0 / m; - } - if (b < 0) { - s0 += (1.0 - a) / (m * (a + m - 1)); + for (m = 1; m <= n; m++) { + if (b >= 0) { + s0 -= 1.0 / m; + } + if (b < 0) { + s0 += (1.0 - a) / (m * (a + m - 1)); + } } - } - hm2 = ps + 2 * el + s0; - r = 1; - hmax = 0; - hmin = 1.0e+300; + hm2 = ps + 2 * el + s0; + r = 1; + hmax = 0; + hmin = 1.0e+300; - for (k = 1; k <= 150; k++) { - s1 = 0; - s2 = 0; + for (k = 1; k <= 150; k++) { + s1 = 0; + s2 = 0; - if (b > 0) { - for (m = 1; m <= k; m++) { - s1 -= (m + 2 * a - 2) / (m * (m + a - 1)); - } - for (m = 1; m <= n; m++) { - s2 += 1.0 / (k + m); + if (b > 0) { + for (m = 1; m <= k; m++) { + s1 -= (m + 2 * a - 2) / (m * (m + a - 1)); + } + for (m = 1; m <= n; m++) { + s2 += 1.0 / (k + m); + } + } else { + for (m = 1; m <= k + n; m++) { + s1 += (1.0 - a) / (m * (m + a - 1)); + } + for (m = 1; m <= k; m++) { + s2 += 1.0 / m; + } } - } else { - for (m = 1; m <= k + n; m++) { - s1 += (1.0 - a) / (m * (m + a - 1)); + + hw = 2 * el + ps + s1 - s2; + r = r * (a0 + k - 1) * x / ((n + k) * k); + hm2 += r * hw; + hu2 = fabs(hm2); + + if (hu2 > hmax) { + hmax = hu2; } - for (m = 1; m <= k; m++) { - s2 += 1.0 / m; + + if (hu2 < hmin) { + hmin = hu2; } - } - hw = 2 * el + ps + s1 - s2; - r = r * (a0 + k - 1) * x / ((n + k) * k); - hm2 += r * hw; - hu2 = fabs(hm2); + if (fabs((hm2 - h0) / hm2) < 1.0e-15) { + break; + } - if (hu2 > hmax) { - hmax = hu2; + h0 = hm2; } - if (hu2 < hmin) { - hmin = hu2; + db1 = log10(hmax); + db2 = 0.0; + if (hmin != 0.0) { + db2 = log10(hmin); } - - if (fabs((hm2 - h0) / hm2) < 1.0e-15) { - break; + id1 = 15 - (int)fabs(db1 - db2); + if (id1 < *id) { + *id = id1; } - - h0 = hm2; - } - - db1 = log10(hmax); - db2 = 0.0; - if (hmin != 0.0) { db2 = log10(hmin); } - id1 = 15 - (int)fabs(db1 - db2); - if (id1 < *id) { *id = id1; } - hm3 = 1.0; - if (n == 0) { hm3 = 0.0; } - r = 1.0; - for (k = 1; k < n; k++) { - r = r * (a2 + k - 1.0) / ((k - n)*k)*x; - hm3 += r; - } - sa = ua*(hm1 + hm2); - sb = ub*hm3; - hu = sa + sb; - id2 = 0; - if (sa != 0.0) { id1 = (int)(log10(fabs(sa))); } - if (hu != 0.0) { id2 = (int)(log10(fabs(hu))); } - if (sa*sb < 0.0) { *id -= abs(id1-id2); } - return hu; -} - - -inline double chguit(double x, double a, double b, int *id) { - - // ====================================================== - // Purpose: Compute hypergeometric function U(a,b,x) by - // using Gaussian-Legendre integration (n=60) - // Input : a --- Parameter ( a > 0 ) - // b --- Parameter - // x --- Argument ( x > 0 ) - // Output: HU --- U(a,b,z) - // ID --- Estimated number of significant digits - // Routine called: GAMMA2 for computing Г(x) - // ====================================================== - - int k, j, m; - double a1, b1, c, d, f1, f2, g, ga, hu, hu0, hu1, hu2, s, t1, t2, t3, t4; - static const double t[30] = { - 0.259597723012478e-01, 0.778093339495366e-01, 0.129449135396945e+00, 0.180739964873425e+00, - 0.231543551376029e+00, 0.281722937423262e+00, 0.331142848268448e+00, 0.379670056576798e+00, - 0.427173741583078e+00, 0.473525841761707e+00, 0.518601400058570e+00, 0.562278900753945e+00, - 0.604440597048510e+00, 0.644972828489477e+00, 0.683766327381356e+00, 0.720716513355730e+00, - 0.755723775306586e+00, 0.788693739932264e+00, 0.819537526162146e+00, 0.848171984785930e+00, - 0.874519922646898e+00, 0.898510310810046e+00, 0.920078476177628e+00, 0.939166276116423e+00, - 0.955722255839996e+00, 0.969701788765053e+00, 0.981067201752598e+00, 0.989787895222222e+00, - 0.995840525118838e+00, 0.999210123227436e+00 - }; - static const double w[30] = { - 0.519078776312206e-01, 0.517679431749102e-01, 0.514884515009810e-01, 0.510701560698557e-01, - 0.505141845325094e-01, 0.498220356905502e-01, 0.489955754557568e-01, 0.480370318199712e-01, - 0.469489888489122e-01, 0.457343797161145e-01, 0.443964787957872e-01, 0.429388928359356e-01, - 0.413655512355848e-01, 0.396806954523808e-01, 0.378888675692434e-01, 0.359948980510845e-01, - 0.340038927249464e-01, 0.319212190192963e-01, 0.297524915007890e-01, 0.275035567499248e-01, - 0.251804776215213e-01, 0.227895169439978e-01, 0.203371207294572e-01, 0.178299010142074e-01, - 0.152746185967848e-01, 0.126781664768159e-01, 0.100475571822880e-01, 0.738993116334531e-02, - 0.471272992695363e-02, 0.202681196887362e-02 - }; - *id = 9; - // DLMF 13.4.4, integration up to C=12/X - a1 = a - 1.0; - b1 = b - a - 1.0; - c = 12.0 / x; - hu0 = 0.0; - for (m = 10; m <= 100; m += 5) { - hu1 = 0.0; - g=0.5 * c / m; - d=g; - for (j = 1; j < (m + 1); j++) { - s = 0.0; - for (k = 1; k <= 30; k++) { - t1 = d + g * t[k-1]; - t2 = d - g * t[k-1]; - f1 = exp(-x*t1) * pow(t1, a1) * pow(1.0 + t1, b1); - f2 = exp(-x*t2) * pow(t2, a1) * pow(1.0 + t2, b1); - s += w[k-1]*(f1 + f2); - } - hu1 += s * g; - d += 2.0 * g; + hm3 = 1.0; + if (n == 0) { + hm3 = 0.0; } - if (fabs(1.0 - hu0/hu1) < 1.0e-9) { break; } - hu0 = hu1; - } - ga = gamma2(a); - hu1 /= ga; - // DLMF 13.4.4 with substitution t=C/(1-u) - // integration u from 0 to 1, i.e. t from C=12/X to infinity - for (m = 2; m <= 10; m += 2) { - hu2 = 0.0; - g = 0.5 / m; - d = g; - for (j = 1; j <= m; j++) { - s = 0.0; - for (k = 1; k <= 30; k++) { - t1 = d + g * t[k-1]; - t2 = d - g * t[k-1]; - t3 = c / (1.0 - t1); - t4 = c / (1.0 - t2); - f1 = t3*t3 / c * exp(-x*t3)*pow(t3, a1)*pow(1.0 + t3, b1); - f2 = t4*t4 / c * exp(-x*t4)*pow(t4, a1)*pow(1.0 + t4, b1); - s += w[k-1]*(f1 + f2); - } - hu2 += s*g; - d += 2.0*g; - } - if (fabs(1.0 - hu0/hu2) < 1.0e-9) { break; } - hu0 = hu2; - } - ga = gamma2(a); - hu2 /= ga; - hu = hu1 + hu2; - return hu; -} - - -inline double chgul(double x, double a, double b, int *id) { - - // ======================================================= - // Purpose: Compute the confluent hypergeometric function - // U(a,b,x) for large argument x - // Input : a --- Parameter - // b --- Parameter - // x --- Argument - // Output: HU --- U(a,b,x) - // ID --- Estimated number of significant digits - // ======================================================= - - int il1, il2, k, nm; - double aa, hu, r, r0 = 0.0, ra = 0.0; - - *id = -100; - aa = a - b + 1.0; - il1 = (a == (int)a) && (a <= 0.0); - il2 = (aa == (int)aa) && (aa <= 0.0); - nm = 0; - if (il1) { nm = (int)fabs(a); } - if (il2) { nm = (int)fabs(aa); } - // IL1: DLMF 13.2.7 with k=-s-a - // IL2: DLMF 13.2.8 - if (il1 || il2) { - hu = 1.0; - r = 1.0; - for (k = 1; k <= nm; k++) { - r = -r*(a + k - 1.0)*(a - b + k) / (k*x); - hu += r; - } - hu *= pow(x, -a); - *id = 10; - } else { - // DLMF 13.7.3 - hu = 1.0; r = 1.0; - for (k = 1; k <= 25; k++) { - r = -r*(a + k - 1.0)*(a - b + k) / (k*x); - ra = fabs(r); - if (((k > 5) && (ra >= r0)) || (ra < 1e-15)) { break; } - r0 = ra; - hu += r; - } - *id = (int)fabs(log10(ra)); - hu *= pow(x, -a); - } - return hu; -} - - -inline double chgus(double x, double a, double b, int *id) { - - // ====================================================== - // Purpose: Compute confluent hypergeometric function - // U(a,b,x) for small argument x - // Input : a --- Parameter - // b --- Parameter ( b <> 0,-1,-2,...) - // x --- Argument - // Output: HU --- U(a,b,x) - // ID --- Estimated number of significant digits - // Routine called: GAMMA2 for computing gamma function - // ====================================================== - - // DLMF 13.2.42 with prefactors rewritten according to - // DLMF 5.5.3, M(a, b, x) with DLMF 13.2.2 - int j; - double d1, d2, ga, gb, gab, gb2, h0, hmax, hmin, hu, hu0, hua, r1, r2; - const double pi = 3.141592653589793; - - *id = 100; - ga = gamma2(a); - gb = gamma2(b); - gab = gamma2(1.0 + a - b); - gb2 = gamma2(2.0 - b); - hu0 = pi / sin(pi*b); - r1 = hu0 / (gab*gb); - r2 = hu0*pow(x, 1.0 - b) / (ga*gb2); - hu = r1 - r2; - hmax = 0.0; - hmin = 1e300; - h0 = 0.0; - for (j = 1; j < 151; j++) { - r1 = r1*(a + j - 1.0) / (j*(b + j - 1.0))*x; - r2 = r2*(a - b + j) / (j*(1.0 - b + j))*x; - hu += r1 - r2; - hua = fabs(hu); - if (hua > hmax) { hmax = hua; } - if (hua < hmin) { hmin = hua; } - if (fabs(hu - h0) < fabs(hu)*1e-15) { break; } - h0 = hu; - } - d1 = log10(hmax); - d2 = 0.0; - if (hmin != 0.0) { d2 = log10(hmin); } - *id = 15 - (d1 - d2 < 0 ? d2 - d1 : d1 - d2); - return hu; -} - - -inline void cpbdn(int n, std::complex z, std::complex *cpb, std::complex *cpd) { - - // ================================================== - // Purpose: Compute the parabolic cylinder functions - // Dn(z) and Dn'(z) for a complex argument - // Input: z --- Complex argument of Dn(z) - // n --- Order of Dn(z) ( n=0,±1,±2,… ) - // Output: CPB(|n|) --- Dn(z) - // CPD(|n|) --- Dn'(z) - // Routines called: - // (1) CPDSA for computing Dn(z) for a small |z| - // (2) CPDLA for computing Dn(z) for a large |z| - // ================================================== - - int n0, n1, nm1; - double a0, x; - std::complex ca0, cf, cf0, cf1, cfa, cfb, cs0, z1; - const double pi = 3.141592653589793; - - x = z.real(); - a0 = std::abs(z); - ca0 = std::exp(-0.25 * z * conj(z)); - n0 = 0; - - if (n >= 0) { - cf0 = ca0; - cf1 = z * ca0; - - cpb[0] = cf0; - cpb[1] = cf1; - - for (int k = 2; k <= n; ++k) { - cf = z * cf1 - (k - 1.0) * cf0; - cpb[k] = cf; - cf0 = cf1; - cf1 = cf; - } - } else { - n0 = -n; - - if (x <= 0.0 || a0 == 0.0) { - cf0 = ca0; - cpb[0] = cf0; - - z1 = -z; - - if (a0 <= 7.0) { - cpb[1] = cpdsa(-1, z1); - } else { - cpb[1] = cpdla(-1, z1); + for (k = 1; k < n; k++) { + r = r * (a2 + k - 1.0) / ((k - n) * k) * x; + hm3 += r; + } + sa = ua * (hm1 + hm2); + sb = ub * hm3; + hu = sa + sb; + id2 = 0; + if (sa != 0.0) { + id1 = (int)(log10(fabs(sa))); + } + if (hu != 0.0) { + id2 = (int)(log10(fabs(hu))); + } + if (sa * sb < 0.0) { + *id -= abs(id1 - id2); + } + return hu; + } + + inline double chguit(double x, double a, double b, int *id) { + + // ====================================================== + // Purpose: Compute hypergeometric function U(a,b,x) by + // using Gaussian-Legendre integration (n=60) + // Input : a --- Parameter ( a > 0 ) + // b --- Parameter + // x --- Argument ( x > 0 ) + // Output: HU --- U(a,b,z) + // ID --- Estimated number of significant digits + // Routine called: GAMMA2 for computing Г(x) + // ====================================================== + + int k, j, m; + double a1, b1, c, d, f1, f2, g, ga, hu, hu0, hu1, hu2, s, t1, t2, t3, t4; + static const double t[30] = {0.259597723012478e-01, 0.778093339495366e-01, 0.129449135396945e+00, + 0.180739964873425e+00, 0.231543551376029e+00, 0.281722937423262e+00, + 0.331142848268448e+00, 0.379670056576798e+00, 0.427173741583078e+00, + 0.473525841761707e+00, 0.518601400058570e+00, 0.562278900753945e+00, + 0.604440597048510e+00, 0.644972828489477e+00, 0.683766327381356e+00, + 0.720716513355730e+00, 0.755723775306586e+00, 0.788693739932264e+00, + 0.819537526162146e+00, 0.848171984785930e+00, 0.874519922646898e+00, + 0.898510310810046e+00, 0.920078476177628e+00, 0.939166276116423e+00, + 0.955722255839996e+00, 0.969701788765053e+00, 0.981067201752598e+00, + 0.989787895222222e+00, 0.995840525118838e+00, 0.999210123227436e+00}; + static const double w[30] = {0.519078776312206e-01, 0.517679431749102e-01, 0.514884515009810e-01, + 0.510701560698557e-01, 0.505141845325094e-01, 0.498220356905502e-01, + 0.489955754557568e-01, 0.480370318199712e-01, 0.469489888489122e-01, + 0.457343797161145e-01, 0.443964787957872e-01, 0.429388928359356e-01, + 0.413655512355848e-01, 0.396806954523808e-01, 0.378888675692434e-01, + 0.359948980510845e-01, 0.340038927249464e-01, 0.319212190192963e-01, + 0.297524915007890e-01, 0.275035567499248e-01, 0.251804776215213e-01, + 0.227895169439978e-01, 0.203371207294572e-01, 0.178299010142074e-01, + 0.152746185967848e-01, 0.126781664768159e-01, 0.100475571822880e-01, + 0.738993116334531e-02, 0.471272992695363e-02, 0.202681196887362e-02}; + *id = 9; + // DLMF 13.4.4, integration up to C=12/X + a1 = a - 1.0; + b1 = b - a - 1.0; + c = 12.0 / x; + hu0 = 0.0; + for (m = 10; m <= 100; m += 5) { + hu1 = 0.0; + g = 0.5 * c / m; + d = g; + for (j = 1; j < (m + 1); j++) { + s = 0.0; + for (k = 1; k <= 30; k++) { + t1 = d + g * t[k - 1]; + t2 = d - g * t[k - 1]; + f1 = exp(-x * t1) * pow(t1, a1) * pow(1.0 + t1, b1); + f2 = exp(-x * t2) * pow(t2, a1) * pow(1.0 + t2, b1); + s += w[k - 1] * (f1 + f2); + } + hu1 += s * g; + d += 2.0 * g; + } + if (fabs(1.0 - hu0 / hu1) < 1.0e-9) { + break; + } + hu0 = hu1; + } + ga = gamma2(a); + hu1 /= ga; + // DLMF 13.4.4 with substitution t=C/(1-u) + // integration u from 0 to 1, i.e. t from C=12/X to infinity + for (m = 2; m <= 10; m += 2) { + hu2 = 0.0; + g = 0.5 / m; + d = g; + for (j = 1; j <= m; j++) { + s = 0.0; + for (k = 1; k <= 30; k++) { + t1 = d + g * t[k - 1]; + t2 = d - g * t[k - 1]; + t3 = c / (1.0 - t1); + t4 = c / (1.0 - t2); + f1 = t3 * t3 / c * exp(-x * t3) * pow(t3, a1) * pow(1.0 + t3, b1); + f2 = t4 * t4 / c * exp(-x * t4) * pow(t4, a1) * pow(1.0 + t4, b1); + s += w[k - 1] * (f1 + f2); + } + hu2 += s * g; + d += 2.0 * g; + } + if (fabs(1.0 - hu0 / hu2) < 1.0e-9) { + break; + } + hu0 = hu2; + } + ga = gamma2(a); + hu2 /= ga; + hu = hu1 + hu2; + return hu; + } + + inline double chgul(double x, double a, double b, int *id) { + + // ======================================================= + // Purpose: Compute the confluent hypergeometric function + // U(a,b,x) for large argument x + // Input : a --- Parameter + // b --- Parameter + // x --- Argument + // Output: HU --- U(a,b,x) + // ID --- Estimated number of significant digits + // ======================================================= + + int il1, il2, k, nm; + double aa, hu, r, r0 = 0.0, ra = 0.0; + + *id = -100; + aa = a - b + 1.0; + il1 = (a == (int)a) && (a <= 0.0); + il2 = (aa == (int)aa) && (aa <= 0.0); + nm = 0; + if (il1) { + nm = (int)fabs(a); + } + if (il2) { + nm = (int)fabs(aa); + } + // IL1: DLMF 13.2.7 with k=-s-a + // IL2: DLMF 13.2.8 + if (il1 || il2) { + hu = 1.0; + r = 1.0; + for (k = 1; k <= nm; k++) { + r = -r * (a + k - 1.0) * (a - b + k) / (k * x); + hu += r; + } + hu *= pow(x, -a); + *id = 10; + } else { + // DLMF 13.7.3 + hu = 1.0; + r = 1.0; + for (k = 1; k <= 25; k++) { + r = -r * (a + k - 1.0) * (a - b + k) / (k * x); + ra = fabs(r); + if (((k > 5) && (ra >= r0)) || (ra < 1e-15)) { + break; + } + r0 = ra; + hu += r; + } + *id = (int)fabs(log10(ra)); + hu *= pow(x, -a); + } + return hu; + } + + inline double chgus(double x, double a, double b, int *id) { + + // ====================================================== + // Purpose: Compute confluent hypergeometric function + // U(a,b,x) for small argument x + // Input : a --- Parameter + // b --- Parameter ( b <> 0,-1,-2,...) + // x --- Argument + // Output: HU --- U(a,b,x) + // ID --- Estimated number of significant digits + // Routine called: GAMMA2 for computing gamma function + // ====================================================== + + // DLMF 13.2.42 with prefactors rewritten according to + // DLMF 5.5.3, M(a, b, x) with DLMF 13.2.2 + int j; + double d1, d2, ga, gb, gab, gb2, h0, hmax, hmin, hu, hu0, hua, r1, r2; + const double pi = 3.141592653589793; + + *id = 100; + ga = gamma2(a); + gb = gamma2(b); + gab = gamma2(1.0 + a - b); + gb2 = gamma2(2.0 - b); + hu0 = pi / sin(pi * b); + r1 = hu0 / (gab * gb); + r2 = hu0 * pow(x, 1.0 - b) / (ga * gb2); + hu = r1 - r2; + hmax = 0.0; + hmin = 1e300; + h0 = 0.0; + for (j = 1; j < 151; j++) { + r1 = r1 * (a + j - 1.0) / (j * (b + j - 1.0)) * x; + r2 = r2 * (a - b + j) / (j * (1.0 - b + j)) * x; + hu += r1 - r2; + hua = fabs(hu); + if (hua > hmax) { + hmax = hua; } + if (hua < hmin) { + hmin = hua; + } + if (fabs(hu - h0) < fabs(hu) * 1e-15) { + break; + } + h0 = hu; + } + d1 = log10(hmax); + d2 = 0.0; + if (hmin != 0.0) { + d2 = log10(hmin); + } + *id = 15 - (d1 - d2 < 0 ? d2 - d1 : d1 - d2); + return hu; + } + + inline void cpbdn(int n, std::complex z, std::complex *cpb, std::complex *cpd) { + + // ================================================== + // Purpose: Compute the parabolic cylinder functions + // Dn(z) and Dn'(z) for a complex argument + // Input: z --- Complex argument of Dn(z) + // n --- Order of Dn(z) ( n=0,±1,±2,… ) + // Output: CPB(|n|) --- Dn(z) + // CPD(|n|) --- Dn'(z) + // Routines called: + // (1) CPDSA for computing Dn(z) for a small |z| + // (2) CPDLA for computing Dn(z) for a large |z| + // ================================================== + + int n0, n1, nm1; + double a0, x; + std::complex ca0, cf, cf0, cf1, cfa, cfb, cs0, z1; + const double pi = 3.141592653589793; + + x = z.real(); + a0 = std::abs(z); + ca0 = std::exp(-0.25 * z * conj(z)); + n0 = 0; + + if (n >= 0) { + cf0 = ca0; + cf1 = z * ca0; - cf1 = std::sqrt(2.0 * pi) / ca0 - cpb[1]; + cpb[0] = cf0; cpb[1] = cf1; - for (int k = 2; k < n0; ++k) { - cf = (-z * cf1 + cf0) / (k - 1.0); + for (int k = 2; k <= n; ++k) { + cf = z * cf1 - (k - 1.0) * cf0; cpb[k] = cf; cf0 = cf1; cf1 = cf; } - } else if (a0 <= 3.0) { - cpb[n0] = cpdsa(-n0, z); - n1 = n0 + 1; - cpb[n1] = cpdsa(-n1, z); - - nm1 = n0 - 1; - for (int k = nm1; k >= 0; --k) { - cf = z * cpb[n0] + (k + 1.0) * cpb[n1]; - cpb[k] = cf; - cpb[n1] = cpb[n0]; - cpb[n0] = cf; - } } else { - int m = 100 + abs(n); - cfa = 0.0; - cfb = 1.0e-30; + n0 = -n; + + if (x <= 0.0 || a0 == 0.0) { + cf0 = ca0; + cpb[0] = cf0; + + z1 = -z; + + if (a0 <= 7.0) { + cpb[1] = cpdsa(-1, z1); + } else { + cpb[1] = cpdla(-1, z1); + } - for (int k = m; k >= 0; --k) { - cf = z * cfb + (k + 1.0) * cfa; + cf1 = std::sqrt(2.0 * pi) / ca0 - cpb[1]; + cpb[1] = cf1; - if (k <= n0) { + for (int k = 2; k < n0; ++k) { + cf = (-z * cf1 + cf0) / (k - 1.0); + cpb[k] = cf; + cf0 = cf1; + cf1 = cf; + } + } else if (a0 <= 3.0) { + cpb[n0] = cpdsa(-n0, z); + n1 = n0 + 1; + cpb[n1] = cpdsa(-n1, z); + + nm1 = n0 - 1; + for (int k = nm1; k >= 0; --k) { + cf = z * cpb[n0] + (k + 1.0) * cpb[n1]; cpb[k] = cf; + cpb[n1] = cpb[n0]; + cpb[n0] = cf; + } + } else { + int m = 100 + abs(n); + cfa = 0.0; + cfb = 1.0e-30; + + for (int k = m; k >= 0; --k) { + cf = z * cfb + (k + 1.0) * cfa; + + if (k <= n0) { + cpb[k] = cf; + } + + cfa = cfb; + cfb = cf; } - cfa = cfb; - cfb = cf; + cs0 = ca0 / cfb; + + for (int k = 0; k <= n0; ++k) { + cpb[k] = cs0 * cpb[k]; + } } + } - cs0 = ca0 / cfb; + cpd[0] = -0.5 * z * cpb[0]; - for (int k = 0; k <= n0; ++k) { - cpb[k] = cs0 * cpb[k]; + if (n >= 0) { + for (int k = 1; k <= n; ++k) { + cpd[k] = -0.5 * z * cpb[k] + static_cast(k) * cpb[k - 1]; + } + } else { + for (int k = 1; k < n0; ++k) { + cpd[k] = 0.5 * z * cpb[k] - cpb[k - 1]; } } } - cpd[0] = -0.5 * z * cpb[0]; + inline std::complex cpdla(int n, std::complex z) { - if (n >= 0) { - for (int k = 1; k <= n; ++k) { - cpd[k] = -0.5 * z * cpb[k] + static_cast(k) * cpb[k - 1]; - } - } else { - for (int k = 1; k < n0; ++k) { - cpd[k] = 0.5 * z * cpb[k] - cpb[k - 1]; + // =========================================================== + // Purpose: Compute complex parabolic cylinder function Dn(z) + // for large argument + // Input: z --- Complex argument of Dn(z) + // n --- Order of Dn(z) (n = 0,±1,±2,…) + // Output: CDN --- Dn(z) + // =========================================================== + + int k; + std::complex cb0, cr, cdn; + + cb0 = std::pow(z, n) * std::exp(-0.25 * z * z); + cr = 1.0; + cdn = 1.0; + for (k = 1; k <= 16; k++) { + cr = -0.5 * cr * (2.0 * k - n - 1.0) * (2.0 * k - n - 2.0) / (static_cast(k) * z * z); + cdn += cr; + if (std::abs(cr) < std::abs(cdn) * 1e-12) { + break; + } } + return cdn * cb0; } -} + inline std::complex cpdsa(int n, std::complex z) { -inline std::complex cpdla(int n, std::complex z) { + // =========================================================== + // Purpose: Compute complex parabolic cylinder function Dn(z) + // for small argument + // Input: z --- Complex argument of D(z) + // n --- Order of D(z) (n = 0,-1,-2,...) + // Output: CDN --- Dn(z) + // Routine called: GAIH for computing Г(x), x=n/2 (n=1,2,...) + // =========================================================== - // =========================================================== - // Purpose: Compute complex parabolic cylinder function Dn(z) - // for large argument - // Input: z --- Complex argument of Dn(z) - // n --- Order of Dn(z) (n = 0,±1,±2,…) - // Output: CDN --- Dn(z) - // =========================================================== + int m; + double va0, pd, vm, vt, xn; + std::complex ca0, cb0, cdn, cr, cdw, g0, g1, ga0, gm; + const double eps = 1.0e-15; + const double pi = 3.141592653589793; + const double sq2 = sqrt(2.0); - int k; - std::complex cb0, cr, cdn; - - cb0 = std::pow(z, n)*std::exp(-0.25*z*z); - cr = 1.0; - cdn = 1.0; - for (k = 1; k <= 16; k++) { - cr = - 0.5 * cr * (2.0 * k - n - 1.0) * (2.0 * k - n - 2.0) / (static_cast(k) * z * z); - cdn += cr; - if (std::abs(cr) < std::abs(cdn) * 1e-12) { break; } + ca0 = std::exp(-0.25 * z * z); + va0 = 0.5 * (1.0 - n); + if (n == 0.0) { + cdn = ca0; + } else { + if (std::abs(z) == 0.0) { + if ((va0 <= 0.0) && (va0 == (int)va0)) { + cdn = 0.0; + } else { + ga0 = gaih(va0); + pd = sqrt(pi) / (pow(2.0, -0.5 * n) * ga0.real()); + cdn = pd; + } + } else { + xn = -n; + g1 = gaih(xn); + cb0 = pow(2.0, -0.5 * n - 1.0) * ca0 / g1; + vt = -0.5 * n; + g0 = gaih(vt); + cdn = g0; + cr = std::complex(1.0, 0.0); + + for (m = 1; m <= 250; m++) { + vm = 0.5 * (m - n); + gm = gaih(vm); + cr = -cr * sq2 * z / static_cast(m); + cdw = gm * cr; + cdn += cdw; + if (std::abs(cdw) < std::abs(cdn) * eps) { + break; + } + } + cdn *= cb0; + } + } + return cdn; } - return cdn * cb0; -} - - -inline std::complex cpdsa(int n, std::complex z) { - - // =========================================================== - // Purpose: Compute complex parabolic cylinder function Dn(z) - // for small argument - // Input: z --- Complex argument of D(z) - // n --- Order of D(z) (n = 0,-1,-2,...) - // Output: CDN --- Dn(z) - // Routine called: GAIH for computing Г(x), x=n/2 (n=1,2,...) - // =========================================================== - - int m; - double va0, pd, vm, vt, xn; - std::complex ca0, cb0, cdn, cr, cdw, g0, g1, ga0, gm; - const double eps = 1.0e-15; - const double pi = 3.141592653589793; - const double sq2 = sqrt(2.0); - - ca0 = std::exp(-0.25 * z * z); - va0 = 0.5 * (1.0 - n); - if (n == 0.0) { - cdn = ca0; - } else { - if (std::abs(z) == 0.0) { - if ((va0 <= 0.0) && (va0 == (int)va0)) { - cdn = 0.0; + + inline double cv0(double kd, double m, double q) { + + // ===================================================== + // Purpose: Compute the initial characteristic value of + // Mathieu functions for m ≤ 12 or q ≤ 300 or + // q ≥ m*m + // Input : m --- Order of Mathieu functions + // q --- Parameter of Mathieu functions + // Output: A0 --- Characteristic value + // Routines called: + // (1) CVQM for computing initial characteristic + // value for q ≤ 3*m + // (2) CVQL for computing initial characteristic + // value for q ≥ m*m + // ==================================================== + + double a0 = 0.0, q2 = q * q; + + if (m == 0) { + if (q <= 1.0) { + a0 = (((0.0036392 * q2 - 0.0125868) * q2 + 0.0546875) * q2 - 0.5) * q2; + } else if (q <= 10.0) { + a0 = ((3.999267e-3 * q - 9.638957e-2) * q - 0.88297) * q + 0.5542818; + } else { + a0 = cvql(kd, m, q); + } + } else if (m == 1) { + if ((q <= 1.0) && (kd == 2)) { + a0 = (((-6.51e-4 * q - 0.015625) * q - 0.125) * q + 1.0) * q + 1.0; + } else if (q <= 1.0 && kd == 3) { + a0 = (((-6.51e-4 * q + 0.015625) * q - 0.125) * q - 1.0) * q + 1.0; + } else if (q <= 10.0 && kd == 2) { + a0 = (((-4.94603e-4 * q + 1.92917e-2) * q - 0.3089229) * q + 1.33372) * q + 0.811752; + } else if (q <= 10.0 && kd == 3) { + a0 = ((1.971096e-3 * q - 5.482465e-2) * q - 1.152218) * q + 1.10427; + } else { + a0 = cvql(kd, m, q); + } + } else if (m == 2) { + if (q <= 1.0 && kd == 1) { + a0 = (((-0.0036391 * q2 + 0.0125888) * q2 - 0.0551939) * q2 + 0.416667) * q2 + 4.0; + } else if (q <= 1.0 && kd == 4) { + a0 = (0.0003617 * q2 - 0.0833333) * q2 + 4.0; + } else if (q <= 15.0 && kd == 1) { + a0 = (((3.200972e-4 * q - 8.667445e-3) * q - 1.829032e-4) * q + 0.9919999) * q + 3.3290504; + } else if (q <= 10.0 && kd == 4) { + a0 = ((2.38446e-3 * q - 0.08725329) * q - 4.732542e-3) * q + 4.00909; + } else { + a0 = cvql(kd, m, q); + } + } else if (m == 3) { + if (q <= 1.0 && kd == 2) { + a0 = (((6.348e-4 * q + 0.015625) * q + 0.0625) * q2 + 9.0); + } else if (q <= 1.0 && kd == 3) { + a0 = (((6.348e-4 * q - 0.015625) * q + 0.0625) * q2 + 9.0); + } else if (q <= 20.0 && kd == 2) { + a0 = (((3.035731e-4 * q - 1.453021e-2) * q + 0.19069602) * q - 0.1039356) * q + 8.9449274; + } else if (q <= 15.0 && kd == 3) { + a0 = ((9.369364e-5 * q - 0.03569325) * q + 0.2689874) * q + 8.771735; + } else { + a0 = cvql(kd, m, q); + } + } else if (m == 4) { + if (q <= 1.0 && kd == 1) { + a0 = ((-2.1e-6 * q2 + 5.012e-4) * q2 + 0.0333333) * q2 + 16.0; + } else if (q <= 1.0 && kd == 4) { + a0 = ((3.7e-6 * q2 - 3.669e-4) * q2 + 0.0333333) * q2 + 16.0; + } else if (q <= 25.0 && kd == 1) { + a0 = (((1.076676e-4 * q - 7.9684875e-3) * q + 0.17344854) * q - 0.5924058) * q + 16.620847; + } else if (q <= 20.0 && kd == 4) { + a0 = ((-7.08719e-4 * q + 3.8216144e-3) * q + 0.1907493) * q + 15.744; + } else { + a0 = cvql(kd, m, q); + } + } else if (m == 5) { + if (q <= 1.0 && kd == 2) { + a0 = ((6.8e-6 * q + 1.42e-5) * q2 + 0.0208333) * q2 + 25.0; + } else if (q <= 1.0 && kd == 3) { + a0 = ((-6.8e-6 * q + 1.42e-5) * q2 + 0.0208333) * q2 + 25.0; + } else if (q <= 35.0 && kd == 2) { + a0 = (((2.238231e-5 * q - 2.983416e-3) * q + 0.10706975) * q - 0.600205) * q + 25.93515; + } else if (q <= 25.0 && kd == 3) { + a0 = ((-7.425364e-4 * q + 2.18225e-2) * q + 4.16399e-2) * q + 24.897; + } else { + a0 = cvql(kd, m, q); + } + } else if (m == 6) { + if (q <= 1.0) { + a0 = (4e-6 * q2 + 0.0142857) * q2 + 36.0; + } else if (q <= 40.0 && kd == 1) { + a0 = (((-1.66846e-5 * q + 4.80263e-4) * q + 2.53998e-2) * q - 0.181233) * q + 36.423; + } else if (q <= 35.0 && kd == 4) { + a0 = ((-4.57146e-4 * q + 2.16609e-2) * q - 2.349616e-2) * q + 35.99251; } else { - ga0 = gaih(va0); - pd = sqrt(pi) / (pow(2.0, -0.5 * n) * ga0.real()); - cdn = pd; + a0 = cvql(kd, m, q); + } + } else if (m == 7) { + if (q <= 10.0) { + a0 = cvqm(m, q); + } else if (q <= 50.0 && kd == 2) { + a0 = (((-1.411114e-5 * q + 9.730514e-4) * q - 3.097887e-3) * q + 3.533597e-2) * q + 49.0547; + } else if (q <= 40.0 && kd == 3) { + a0 = ((-3.043872e-4 * q + 2.05511e-2) * q - 9.16292e-2) * q + 49.19035; + } else { + a0 = cvql(kd, m, q); + } + } else if (m >= 8) { + if (q <= 3 * m) { + a0 = cvqm(m, q); + } else if (q > m * m) { + a0 = cvql(kd, m, q); + } else { + if (m == 8 && kd == 1) { + a0 = (((8.634308e-6 * q - 2.100289e-3) * q + 0.169072) * q - 4.64336) * q + 109.4211; + } else if (m == 8 && kd == 4) { + a0 = ((-6.7842e-5 * q + 2.2057e-3) * q + 0.48296) * q + 56.59; + } else if (m == 9 && kd == 2) { + a0 = (((2.906435e-6 * q - 1.019893e-3) * q + 0.1101965) * q - 3.821851) * q + 127.6098; + } else if (m == 9 && kd == 3) { + a0 = ((-9.577289e-5 * q + 0.01043839) * q + 0.06588934) * q + 78.0198; + } else if (m == 10 && kd == 1) { + a0 = (((5.44927e-7 * q - 3.926119e-4) * q + 0.0612099) * q - 2.600805) * q + 138.1923; + } else if (m == 10 && kd == 4) { + a0 = ((-7.660143e-5 * q + 0.01132506) * q - 0.09746023) * q + 99.29494; + } else if (m == 11 && kd == 2) { + a0 = (((-5.67615e-7 * q + 7.152722e-6) * q + 0.01920291) * q - 1.081583) * q + 140.88; + } else if (m == 11 && kd == 3) { + a0 = ((-6.310551e-5 * q + 0.0119247) * q - 0.2681195) * q + 123.667; + } else if (m == 12 && kd == 1) { + a0 = (((-2.38351e-7 * q - 2.90139e-5) * q + 0.02023088) * q - 1.289) * q + 171.2723; + } else if (m == 12 && kd == 4) { + a0 = (((3.08902e-7 * q - 1.577869e-4) * q + 0.0247911) * q - 1.05454) * q + 161.471; + } + } + } + return a0; + } + + inline double cva2(int kd, int m, double q) { + + // ====================================================== + // Purpose: Calculate a specific characteristic value of + // Mathieu functions + // Input : m --- Order of Mathieu functions + // q --- Parameter of Mathieu functions + // KD --- Case code + // KD=1 for cem(x,q) ( m = 0,2,4,...) + // KD=2 for cem(x,q) ( m = 1,3,5,...) + // KD=3 for sem(x,q) ( m = 1,3,5,...) + // KD=4 for sem(x,q) ( m = 2,4,6,...) + // Output: A --- Characteristic value + // Routines called: + // (1) REFINE for finding accurate characteristic + // value using an iteration method + // (2) CV0 for finding initial characteristic + // values using polynomial approximation + // (3) CVQM for computing initial characteristic + // values for q ≤ 3*m + // (3) CVQL for computing initial characteristic + // values for q ≥ m*m + // ====================================================== + + int ndiv, nn, i; + double a = 0.0, delta, q1, q2, qq, a1, a2; + + if ((m <= 12) || (q <= 3.0 * m) || (q > m * m)) { + a = cv0(kd, m, q); + if ((q != 0.0) && (m != 2)) { + a = refine(kd, m, q, a); + } + if ((q > 2.0e-3) && (m == 2)) { + a = refine(kd, m, q, a); } } else { - xn = -n; - g1 = gaih(xn); - cb0 = pow(2.0, -0.5 * n - 1.0) * ca0 / g1; - vt = -0.5 * n; - g0 = gaih(vt); - cdn = g0; - cr = std::complex(1.0, 0.0); - - for (m = 1; m <= 250; m++) { - vm = 0.5 * (m - n); - gm = gaih(vm); - cr = -cr*sq2 * z / static_cast(m); - cdw = gm * cr; - cdn += cdw; - if (std::abs(cdw) < std::abs(cdn) * eps) { - break; + ndiv = 10; + delta = (m - 3.0) * m / ndiv; + + if ((q - 3.0 * m) <= (m * m - q)) { + nn = (int)((q - 3.0 * m) / delta) + 1; + delta = (q - 3.0 * m) / nn; + q1 = 2.0 * m; + a1 = cvqm(m, q1); + q2 = 3.0 * m; + a2 = cvqm(m, q2); + qq = 3.0 * m; + for (i = 1; i <= nn; i++) { + qq = qq + delta; + a = (a1 * q2 - a2 * q1 + (a2 - a1) * qq) / (q2 - q1); + a = refine(kd, m, qq, a); + q1 = q2; + q2 = qq; + a1 = a2; + a2 = a; + } + } else { + nn = (int)((m * m - q) / delta) + 1; + delta = (m * m - q) / nn; + q1 = m * (m - 1.0); + a1 = cvql(kd, m, q1); + q2 = m * m; + a2 = cvql(kd, m, q2); + qq = m * m; + for (i = 1; i <= nn; ++i) { + qq = qq - delta; + a = (a1 * q2 - a2 * q1 + (a2 - a1) * qq) / (q2 - q1); + a = refine(kd, m, qq, a); + q1 = q2; + q2 = qq; + a1 = a2; + a2 = a; } } - cdn *= cb0; } + return a; } - return cdn; -} - -inline double cv0(double kd, double m, double q) { + inline double cvf(int kd, int m, double q, double a, int mj) { - // ===================================================== - // Purpose: Compute the initial characteristic value of - // Mathieu functions for m ≤ 12 or q ≤ 300 or - // q ≥ m*m - // Input : m --- Order of Mathieu functions - // q --- Parameter of Mathieu functions - // Output: A0 --- Characteristic value - // Routines called: - // (1) CVQM for computing initial characteristic - // value for q ≤ 3*m - // (2) CVQL for computing initial characteristic - // value for q ≥ m*m - // ==================================================== + // ====================================================== + // Purpose: Compute the value of F for characteristic + // equation of Mathieu functions + // Input : m --- Order of Mathieu functions + // q --- Parameter of Mathieu functions + // A --- Characteristic value + // Output: F --- Value of F for characteristic equation + // ====================================================== - double a0 = 0.0, q2 = q*q; + int j, ic = m / 2, l = 0, l0 = 0, j0 = 2; + int jf = ic; + double t0 = 0.0, t1 = 0.0, t2 = 0.0, b = a, f; - if (m == 0) { - if (q <= 1.0) { - a0 = (((0.0036392 * q2 - 0.0125868) * q2 + 0.0546875) * q2 - 0.5) * q2; - } else if (q <= 10.0) { - a0 = ((3.999267e-3 * q - 9.638957e-2) * q - 0.88297) * q + 0.5542818; - } else { - a0 = cvql(kd, m, q); - } - } else if (m == 1) { - if ((q <= 1.0) && (kd == 2)) { - a0 = (((-6.51e-4 * q - 0.015625) * q - 0.125) * q + 1.0) * q + 1.0; - } else if (q <= 1.0 && kd == 3) { - a0 = (((-6.51e-4 * q + 0.015625) * q - 0.125) * q - 1.0) * q + 1.0; - } else if (q <= 10.0 && kd == 2) { - a0 = (((-4.94603e-4 * q + 1.92917e-2) * q - 0.3089229) * q + 1.33372) * q + 0.811752; - } else if (q <= 10.0 && kd == 3) { - a0 = ((1.971096e-3 * q - 5.482465e-2) * q - 1.152218) * q + 1.10427; - } else { - a0 = cvql(kd, m, q); - } - } else if (m == 2) { - if (q <= 1.0 && kd == 1) { - a0 = (((-0.0036391 * q2 + 0.0125888) * q2 - 0.0551939) * q2 + 0.416667) * q2 + 4.0; - } else if (q <= 1.0 && kd == 4) { - a0 = (0.0003617 * q2 - 0.0833333) * q2 + 4.0; - } else if (q <= 15.0 && kd == 1) { - a0 = (((3.200972e-4 * q - 8.667445e-3) * q - 1.829032e-4) * q + 0.9919999) * q + 3.3290504; - } else if (q <= 10.0 && kd == 4) { - a0 = ((2.38446e-3 * q - 0.08725329) * q - 4.732542e-3) * q + 4.00909; - } else { - a0 = cvql(kd, m, q); - } - } else if (m == 3) { - if (q <= 1.0 && kd == 2) { - a0 = (((6.348e-4 * q + 0.015625) * q + 0.0625) * q2 + 9.0); - } else if (q <= 1.0 && kd == 3) { - a0 = (((6.348e-4 * q - 0.015625) * q + 0.0625) * q2 + 9.0); - } else if (q <= 20.0 && kd == 2) { - a0 = (((3.035731e-4 * q - 1.453021e-2) * q + 0.19069602) * q - 0.1039356) * q + 8.9449274; - } else if (q <= 15.0 && kd == 3) { - a0 = ((9.369364e-5 * q - 0.03569325) * q + 0.2689874) * q + 8.771735; - } else { - a0 = cvql(kd, m, q); - } - } else if (m == 4) { - if (q <= 1.0 && kd == 1) { - a0 = ((-2.1e-6 * q2 + 5.012e-4) * q2 + 0.0333333) * q2 + 16.0; - } else if (q <= 1.0 && kd == 4) { - a0 = ((3.7e-6 * q2 - 3.669e-4) * q2 + 0.0333333) * q2 + 16.0; - } else if (q <= 25.0 && kd == 1) { - a0 = (((1.076676e-4 * q - 7.9684875e-3) * q + 0.17344854) * q - 0.5924058) * q + 16.620847; - } else if (q <= 20.0 && kd == 4) { - a0 = ((-7.08719e-4 * q + 3.8216144e-3) * q + 0.1907493) * q + 15.744; - } else { - a0 = cvql(kd, m, q); - } - } else if (m == 5) { - if (q <= 1.0 && kd == 2) { - a0 = ((6.8e-6 * q + 1.42e-5) * q2 + 0.0208333) * q2 + 25.0; - } else if (q <= 1.0 && kd == 3) { - a0 = ((-6.8e-6 * q + 1.42e-5) * q2 + 0.0208333) * q2 + 25.0; - } else if (q <= 35.0 && kd == 2) { - a0 = (((2.238231e-5 * q - 2.983416e-3) * q + 0.10706975) * q - 0.600205) * q + 25.93515; - } else if (q <= 25.0 && kd == 3) { - a0 = ((-7.425364e-4 * q + 2.18225e-2) * q + 4.16399e-2) * q + 24.897; - } else { - a0 = cvql(kd, m, q); + if (kd == 1) { + j0 = 3; + l0 = 2; } - } else if (m == 6) { - if (q <= 1.0) { - a0 = (4e-6 * q2 + 0.0142857) * q2 + 36.0; - } else if (q <= 40.0 && kd == 1) { - a0 = (((-1.66846e-5 * q + 4.80263e-4) * q + 2.53998e-2) * q - 0.181233) * q + 36.423; - } else if (q <= 35.0 && kd == 4) { - a0 = ((-4.57146e-4 * q + 2.16609e-2) * q - 2.349616e-2) * q + 35.99251; - } else { - a0 = cvql(kd, m, q); - } - } else if (m == 7) { - if (q <= 10.0) { - a0 = cvqm(m, q); - } else if (q <= 50.0 && kd == 2) { - a0 = (((-1.411114e-5 * q + 9.730514e-4) * q - 3.097887e-3) * q + 3.533597e-2) * q + 49.0547; - } else if (q <= 40.0 && kd == 3) { - a0 = ((-3.043872e-4 * q + 2.05511e-2) * q - 9.16292e-2) * q + 49.19035; - } else { - a0 = cvql(kd, m, q); + if ((kd == 2) || (kd == 3)) { + l = 1; } - } else if (m >= 8) { - if (q <= 3*m) { - a0 = cvqm(m, q); - } else if (q > m * m) { - a0 = cvql(kd, m, q); - } else { - if (m == 8 && kd == 1) { - a0 = (((8.634308e-6 * q - 2.100289e-3) * q + 0.169072) * q - 4.64336) * q + 109.4211; - } else if (m == 8 && kd == 4) { - a0 = ((-6.7842e-5 * q + 2.2057e-3) * q + 0.48296) * q + 56.59; - } else if (m == 9 && kd == 2) { - a0 = (((2.906435e-6 * q - 1.019893e-3) * q + 0.1101965) * q - 3.821851) * q + 127.6098; - } else if (m == 9 && kd == 3) { - a0 = ((-9.577289e-5 * q + 0.01043839) * q + 0.06588934) * q + 78.0198; - } else if (m == 10 && kd == 1) { - a0 = (((5.44927e-7 * q - 3.926119e-4) * q + 0.0612099) * q - 2.600805) * q + 138.1923; - } else if (m == 10 && kd == 4) { - a0 = ((-7.660143e-5 * q + 0.01132506) * q - 0.09746023) * q + 99.29494; - } else if (m == 11 && kd == 2) { - a0 = (((-5.67615e-7 * q + 7.152722e-6) * q + 0.01920291) * q - 1.081583) * q + 140.88; - } else if (m == 11 && kd == 3) { - a0 = ((-6.310551e-5 * q + 0.0119247) * q - 0.2681195) * q + 123.667; - } else if (m == 12 && kd == 1) { - a0 = (((-2.38351e-7 * q - 2.90139e-5) * q + 0.02023088) * q - 1.289) * q + 171.2723; - } else if (m == 12 && kd == 4) { - a0 = (((3.08902e-7 * q - 1.577869e-4) * q + 0.0247911) * q - 1.05454) * q + 161.471; - } + if (kd == 4) { + jf = ic - 1; } - } - return a0; -} - - -inline double cva2(int kd, int m, double q) { - - // ====================================================== - // Purpose: Calculate a specific characteristic value of - // Mathieu functions - // Input : m --- Order of Mathieu functions - // q --- Parameter of Mathieu functions - // KD --- Case code - // KD=1 for cem(x,q) ( m = 0,2,4,...) - // KD=2 for cem(x,q) ( m = 1,3,5,...) - // KD=3 for sem(x,q) ( m = 1,3,5,...) - // KD=4 for sem(x,q) ( m = 2,4,6,...) - // Output: A --- Characteristic value - // Routines called: - // (1) REFINE for finding accurate characteristic - // value using an iteration method - // (2) CV0 for finding initial characteristic - // values using polynomial approximation - // (3) CVQM for computing initial characteristic - // values for q ≤ 3*m - // (3) CVQL for computing initial characteristic - // values for q ≥ m*m - // ====================================================== - - int ndiv, nn, i; - double a = 0.0, delta, q1, q2, qq, a1, a2; - - if ((m <= 12) || (q <= 3.0 * m) || (q > m * m)) { - a = cv0(kd, m, q); - if ((q != 0.0) && (m != 2)) { a = refine(kd, m, q, a); } - if ((q > 2.0e-3) && (m == 2)) { a = refine(kd, m, q, a); } - } else { - ndiv = 10; - delta = (m - 3.0) * m / ndiv; - - if ((q - 3.0 * m) <= (m * m - q)) { - nn = (int)((q - 3.0 * m) / delta) + 1; - delta = (q - 3.0 * m) / nn; - q1 = 2.0 * m; - a1 = cvqm(m, q1); - q2 = 3.0 * m; - a2 = cvqm(m, q2); - qq = 3.0 * m; - for (i = 1; i <= nn; i++) { - qq = qq + delta; - a = (a1 * q2 - a2 * q1 + (a2 - a1) * qq) / (q2 - q1); - a = refine(kd, m, qq, a); - q1 = q2; - q2 = qq; - a1 = a2; - a2 = a; + + for (j = mj; j >= ic + 1; j--) { + t1 = -q * q / (pow(2.0 * j + l, 2) - b + t1); + } + + if (m <= 2) { + if ((kd == 1) && (m == 0)) { + t1 += t1; + } + if ((kd == 1) && (m == 2)) { + t1 = -2.0 * q * q / (4.0 - b + t1) - 4.0; + } + if ((kd == 2) && (m == 1)) { + t1 += q; + } + if ((kd == 3) && (m == 1)) { + t1 -= q; } } else { - nn = (int)((m * m - q) / delta) + 1; - delta = (m * m - q) / nn; - q1 = m * (m - 1.0); - a1 = cvql(kd, m, q1); - q2 = m * m; - a2 = cvql(kd, m, q2); - qq = m * m; - for (i = 1; i <= nn; ++i) { - qq = qq - delta; - a = (a1 * q2 - a2 * q1 + (a2 - a1) * qq) / (q2 - q1); - a = refine(kd, m, qq, a); - q1 = q2; - q2 = qq; - a1 = a2; - a2 = a; + if (kd == 1) { + t0 = 4.0 - b + 2.0 * q * q / b; + } + if (kd == 2) { + t0 = 1.0 - b + q; + } + if (kd == 3) { + t0 = 1.0 - b - q; + } + if (kd == 4) { + t0 = 4.0 - b; + } + t2 = -q * q / t0; + for (j = j0; j <= jf; j++) { + t2 = -q * q / (pow(2.0 * j - l - l0, 2.0) - b + t2); } } + f = pow(2.0 * ic + l, 2) + t1 + t2 - b; + return f; } - return a; -} + inline double cvql(int kd, int m, double q) { -inline double cvf(int kd, int m, double q, double a, int mj) { + // ======================================================== + // Purpose: Compute the characteristic value of Mathieu + // functions for q ≥ 3m + // Input : m --- Order of Mathieu functions + // q --- Parameter of Mathieu functions + // Output: A0 --- Initial characteristic value + // ======================================================== - // ====================================================== - // Purpose: Compute the value of F for characteristic - // equation of Mathieu functions - // Input : m --- Order of Mathieu functions - // q --- Parameter of Mathieu functions - // A --- Characteristic value - // Output: F --- Value of F for characteristic equation - // ====================================================== + double a0, w, w2, w3, w4, w6, d1, d2, d3, d4, c1, p1, p2, cv1, cv2; - int j, ic = m / 2, l = 0, l0 = 0, j0 = 2; - int jf = ic; - double t0 = 0.0, t1 = 0.0, t2 = 0.0, b = a, f; + w = 0.0; + if ((kd == 1) || (kd == 2)) { + w = 2.0 * m + 1.0; + } + if ((kd == 3) || (kd == 4)) { + w = 2.0 * m - 1.0; + } + w2 = w * w; + w3 = w * w2; + w4 = w2 * w2; + w6 = w2 * w4; + d1 = 5.0 + 34.0 / w2 + 9.0 / w4; + d2 = (33.0 + 410.0 / w2 + 405.0 / w4) / w; + d3 = (63.0 + 1260.0 / w2 + 2943.0 / w4 + 486.0 / w6) / w2; + d4 = (527.0 + 15617.0 / w2 + 69001.0 / w4 + 41607.0 / w6) / w3; + c1 = 128.0; + p2 = q / w4; + p1 = sqrt(p2); + cv1 = -2.0 * q + 2.0 * w * sqrt(q) - (w2 + 1.0) / 8.0; + cv2 = (w + 3.0 / w) + d1 / (32.0 * p1) + d2 / (8.0 * c1 * p2); + cv2 = cv2 + d3 / (64.0 * c1 * p1 * p2) + d4 / (16.0 * c1 * c1 * p2 * p2); + a0 = cv1 - cv2 / (c1 * p1); + return a0; + } + + inline double cvqm(int m, double q) { + + // ===================================================== + // Purpose: Compute the characteristic value of Mathieu + // functions for q ≤ m*m + // Input : m --- Order of Mathieu functions + // q --- Parameter of Mathieu functions + // Output: A0 --- Initial characteristic value + // ===================================================== + + double hm1, hm3, hm5, a0; + + hm1 = 0.5 * q / (m * m - 1.0); + hm3 = .25 * pow(hm1, 3) / (m * m - 4.0); + hm5 = hm1 * hm3 * q / ((m * m - 1.0) * (m * m - 9.0)); + a0 = m * m + q * (hm1 + (5.0 * m * m + 7.0) * hm3 + (9.0 * pow(m, 4) + 58.0 * m * m + 29.0) * hm5); + return a0; + } + + inline void cy01(int kf, std::complex z, std::complex *zf, std::complex *zd) { + + // =========================================================== + // Purpose: Compute complex Bessel functions Y0(z), Y1(z) + // and their derivatives + // Input : z --- Complex argument of Yn(z) ( n=0,1 ) + // KF --- Function choice code + // KF=0 for ZF=Y0(z) and ZD=Y0'(z) + // KF=1 for ZF=Y1(z) and ZD=Y1'(z) + // KF=2 for ZF=Y1'(z) and ZD=Y1''(z) + // Output: ZF --- Y0(z) or Y1(z) or Y1'(z) + // ZD --- Y0'(z) or Y1'(z) or Y1''(z) + // =========================================================== + + int k, k0; + double a0, w0, w1; + std::complex cr, cp, cp0, cq0, cu, cp1, cq1, cbj0, cbj1, cby0, cby1, cdy0, cdy1, cs, ct1, ct2, z1, z2; + + const double pi = 3.141592653589793; + const double el = 0.5772156649015329; + const double rp2 = 2.0 / pi; + const std::complex ci(0.0, 1.0); + + static const double a[12] = {-0.703125e-01, 0.112152099609375, -0.5725014209747314, 0.6074042001273483, + -0.1100171402692467, 0.3038090510922384, -0.1188384262567832, 0.6252951493434797, + -0.4259392165047669, 0.3646840080706556, -0.3833534661393944, 0.4854014686852901}; + + static const double b[12] = {0.732421875e-01, -0.2271080017089844, 0.1727727502584457, -0.2438052969955606, + 0.5513358961220206, -0.1825775547429318, 0.8328593040162893, -0.5006958953198893, + 0.3836255180230433, -0.3649010818849833, 0.4218971570284096, -0.5827244631566907}; + + static const double a1[12] = {0.1171875, -0.144195556640625, 0.6765925884246826, -0.6883914268109947, + 0.1215978918765359, -0.3302272294480852, 0.1276412726461746, -0.6656367718817688, + 0.4502786003050393, -0.3833857520742790, 0.4011838599133198, -0.5060568503314727}; + + static const double b1[12] = {-0.1025390625, 0.2775764465332031, -0.1993531733751297, 0.2724882731126854, + -0.6038440767050702, 0.1971837591223663, -0.8902978767070678, 0.5310411010968522, + -0.4043620325107754, 0.3827011346598605, -0.4406481417852278, 0.6065091351222699}; + + a0 = std::abs(z); + z1 = z; + z2 = z * z; + if (a0 == 0.0) { + cbj0 = std::complex(1.0, 0.0); + cbj1 = std::complex(0.0, 0.0); + cby0 = std::complex(-1e300, 0.0); + cby1 = std::complex(-1e300, 0.0); + cdy0 = std::complex(1e300, 0.0); + cdy1 = std::complex(1e300, 0.0); + if (kf == 0) { + *zf = cby0; + *zd = cdy0; + } else if (kf == 1) { + *zf = cby1; + *zd = cdy1; + } else if (kf == 2) { + *zf = cdy1; + *zd = -cdy1 / z - (1.0 - 1.0 / (z * z)) * cby1; + } + return; + } - if (kd == 1) { - j0 = 3; - l0 = 2; - } - if ((kd == 2) || (kd == 3)) { l = 1; } - if (kd == 4) { jf = ic-1; } + if (z.real() < 0.0) { + z1 = -z; + } - for (j = mj; j >= ic+1; j--) { - t1 = -q*q/(pow(2.0*j + l, 2) - b + t1); - } + if (a0 <= 12.0) { + cbj0 = std::complex(1.0, 0.0); + cr = std::complex(1.0, 0.0); + for (k = 1; k <= 40; k++) { + cr = -0.25 * cr * z2 / static_cast(k * k); + cbj0 += cr; + if (std::abs(cr) < std::abs(cbj0) * 1.0e-15) + break; + } + + cbj1 = std::complex(1.0, 0.0); + cr = std::complex(1.0, 0.0); + for (k = 1; k <= 40; k++) { + cr = -0.25 * cr * z2 / (k * (k + 1.0)); + cbj1 += cr; + if (std::abs(cr) < std::abs(cbj1) * 1.0e-15) + break; + } + + cbj1 *= 0.5 * z1; + w0 = 0.0; + cr = std::complex(1.0, 0.0); + cs = std::complex(0.0, 0.0); + for (k = 1; k <= 40; k++) { + w0 += 1.0 / k; + cr = -0.25 * cr / static_cast(k * k) * z2; + cp = cr * w0; + cs += cp; + if (std::abs(cp) < std::abs(cs) * 1.0e-15) + break; + } + + cby0 = rp2 * (std::log(z1 / 2.0) + el) * cbj0 - rp2 * cs; + w1 = 0.0; + cr = 1.0; + cs = 1.0; + for (k = 1; k <= 40; k++) { + w1 += 1.0 / k; + cr = -0.25 * cr / static_cast(k * (k + 1)) * z2; + cp = cr * (2.0 * w1 + 1.0 / (k + 1.0)); + cs += cp; + if (std::abs(cp) < std::abs(cs) * 1.0e-15) + break; + } + cby1 = rp2 * ((std::log(z1 / 2.0) + el) * cbj1 - 1.0 / z1 - 0.25 * z1 * cs); + } else { + k0 = 12; + if (a0 >= 35.0) + k0 = 10; + if (a0 >= 50.0) + k0 = 8; + + ct1 = z1 - 0.25 * pi; + cp0 = 1.0; + for (k = 1; k <= k0; k++) { + cp0 += a[k - 1] * pow(z1, -2 * k); + } + cq0 = -0.125 / z1; + for (k = 1; k <= k0; k++) + cq0 += b[k - 1] * pow(z1, -2 * k - 1); + + cu = std::sqrt(rp2 / z1); + cbj0 = cu * (cp0 * cos(ct1) - cq0 * sin(ct1)); + cby0 = cu * (cp0 * sin(ct1) + cq0 * cos(ct1)); + + ct2 = z1 - 0.75 * pi; + cp1 = 1.0; + for (k = 1; k <= k0; k++) + cp1 += a1[k - 1] * pow(z1, -2 * k); + + cq1 = 0.375 / z1; + for (k = 1; k <= k0; k++) { + cq1 = cq1 + b1[k - 1] * pow(z1, -2 * k - 1); + } + cbj1 = cu * (cp1 * cos(ct2) - cq1 * sin(ct2)); + cby1 = cu * (cp1 * sin(ct2) + cq1 * cos(ct2)); + } - if (m <= 2) { - if ((kd == 1) && (m == 0)) { t1 += t1; } - if ((kd == 1) && (m == 2)) { t1 = -2.0*q*q/(4.0-b+t1) - 4.0; } - if ((kd == 2) && (m == 1)) { t1 += q; } - if ((kd == 3) && (m == 1)) { t1 -= q; } - } else { - if (kd == 1) { t0 = 4.0 - b + 2.0*q*q / b; } - if (kd == 2) { t0 = 1.0 - b + q; } - if (kd == 3) { t0 = 1.0 - b - q; } - if (kd == 4) { t0 = 4.0 - b; } - t2 = -q*q / t0; - for (j = j0; j <= jf; j++) { - t2 = -q*q/(pow(2.0*j -l-l0, 2.0) - b + t2); + if (z.real() < 0.0) { + if (z.imag() < 0.0) + cby0 = cby0 - 2.0 * ci * cbj0; + if (z.imag() > 0.0) + cby0 = cby0 + 2.0 * ci * cbj0; + if (z.imag() < 0.0) + cby1 = -(cby1 - 2.0 * ci * cbj1); + if (z.imag() > 0.0) + cby1 = -(cby1 + 2.0 * ci * cbj1); + cbj1 = -cbj1; } - } - f = pow(2.0*ic+l, 2) + t1 + t2 - b; - return f; -} - - -inline double cvql(int kd, int m, double q) { - - // ======================================================== - // Purpose: Compute the characteristic value of Mathieu - // functions for q ≥ 3m - // Input : m --- Order of Mathieu functions - // q --- Parameter of Mathieu functions - // Output: A0 --- Initial characteristic value - // ======================================================== - - double a0, w, w2, w3, w4, w6, d1, d2, d3, d4, c1, p1, p2, cv1, cv2; - - w = 0.0; - if ((kd == 1) || (kd == 2)) { w=2.0*m + 1.0; } - if ((kd == 3) || (kd == 4)) { w=2.0*m - 1.0; } - w2 = w*w; - w3 = w*w2; - w4 = w2*w2; - w6 = w2*w4; - d1 = 5.0+34.0/w2+9.0/w4; - d2 = (33.0 + 410.0/w2 + 405.0/w4)/w; - d3 = (63.0 + 1260.0/w2 + 2943.0/w4 + 486.0/w6)/w2; - d4 = (527.0 + 15617.0/w2 + 69001.0/w4 + 41607.0/w6)/w3; - c1 = 128.0; - p2 = q/w4; - p1 = sqrt(p2); - cv1 = -2.0*q+2.0*w*sqrt(q) - (w2+1.0)/8.0; - cv2 = (w+3.0/w) + d1/(32.0*p1) + d2/(8.0*c1*p2); - cv2 = cv2 + d3/(64.0*c1*p1*p2)+d4/(16.0*c1*c1*p2*p2); - a0 = cv1 - cv2/(c1*p1); - return a0; -} - - -inline double cvqm(int m, double q) { - - // ===================================================== - // Purpose: Compute the characteristic value of Mathieu - // functions for q ≤ m*m - // Input : m --- Order of Mathieu functions - // q --- Parameter of Mathieu functions - // Output: A0 --- Initial characteristic value - // ===================================================== - - double hm1, hm3, hm5, a0; - - hm1= 0.5*q/(m*m-1.0); - hm3=.25*pow(hm1, 3)/(m*m - 4.0); - hm5 = hm1*hm3*q/((m*m - 1.0)*(m*m - 9.0)); - a0 = m*m + q*(hm1+(5.0*m*m + 7.0)*hm3 + (9.0*pow(m, 4) + 58.0*m*m + 29.0)*hm5); - return a0; -} - - -inline void cy01(int kf, std::complex z, std::complex *zf, std::complex *zd) { - - // =========================================================== - // Purpose: Compute complex Bessel functions Y0(z), Y1(z) - // and their derivatives - // Input : z --- Complex argument of Yn(z) ( n=0,1 ) - // KF --- Function choice code - // KF=0 for ZF=Y0(z) and ZD=Y0'(z) - // KF=1 for ZF=Y1(z) and ZD=Y1'(z) - // KF=2 for ZF=Y1'(z) and ZD=Y1''(z) - // Output: ZF --- Y0(z) or Y1(z) or Y1'(z) - // ZD --- Y0'(z) or Y1'(z) or Y1''(z) - // =========================================================== - - int k, k0; - double a0, w0, w1; - std::complex cr, cp, cp0, cq0, cu, cp1, cq1, cbj0, cbj1,\ - cby0, cby1, cdy0, cdy1, cs, ct1, ct2, z1, z2; - - const double pi = 3.141592653589793; - const double el = 0.5772156649015329; - const double rp2 = 2.0 / pi; - const std::complex ci(0.0, 1.0); - - static const double a[12] = {-0.703125e-01, 0.112152099609375, -0.5725014209747314, - 0.6074042001273483, -0.1100171402692467, 0.3038090510922384, - -0.1188384262567832, 0.6252951493434797, -0.4259392165047669, - 0.3646840080706556, -0.3833534661393944, 0.4854014686852901}; - - static const double b[12] = { 0.732421875e-01, -0.2271080017089844, 0.1727727502584457, - -0.2438052969955606, 0.5513358961220206, -0.1825775547429318, - 0.8328593040162893, -0.5006958953198893, 0.3836255180230433, - -0.3649010818849833, 0.4218971570284096, -0.5827244631566907}; - - static const double a1[12] = { 0.1171875, -0.144195556640625, 0.6765925884246826, - -0.6883914268109947, 0.1215978918765359, -0.3302272294480852, - 0.1276412726461746, -0.6656367718817688, 0.4502786003050393, - -0.3833857520742790, 0.4011838599133198, -0.5060568503314727}; - - static const double b1[12] = {-0.1025390625, 0.2775764465332031, -0.1993531733751297, - 0.2724882731126854, -0.6038440767050702, 0.1971837591223663, - -0.8902978767070678, 0.5310411010968522, -0.4043620325107754, - 0.3827011346598605, -0.4406481417852278, 0.6065091351222699}; - - a0 = std::abs(z); - z1 = z; - z2 = z * z; - if (a0 == 0.0) { - cbj0 = std::complex(1.0, 0.0); - cbj1 = std::complex(0.0, 0.0); - cby0 = std::complex(-1e300, 0.0); - cby1 = std::complex(-1e300, 0.0); - cdy0 = std::complex( 1e300, 0.0); - cdy1 = std::complex( 1e300, 0.0); + + cdy0 = -cby1; + cdy1 = cby0 - 1.0 / z * cby1; + if (kf == 0) { *zf = cby0; *zd = cdy0; @@ -1865,4030 +2078,4114 @@ inline void cy01(int kf, std::complex z, std::complex *zf, std:: return; } - if (z.real() < 0.0) { - z1 = -z; - } + inline void cyzo(int nt, int kf, int kc, std::complex *zo, std::complex *zv) { + + // =========================================================== + // Purpose : Compute the complex zeros of Y0(z), Y1(z) and + // Y1'(z), and their associated values at the zeros + // using the modified Newton's iteration method + // Input: NT --- Total number of zeros/roots + // KF --- Function choice code + // KF=0 for Y0(z) & Y1(z0) + // KF=1 for Y1(z) & Y0(z1) + // KF=2 for Y1'(z) & Y1(z1') + // KC --- Choice code + // KC=0 for complex roots + // KC=1 for real roots + // Output: ZO(L) --- L-th zero of Y0(z) or Y1(z) or Y1'(z) + // ZV(L) --- Value of Y0'(z) or Y1'(z) or Y1(z) + // at the L-th zero + // Routine called: CY01 for computing Y0(z) and Y1(z), and + // their derivatives + // =========================================================== + + int i, it, j, nr; + double x, h, w, y, w0; + std::complex z, zf, zd, zfd, zgd, zp, zq, zw; + + x = 0.0; + y = 0.0; + h = 0.0; - if (a0 <= 12.0) { - cbj0 = std::complex(1.0, 0.0); - cr = std::complex(1.0, 0.0); - for (k = 1; k <= 40; k++) { - cr = -0.25 * cr * z2 / static_cast(k * k); - cbj0 += cr; - if (std::abs(cr) < std::abs(cbj0) * 1.0e-15) break; + if (kc == 0) { + x = -2.4; + y = 0.54; + h = 3.14; + } else if (kc == 1) { + x = 0.89; + y = 0.0; + h = -3.14; } - cbj1 = std::complex(1.0, 0.0); - cr = std::complex(1.0, 0.0); - for (k = 1; k <= 40; k++) { - cr = -0.25 * cr * z2 / (k * (k + 1.0)); - cbj1 += cr; - if (std::abs(cr) < std::abs(cbj1) * 1.0e-15) break; + if (kf == 1) { + x = -0.503; } - cbj1 *= 0.5 * z1; - w0 = 0.0; - cr = std::complex(1.0, 0.0); - cs = std::complex(0.0, 0.0); - for (k = 1; k <= 40; k++) { - w0 += 1.0 / k; - cr = -0.25 * cr / static_cast(k * k) * z2; - cp = cr * w0; - cs += cp; - if (std::abs(cp) < std::abs(cs) * 1.0e-15) break; + if (kf == 2) { + x = 0.577; } - - cby0 = rp2 * (std::log(z1 / 2.0) + el) * cbj0 - rp2 * cs; - w1 = 0.0; - cr = 1.0; - cs = 1.0; - for (k = 1; k <= 40; k++) { - w1 += 1.0 / k; - cr = -0.25 * cr / static_cast(k * (k + 1)) * z2; - cp = cr * (2.0 * w1 + 1.0 / (k + 1.0)); - cs += cp; - if (std::abs(cp) < std::abs(cs) * 1.0e-15) break; - } - cby1 = rp2 * ((std::log(z1 / 2.0) + el) * cbj1 - 1.0 / z1 - 0.25 * z1 * cs); - } else { - k0 = 12; - if (a0 >= 35.0) k0 = 10; - if (a0 >= 50.0) k0 = 8; - - ct1 = z1 - 0.25 * pi; - cp0 = 1.0; - for (k = 1; k <= k0; k++) { - cp0 += a[k - 1] * pow(z1, -2 * k); - } - cq0 = -0.125 / z1; - for (k = 1; k <= k0; k++) - cq0 += b[k - 1] * pow(z1, -2 * k - 1); - - cu = std::sqrt(rp2 / z1); - cbj0 = cu * (cp0 * cos(ct1) - cq0 * sin(ct1)); - cby0 = cu * (cp0 * sin(ct1) + cq0 * cos(ct1)); - - ct2 = z1 - 0.75 * pi; - cp1 = 1.0; - for (k = 1; k <= k0; k++) - cp1 += a1[k - 1] * pow(z1, -2 * k); - - cq1 = 0.375 / z1; - for (k = 1; k <= k0; k++) { - cq1 = cq1 + b1[k - 1] * pow(z1, -2 * k - 1); - } - cbj1 = cu * (cp1 * cos(ct2) - cq1 * sin(ct2)); - cby1 = cu * (cp1 * sin(ct2) + cq1 * cos(ct2)); + z = std::complex(x, y); + w = 0.0; + for (nr = 1; nr <= nt; nr++) { + if (nr > 1) { + z = zo[nr - 2] - h; + } + it = 0; + do { + it += 1; + cy01(kf, z, &zf, &zd); + zp = 1.0; + for (i = 1; i < nr; i++) { + zp *= (z - zo[i - 1]); + } + zfd = zf / zp; + zq = 0.0; + for (i = 1; i < nr; i++) { + zw = 1.0; + for (j = 1; j < nr; j++) { + if (j == i) { + continue; + } + zw *= (z - zo[j - 1]); + } + zq += zw; + } + zgd = (zd - zq * zfd) / zp; + z -= zfd / zgd; + w0 = w; + w = std::abs(z); + } while ((it <= 50) && (fabs((w - w0) / w) > 1.0e-12)); + + zo[nr - 1] = z; + } + + for (i = 1; i <= nt; i++) { + z = zo[i - 1]; + if ((kf == 0) || (kf == 2)) { + cy01(1, z, &zf, &zd); + zv[i - 1] = zf; + } else if (kf == 1) { + cy01(0, z, &zf, &zd); + zv[i - 1] = zf; + } + } + return; } - if (z.real() < 0.0) { - if (z.imag() < 0.0) cby0 = cby0 - 2.0 * ci * cbj0; - if (z.imag() > 0.0) cby0 = cby0 + 2.0 * ci * cbj0; - if (z.imag() < 0.0) cby1 = -(cby1 - 2.0 * ci * cbj1); - if (z.imag() > 0.0) cby1 = -(cby1 + 2.0 * ci * cbj1); - cbj1 = -cbj1; - } + template + T e1xb(T x) { - cdy0 = -cby1; - cdy1 = cby0 - 1.0 / z * cby1; - - if (kf == 0) { - *zf = cby0; - *zd = cdy0; - } else if (kf == 1) { - *zf = cby1; - *zd = cdy1; - } else if (kf == 2) { - *zf = cdy1; - *zd = -cdy1 / z - (1.0 - 1.0 / (z * z)) * cby1; - } - return; -} - - -inline void cyzo(int nt, int kf, int kc, std::complex *zo, std::complex *zv) { - - // =========================================================== - // Purpose : Compute the complex zeros of Y0(z), Y1(z) and - // Y1'(z), and their associated values at the zeros - // using the modified Newton's iteration method - // Input: NT --- Total number of zeros/roots - // KF --- Function choice code - // KF=0 for Y0(z) & Y1(z0) - // KF=1 for Y1(z) & Y0(z1) - // KF=2 for Y1'(z) & Y1(z1') - // KC --- Choice code - // KC=0 for complex roots - // KC=1 for real roots - // Output: ZO(L) --- L-th zero of Y0(z) or Y1(z) or Y1'(z) - // ZV(L) --- Value of Y0'(z) or Y1'(z) or Y1(z) - // at the L-th zero - // Routine called: CY01 for computing Y0(z) and Y1(z), and - // their derivatives - // =========================================================== - - int i, it, j, nr; - double x, h, w, y, w0; - std::complex z, zf, zd, zfd, zgd, zp, zq, zw; - - x = 0.0; - y = 0.0; - h = 0.0; - - if (kc == 0) { - x = -2.4; - y = 0.54; - h = 3.14; - } else if (kc == 1) { - x = 0.89; - y = 0.0; - h = -3.14; - } + // ============================================ + // Purpose: Compute exponential integral E1(x) + // Input : x --- Argument of E1(x) + // Output: E1 --- E1(x) ( x > 0 ) + // ============================================ - if (kf == 1) { - x = -0.503; - } + int k, m; + T e1, r, t, t0; + const T ga = 0.5772156649015328; - if (kf == 2) { - x = 0.577; - } - z = std::complex(x, y); - w = 0.0; - for (nr = 1; nr <= nt; nr++) { - if (nr > 1) { - z = zo[nr - 2] - h; - } - it = 0; - do { - it += 1; - cy01(kf, z, &zf, &zd); - zp = 1.0; - for (i = 1; i < nr; i++) { - zp *= (z - zo[i - 1]); - } - zfd = zf / zp; - zq = 0.0; - for (i = 1; i < nr; i++) { - zw = 1.0; - for (j = 1; j < nr; j++) { - if (j == i) { continue; } - zw *= (z - zo[j - 1]); + if (x == 0.0) { + e1 = 1e300; + } else if (x <= 1.0) { + e1 = 1.0; + r = 1.0; + for (k = 1; k < 26; k++) { + r = -r * k * x / pow(k + 1.0, 2); + e1 += r; + if (fabs(r) <= fabs(e1) * 1e-15) { + break; } - zq += zw; } - zgd = (zd - zq * zfd) / zp; - z -= zfd / zgd; - w0 = w; - w = std::abs(z); - } while ((it <= 50) && (fabs((w - w0) / w) > 1.0e-12)); - - zo[nr - 1] = z; - } - - for (i = 1; i <= nt; i++) { - z = zo[i - 1]; - if ((kf == 0) || (kf == 2)) { - cy01(1, z, &zf, &zd); - zv[i - 1] = zf; - } else if (kf == 1) { - cy01(0, z, &zf, &zd); - zv[i - 1] = zf; + e1 = -ga - log(x) + x * e1; + } else { + m = 20 + (int)(80.0 / x); + t0 = 0.0; + for (k = m; k > 0; k--) { + t0 = k / (1.0 + k / (x + t0)); + } + t = 1.0 / (x + t0); + e1 = exp(-x) * t; + } + return e1; + } + + template + std::complex e1z(std::complex z) { + + // ==================================================== + // Purpose: Compute complex exponential integral E1(z) + // Input : z --- Argument of E1(z) + // Output: CE1 --- E1(z) + // ==================================================== + + const T pi = 3.141592653589793; + const T el = 0.5772156649015328; + int k; + std::complex ce1, cr, zc, zd, zdc; + T x = z.real(); + T a0 = std::abs(z); + // Continued fraction converges slowly near negative real axis, + // so use power series in a wedge around it until radius 40.0 + T xt = -2.0 * fabs(z.imag()); + + if (a0 == 0.0) { + return 1e300; + } + if ((a0 < 5.0) || ((x < xt) && (a0 < 40.0))) { + // Power series + ce1 = 1.0; + cr = 1.0; + for (k = 1; k < 501; k++) { + cr = -cr * z * static_cast(k / std::pow(k + 1, 2)); + ce1 += cr; + if (std::abs(cr) < std::abs(ce1) * 1e-15) { + break; + } + } + if ((x <= 0.0) && (z.imag() == 0.0)) { + // Careful on the branch cut -- use the sign of the imaginary part + // to get the right sign on the factor if pi. + ce1 = -el - std::log(-z) + z * ce1 - copysign(pi, z.imag()) * std::complex(0.0, 1.0); + } else { + ce1 = -el - std::log(z) + z * ce1; + } + } else { + // Continued fraction https://dlmf.nist.gov/6.9 + // 1 1 1 2 2 3 3 + // E1 = exp(-z) * ----- ----- ----- ----- ----- ----- ----- ... + // Z + 1 + Z + 1 + Z + 1 + Z + + zc = 0.0; + zd = static_cast(1) / z; + zdc = zd; + zc += zdc; + for (k = 1; k < 501; k++) { + zd = static_cast(1) / (zd * static_cast(k) + static_cast(1)); + zdc *= (zd - static_cast(1)); + zc += zdc; + + zd = static_cast(1) / (zd * static_cast(k) + z); + zdc *= (z * zd - static_cast(1)); + zc += zdc; + if ((std::abs(zdc) <= std::abs(zc) * 1e-15) && (k > 20)) { + break; + } + } + ce1 = std::exp(-z) * zc; + if ((x <= 0.0) && (z.imag() == 0.0)) { + ce1 -= pi * std::complex(0.0, 1.0); + } } + return ce1; } - return; -} + template + T eix(T x) { -template -T e1xb(T x) { + // ============================================ + // Purpose: Compute exponential integral Ei(x) + // Input : x --- Argument of Ei(x) + // Output: EI --- Ei(x) + // ============================================ - // ============================================ - // Purpose: Compute exponential integral E1(x) - // Input : x --- Argument of E1(x) - // Output: E1 --- E1(x) ( x > 0 ) - // ============================================ + const T ga = 0.5772156649015328; + T ei, r; - int k, m; - T e1, r, t, t0; - const T ga = 0.5772156649015328; + if (x == 0.0) { + ei = -1.0e+300; + } else if (x < 0) { + ei = -e1xb(-x); + } else if (fabs(x) <= 40.0) { + // Power series around x=0 + ei = 1.0; + r = 1.0; - if (x == 0.0) { - e1 = 1e300; - } else if (x <= 1.0) { - e1 = 1.0; - r = 1.0; - for (k = 1; k < 26; k++) { - r = -r*k*x/pow(k+1.0, 2); - e1 += r; - if (fabs(r) <= fabs(e1)*1e-15) { break; } - } - e1 = -ga - log(x) + x*e1; - } else { - m = 20 + (int)(80.0/x); - t0 = 0.0; - for (k = m; k > 0; k--) { - t0 = k / (1.0 + k / (x+t0)); - } - t = 1.0 / (x + t0); - e1 = exp(-x)*t; - } - return e1; -} - - -template -std::complex e1z(std::complex z) { - - // ==================================================== - // Purpose: Compute complex exponential integral E1(z) - // Input : z --- Argument of E1(z) - // Output: CE1 --- E1(z) - // ==================================================== - - const T pi = 3.141592653589793; - const T el = 0.5772156649015328; - int k; - std::complex ce1, cr, zc, zd, zdc; - T x = z.real(); - T a0 = std::abs(z); - // Continued fraction converges slowly near negative real axis, - // so use power series in a wedge around it until radius 40.0 - T xt = -2.0*fabs(z.imag()); - - if (a0 == 0.0) { return 1e300; } - if ((a0 < 5.0) || ((x < xt) && (a0 < 40.0))) { - // Power series - ce1 = 1.0; - cr = 1.0; - for (k = 1; k < 501; k++) { - cr = -cr*z*static_cast(k / std::pow(k + 1, 2)); - ce1 += cr; - if (std::abs(cr) < std::abs(ce1)*1e-15) { break; } - } - if ((x <= 0.0) && (z.imag() == 0.0)) { - //Careful on the branch cut -- use the sign of the imaginary part - // to get the right sign on the factor if pi. - ce1 = -el - std::log(-z) + z*ce1 - copysign(pi, z.imag())*std::complex(0.0, 1.0); + for (int k = 1; k <= 100; k++) { + r = r * k * x / ((k + 1.0) * (k + 1.0)); + ei += r; + if (fabs(r / ei) <= 1.0e-15) { + break; + } + } + ei = ga + log(x) + x * ei; } else { - ce1 = -el - std::log(z) + z*ce1; - } - } else { - // Continued fraction https://dlmf.nist.gov/6.9 - // 1 1 1 2 2 3 3 - // E1 = exp(-z) * ----- ----- ----- ----- ----- ----- ----- ... - // Z + 1 + Z + 1 + Z + 1 + Z + - zc = 0.0; - zd = static_cast(1) / z; - zdc = zd; - zc += zdc; - for (k = 1; k < 501; k++) { - zd = static_cast(1) / (zd*static_cast(k) + static_cast(1)); - zdc *= (zd - static_cast(1)); - zc += zdc; - - zd = static_cast(1) / (zd*static_cast(k) + z); - zdc *= (z*zd - static_cast(1)); - zc += zdc; - if ((std::abs(zdc) <= std::abs(zc)*1e-15) && (k > 20)) { break; } - } - ce1 = std::exp(-z)*zc; - if ((x <= 0.0) && (z.imag() == 0.0)) { - ce1 -= pi*std::complex(0.0, 1.0); + // Asymptotic expansion (the series is not convergent) + ei = 1.0; + r = 1.0; + for (int k = 1; k <= 20; k++) { + r = r * k / x; + ei += r; + } + ei = exp(x) / x * ei; } + return ei; } - return ce1; -} - - -template -T eix(T x) { - - // ============================================ - // Purpose: Compute exponential integral Ei(x) - // Input : x --- Argument of Ei(x) - // Output: EI --- Ei(x) - // ============================================ - const T ga = 0.5772156649015328; - T ei, r; + template + std::complex eixz(std::complex z) { - if (x == 0.0) { - ei = -1.0e+300; - } else if (x < 0) { - ei = -e1xb(-x); - } else if (fabs(x) <= 40.0) { - // Power series around x=0 - ei = 1.0; - r = 1.0; + // ============================================ + // Purpose: Compute exponential integral Ei(x) + // Input : x --- Complex argument of Ei(x) + // Output: EI --- Ei(x) + // ============================================ - for (int k = 1; k <= 100; k++) { - r = r * k * x / ((k + 1.0) * (k + 1.0)); - ei += r; - if (fabs(r / ei) <= 1.0e-15) { break; } - } - ei = ga + log(x) + x * ei; - } else { - // Asymptotic expansion (the series is not convergent) - ei = 1.0; - r = 1.0; - for (int k = 1; k <= 20; k++) { - r = r * k / x; - ei += r; - } - ei = exp(x) / x * ei; - } - return ei; -} - - -template -std::complex eixz(std::complex z) { - - // ============================================ - // Purpose: Compute exponential integral Ei(x) - // Input : x --- Complex argument of Ei(x) - // Output: EI --- Ei(x) - // ============================================ - - std::complex cei; - const T pi = 3.141592653589793; - cei = - e1z(-z); - if (z.imag() > 0.0) { - cei += std::complex(0.0, pi); - } else if (z.imag() < 0.0 ) { - cei -= std::complex(0.0, pi); - } else { - if (z.real() > 0.0) { - cei += std::complex(0.0, copysign(pi, z.imag())); + std::complex cei; + const T pi = 3.141592653589793; + cei = -e1z(-z); + if (z.imag() > 0.0) { + cei += std::complex(0.0, pi); + } else if (z.imag() < 0.0) { + cei -= std::complex(0.0, pi); + } else { + if (z.real() > 0.0) { + cei += std::complex(0.0, copysign(pi, z.imag())); + } } + return cei; } - return cei; -} - - -inline void eulerb(int n, double *en) { - - // ====================================== - // Purpose: Compute Euler number En - // Input : n --- Serial number - // Output: EN(n) --- En - // ====================================== - - int k, m, isgn; - double r1, r2, s; - const double hpi = 2.0 / 3.141592653589793; - en[0] = 1.0; - en[2] = -1.0; - r1 = -4.0*pow(hpi, 3); - for (m = 4; m <= n; m += 2) { - r1 = -r1 * (m-1) * m * hpi * hpi; - r2 = 1.0; - isgn = 1; - for (k = 3; k <= 1000; k += 2) { - isgn = -isgn; - s = pow(1.0 / k, m + 1); - r2 += isgn * s; - if (s < 1e-15) { break; } - } - en[m] = r1*r2; - } - return; -} - - -template -void fcoef(int kd, int m, T q, T a, T *fc) { - - // ===================================================== - // Purpose: Compute expansion coefficients for Mathieu - // functions and modified Mathieu functions - // Input : m --- Order of Mathieu functions - // q --- Parameter of Mathieu functions - // KD --- Case code - // KD=1 for cem(x,q) ( m = 0,2,4,...) - // KD=2 for cem(x,q) ( m = 1,3,5,...) - // KD=3 for sem(x,q) ( m = 1,3,5,...) - // KD=4 for sem(x,q) ( m = 2,4,6,...) - // A --- Characteristic value of Mathieu - // functions for given m and q - // Output: FC(k) --- Expansion coefficients of Mathieu - // functions ( k= 1,2,...,KM ) - // FC(1),FC(2),FC(3),... correspond to - // A0,A2,A4,... for KD=1 case, A1,A3, - // A5,... for KD=2 case, B1,B3,B5,... - // for KD=3 case and B2,B4,B6,... for - // KD=4 case - // ===================================================== - - int i, k, j, jm = 0, km, kb; - T f1, fnan, qm, s, f, u, v, f2, f3, sp, ss, s0; - - for (i = 0; i < 251; ++i) { fc[i] = 0.0; } - - if (fabs(q) <= 1.0e-7) { - // Expansion up to order Q^1 (Abramowitz & Stegun 20.2.27-28) - if (kd == 1) { - jm = m / 2 + 1; - } else if ((kd == 2) || (kd == 3)) { - jm = (m - 1) / 2 + 1; - } else if (kd == 4) { - jm = m / 2; - } - if (jm + 1 > 251) { - fnan = NAN; - for (i = 0; i < 251; ++i) { - fc[i] = fnan; - } - return; - } - // Proceed using the simplest expansion - if (kd == 1 || kd == 2) { - if (m == 0) { - fc[0] = 1.0 / sqrt(2.0); - fc[1] = -q / (2.0 * sqrt(2.0)); - } else if (m == 1) { - fc[0] = 1.0; - fc[1] = -q / 8.0; - } else if (m == 2) { - fc[0] = q / 4.0; - fc[1] = 1.0; - fc[2] = -q / 12.0; - } else { - fc[jm - 1] = 1.0; - fc[jm] = -q / (4.0 * (m + 1)); - fc[jm - 2] = q / (4.0 * (m - 1)); - } - } else if (kd == 3 || kd == 4) { - if (m == 1) { - fc[0] = 1.0; - fc[1] = -q / 8.0; - } else if (m == 2) { - fc[0] = 1.0; - fc[1] = -q / 12.0; - } else { - fc[jm - 1] = 1.0; - fc[jm] = -q / (4.0 * (m + 1)); - fc[jm - 2] = q / (4.0 * (m - 1)); + inline void eulerb(int n, double *en) { + + // ====================================== + // Purpose: Compute Euler number En + // Input : n --- Serial number + // Output: EN(n) --- En + // ====================================== + + int k, m, isgn; + double r1, r2, s; + const double hpi = 2.0 / 3.141592653589793; + en[0] = 1.0; + en[2] = -1.0; + r1 = -4.0 * pow(hpi, 3); + for (m = 4; m <= n; m += 2) { + r1 = -r1 * (m - 1) * m * hpi * hpi; + r2 = 1.0; + isgn = 1; + for (k = 3; k <= 1000; k += 2) { + isgn = -isgn; + s = pow(1.0 / k, m + 1); + r2 += isgn * s; + if (s < 1e-15) { + break; + } } + en[m] = r1 * r2; } return; - } else if (q <= 1.0) { - qm = 7.5 + 56.1 * sqrt(q) - 134.7 * q + 90.7 * sqrt(q) * q; - } else { - qm = 17.0 + 3.1 * sqrt(q) - 0.126 * q + 0.0037 * sqrt(q) * q; } - km = (int)(qm + 0.5 * m); + template + void fcoef(int kd, int m, T q, T a, T *fc) { + + // ===================================================== + // Purpose: Compute expansion coefficients for Mathieu + // functions and modified Mathieu functions + // Input : m --- Order of Mathieu functions + // q --- Parameter of Mathieu functions + // KD --- Case code + // KD=1 for cem(x,q) ( m = 0,2,4,...) + // KD=2 for cem(x,q) ( m = 1,3,5,...) + // KD=3 for sem(x,q) ( m = 1,3,5,...) + // KD=4 for sem(x,q) ( m = 2,4,6,...) + // A --- Characteristic value of Mathieu + // functions for given m and q + // Output: FC(k) --- Expansion coefficients of Mathieu + // functions ( k= 1,2,...,KM ) + // FC(1),FC(2),FC(3),... correspond to + // A0,A2,A4,... for KD=1 case, A1,A3, + // A5,... for KD=2 case, B1,B3,B5,... + // for KD=3 case and B2,B4,B6,... for + // KD=4 case + // ===================================================== + + int i, k, j, jm = 0, km, kb; + T f1, fnan, qm, s, f, u, v, f2, f3, sp, ss, s0; - if (km > 251) { - // Overflow, generate NaNs for (i = 0; i < 251; ++i) { - fc[i] = NAN; + fc[i] = 0.0; } - return; - } - - kb = 0; - s = 0.0; - f = 1.0e-100; - u = 0.0; - fc[km - 1] = 0.0; - f2 = 0.0; - if (kd == 1) { - for (k = km; k >= 3; k--) { - v = u; - u = f; - f = (a - 4.0 * k * k) * u / q - v; - - if (fabs(f) < fabs(fc[k])) { - kb = k; - fc[0] = 1.0e-100; - sp = 0.0; - f3 = fc[k]; - fc[1] = a / q * fc[0]; - fc[2] = (a - 4.0) * fc[1] / q - 2.0 * fc[0]; - u = fc[1]; - f1 = fc[2]; - - for (i = 3; i <= kb; i++) { - v = u; - u = f1; - f1 = (a - 4.0 * (i - 1.0) * (i - 1.0)) * u / q - v; - fc[i] = f1; + if (fabs(q) <= 1.0e-7) { + // Expansion up to order Q^1 (Abramowitz & Stegun 20.2.27-28) + if (kd == 1) { + jm = m / 2 + 1; + } else if ((kd == 2) || (kd == 3)) { + jm = (m - 1) / 2 + 1; + } else if (kd == 4) { + jm = m / 2; + } - if (i == kb) { f2 = f1; } - if (i != kb) { sp += f1*f1; } + if (jm + 1 > 251) { + fnan = NAN; + for (i = 0; i < 251; ++i) { + fc[i] = fnan; } - - sp += 2.0*fc[0]*fc[0] + fc[1]*fc[1] + fc[2]*fc[2]; - ss = s + sp * (f3 / f2) * (f3 / f2); - s0 = sqrt(1.0 / ss); - - for (j = 1; j <= km; j++) { - if (j <= kb + 1) { - fc[j - 1] = s0 * fc[j-1] * f3 / f2; - } else { - fc[j - 1] *= s0; - } - } - if (fc[0] < 0.0) { for (j = 0; j < km; j++) { fc[j] = -fc[j]; } } return; - } else { - fc[k - 1] = f; - s += f*f; } + // Proceed using the simplest expansion + if (kd == 1 || kd == 2) { + if (m == 0) { + fc[0] = 1.0 / sqrt(2.0); + fc[1] = -q / (2.0 * sqrt(2.0)); + } else if (m == 1) { + fc[0] = 1.0; + fc[1] = -q / 8.0; + } else if (m == 2) { + fc[0] = q / 4.0; + fc[1] = 1.0; + fc[2] = -q / 12.0; + } else { + fc[jm - 1] = 1.0; + fc[jm] = -q / (4.0 * (m + 1)); + fc[jm - 2] = q / (4.0 * (m - 1)); + } + } else if (kd == 3 || kd == 4) { + if (m == 1) { + fc[0] = 1.0; + fc[1] = -q / 8.0; + } else if (m == 2) { + fc[0] = 1.0; + fc[1] = -q / 12.0; + } else { + fc[jm - 1] = 1.0; + fc[jm] = -q / (4.0 * (m + 1)); + fc[jm - 2] = q / (4.0 * (m - 1)); + } + } + return; + } else if (q <= 1.0) { + qm = 7.5 + 56.1 * sqrt(q) - 134.7 * q + 90.7 * sqrt(q) * q; + } else { + qm = 17.0 + 3.1 * sqrt(q) - 0.126 * q + 0.0037 * sqrt(q) * q; } - fc[1] = q * fc[2] / (a - 4.0 - 2.0 * q * q / a); - fc[0] = q / a * fc[1]; - s += 2.0 * fc[0] * fc[0] + fc[1] * fc[1]; - s0 = sqrt(1.0 / s); - - for (k = 1; k <= km; k++) { - fc[k - 1] *= s0; - } - } else if ((kd == 2) || (kd == 3)) { - for (k = km; k >= 3; k--) { - v = u; - u = f; - f = (a - (2.0 * k - 1) * (2.0 * k - 1)) * u / q - v; + km = (int)(qm + 0.5 * m); - if (fabs(f) >= fabs(fc[k - 1])) { - fc[k - 2] = f; - s += f * f; - } else { - kb = k; - f3 = fc[k - 1]; - goto L45; + if (km > 251) { + // Overflow, generate NaNs + for (i = 0; i < 251; ++i) { + fc[i] = NAN; } + return; } - fc[0] = q / (a - 1.0 - pow(-1, kd) * q) * fc[1]; - s += fc[0] * fc[0]; - s0 = sqrt(1.0 / s); + kb = 0; + s = 0.0; + f = 1.0e-100; + u = 0.0; + fc[km - 1] = 0.0; + f2 = 0.0; - for (k = 1; k <= km; k++) { - fc[k - 1] *= s0; - } - if (fc[0] < 0.0) { for (j = 0; j < km; j++) { fc[j] = -fc[j]; } } - return; -L45: - fc[0] = 1.0e-100; - fc[1] = (a - 1.0 - pow(-1, kd) * q) / q * fc[0]; - sp = 0.0; - u = fc[0]; - f1 = fc[1]; - - for (i = 2; i <= kb - 1; i++) { - v = u; - u = f1; - f1 = (a - (2.0 * i - 1) * (2.0 * i - 1)) * u / q - v; - - if (i != kb - 1) { - fc[i] = f1; - sp += f1 * f1; - } else { - f2 = f1; + if (kd == 1) { + for (k = km; k >= 3; k--) { + v = u; + u = f; + f = (a - 4.0 * k * k) * u / q - v; + + if (fabs(f) < fabs(fc[k])) { + kb = k; + fc[0] = 1.0e-100; + sp = 0.0; + f3 = fc[k]; + fc[1] = a / q * fc[0]; + fc[2] = (a - 4.0) * fc[1] / q - 2.0 * fc[0]; + u = fc[1]; + f1 = fc[2]; + + for (i = 3; i <= kb; i++) { + v = u; + u = f1; + f1 = (a - 4.0 * (i - 1.0) * (i - 1.0)) * u / q - v; + fc[i] = f1; + + if (i == kb) { + f2 = f1; + } + if (i != kb) { + sp += f1 * f1; + } + } + + sp += 2.0 * fc[0] * fc[0] + fc[1] * fc[1] + fc[2] * fc[2]; + ss = s + sp * (f3 / f2) * (f3 / f2); + s0 = sqrt(1.0 / ss); + + for (j = 1; j <= km; j++) { + if (j <= kb + 1) { + fc[j - 1] = s0 * fc[j - 1] * f3 / f2; + } else { + fc[j - 1] *= s0; + } + } + if (fc[0] < 0.0) { + for (j = 0; j < km; j++) { + fc[j] = -fc[j]; + } + } + return; + } else { + fc[k - 1] = f; + s += f * f; + } } - } - sp += fc[0] * fc[0] + fc[1] * fc[1]; - ss = s + sp * (f3 / f2) * (f3 / f2); - s0 = sqrt(1.0 / ss); + fc[1] = q * fc[2] / (a - 4.0 - 2.0 * q * q / a); + fc[0] = q / a * fc[1]; + s += 2.0 * fc[0] * fc[0] + fc[1] * fc[1]; + s0 = sqrt(1.0 / s); - for (j = 1; j <= km; j++) { - if (j < kb) { - fc[j - 1] *= s0 * f3 / f2; + for (k = 1; k <= km; k++) { + fc[k - 1] *= s0; + } + } else if ((kd == 2) || (kd == 3)) { + for (k = km; k >= 3; k--) { + v = u; + u = f; + f = (a - (2.0 * k - 1) * (2.0 * k - 1)) * u / q - v; + + if (fabs(f) >= fabs(fc[k - 1])) { + fc[k - 2] = f; + s += f * f; + } else { + kb = k; + f3 = fc[k - 1]; + goto L45; + } } - if (j >= kb) { - fc[j - 1] *= s0; + fc[0] = q / (a - 1.0 - pow(-1, kd) * q) * fc[1]; + s += fc[0] * fc[0]; + s0 = sqrt(1.0 / s); + + for (k = 1; k <= km; k++) { + fc[k - 1] *= s0; + } + if (fc[0] < 0.0) { + for (j = 0; j < km; j++) { + fc[j] = -fc[j]; + } + } + return; + L45: + fc[0] = 1.0e-100; + fc[1] = (a - 1.0 - pow(-1, kd) * q) / q * fc[0]; + sp = 0.0; + u = fc[0]; + f1 = fc[1]; + + for (i = 2; i <= kb - 1; i++) { + v = u; + u = f1; + f1 = (a - (2.0 * i - 1) * (2.0 * i - 1)) * u / q - v; + + if (i != kb - 1) { + fc[i] = f1; + sp += f1 * f1; + } else { + f2 = f1; + } } - } - } else if (kd == 4) { - for (k = km; k >= 3; k--) { - v = u; - u = f; - f = (a - 4.0 * k * k) * u / q - v; + sp += fc[0] * fc[0] + fc[1] * fc[1]; + ss = s + sp * (f3 / f2) * (f3 / f2); + s0 = sqrt(1.0 / ss); - if (fabs(f) >= fabs(fc[k])) { - fc[k - 2] = f; - s += f*f; - } else { - kb = k; - f3 = fc[k - 1]; - goto L70; + for (j = 1; j <= km; j++) { + if (j < kb) { + fc[j - 1] *= s0 * f3 / f2; + } + + if (j >= kb) { + fc[j - 1] *= s0; + } + } + + } else if (kd == 4) { + for (k = km; k >= 3; k--) { + v = u; + u = f; + f = (a - 4.0 * k * k) * u / q - v; + + if (fabs(f) >= fabs(fc[k])) { + fc[k - 2] = f; + s += f * f; + } else { + kb = k; + f3 = fc[k - 1]; + goto L70; + } } - } - fc[0] = q / (a - 4.0) * fc[1]; - s += fc[0] * fc[0]; - s0 = sqrt(1.0 / s); + fc[0] = q / (a - 4.0) * fc[1]; + s += fc[0] * fc[0]; + s0 = sqrt(1.0 / s); - for (k = 1; k <= km; k++) { - fc[k - 1] *= s0; - } - if (fc[0] < 0.0) { for (j = 0; j < km; j++) { fc[j] = -fc[j]; } } - return; -L70: - fc[0] = 1.0e-100; - fc[1] = (a - 4.0) / q * fc[0]; - sp = 0.0; - u = fc[0]; - f1 = fc[1]; - - for (i = 2; i <= kb - 1; i++) { - v = u; - u = f1; - f1 = (a - 4.0 * i * i) * u / q - v; - - if (i != kb - 1) { - fc[i] = f1; - sp = sp + f1 * f1; - } else { - f2 = f1; + for (k = 1; k <= km; k++) { + fc[k - 1] *= s0; + } + if (fc[0] < 0.0) { + for (j = 0; j < km; j++) { + fc[j] = -fc[j]; + } + } + return; + L70: + fc[0] = 1.0e-100; + fc[1] = (a - 4.0) / q * fc[0]; + sp = 0.0; + u = fc[0]; + f1 = fc[1]; + + for (i = 2; i <= kb - 1; i++) { + v = u; + u = f1; + f1 = (a - 4.0 * i * i) * u / q - v; + + if (i != kb - 1) { + fc[i] = f1; + sp = sp + f1 * f1; + } else { + f2 = f1; + } } - } - sp += fc[0] * fc[0] + fc[1] * fc[1]; - ss = s + sp * (f3 / f2) * (f3 / f2); - s0 = sqrt(1.0 / ss); + sp += fc[0] * fc[0] + fc[1] * fc[1]; + ss = s + sp * (f3 / f2) * (f3 / f2); + s0 = sqrt(1.0 / ss); - for (j = 1; j <= km; j++) { - if (j < kb) { - fc[j - 1] *= s0 * f3 / f2; - } else { - fc[j - 1] *= s0; + for (j = 1; j <= km; j++) { + if (j < kb) { + fc[j - 1] *= s0 * f3 / f2; + } else { + fc[j - 1] *= s0; + } + } + } + if (fc[0] < 0.0) { + for (j = 0; j < km; j++) { + fc[j] = -fc[j]; } } + return; } - if (fc[0] < 0.0) { for (j = 0; j < km; j++) { fc[j] = -fc[j]; } } - return; -} - -inline double gaih(double x) { + inline double gaih(double x) { - // ===================================================== - // Purpose: Compute gamma function Г(x) - // Input : x --- Argument of Г(x), x = n/2, n=1,2,… - // Output: GA --- Г(x) - // ===================================================== + // ===================================================== + // Purpose: Compute gamma function Г(x) + // Input : x --- Argument of Г(x), x = n/2, n=1,2,… + // Output: GA --- Г(x) + // ===================================================== - int k, m; - const double pi = 3.141592653589793; - double ga = 0.0; + int k, m; + const double pi = 3.141592653589793; + double ga = 0.0; - if ((x == (int)x) && (x > 0.0)) { - ga = 1.0; - m = (int)(x - 1.0); - for (k = 2; k < (m+1); k++) { - ga *= k; - } - } else if (((x+0.5) == (int)(x+0.5)) && (x > 0.0)) { - m = (int)x; - ga = sqrt(pi); - for (k = 1; k < (m+1); k++) { - ga *= 0.5*(2.0*k - 1.0); - } - } else { - ga = NAN; - } - return ga; -} - - -inline double gam0(double x) { - - // ================================================ - // Purpose: Compute gamma function Г(x) - // Input : x --- Argument of Г(x) ( |x| ≤ 1 ) - // Output: GA --- Г(x) - // ================================================ - double gr; - static const double g[25] = { - 1.0e0, - 0.5772156649015329e0, -0.6558780715202538e0, -0.420026350340952e-1, 0.1665386113822915e0, - -0.421977345555443e-1, -0.96219715278770e-2, 0.72189432466630e-2, -0.11651675918591e-2, - -0.2152416741149e-3, 0.1280502823882e-3, -0.201348547807e-4, -0.12504934821e-5, - 0.11330272320e-5, -0.2056338417e-6, 0.61160950e-8, 0.50020075e-8, -0.11812746e-8, - 0.1043427e-9, 0.77823e-11, -0.36968e-11, 0.51e-12, -0.206e-13, -0.54e-14, 0.14e-14 - }; - gr = g[24]; - for (int k = 23; k >= 0; k--) { - gr = gr*x + g[k]; - } - return 1.0 / (gr * x); -} - - -inline double gamma2(double x) { - - // ================================================== - // Purpose: Compute gamma function Г(x) - // Input : x --- Argument of Г(x) - // ( x is not equal to 0,-1,-2,…) - // Output: GA --- Г(x) - // ================================================== - - double ga, gr, r, z; - int k, m; - const double pi = 3.141592653589793; - static const double g[26] = { - 1.0000000000000000e+00, 0.5772156649015329e+00, -0.6558780715202538e+00, -0.4200263503409520e-01, - 0.1665386113822915e+00, -0.4219773455554430e-01, -0.9621971527877000e-02, 0.7218943246663000e-02, - -0.1165167591859100e-02, -0.2152416741149000e-03, 0.1280502823882000e-03, -0.2013485478070000e-04, - -0.1250493482100000e-05, 0.1133027232000000e-05, -0.2056338417000000e-06, 0.6116095000000000e-08, - 0.5002007500000000e-08, -0.1181274600000000e-08, 0.1043427000000000e-09, 0.7782300000000000e-11, - -0.3696800000000000e-11, 0.5100000000000000e-12, -0.2060000000000000e-13, -0.5400000000000000e-14, - 0.1400000000000000e-14, 0.1000000000000000e-15 - }; - if (x == (int)x) { - if (x > 0.0) { + if ((x == (int)x) && (x > 0.0)) { ga = 1.0; - m = (int)(x - 1); - for (k = 2; k < (m+1); k++) { + m = (int)(x - 1.0); + for (k = 2; k < (m + 1); k++) { ga *= k; } + } else if (((x + 0.5) == (int)(x + 0.5)) && (x > 0.0)) { + m = (int)x; + ga = sqrt(pi); + for (k = 1; k < (m + 1); k++) { + ga *= 0.5 * (2.0 * k - 1.0); + } } else { - ga = 1e300; - } - } else { - r = 1.0; - if (fabs(x) > 1.0) { - z = fabs(x); - m = (int)z; - for (k = 1; k < (m+1); k++) { - r *= (z-k); + ga = NAN; + } + return ga; + } + + inline double gam0(double x) { + + // ================================================ + // Purpose: Compute gamma function Г(x) + // Input : x --- Argument of Г(x) ( |x| ≤ 1 ) + // Output: GA --- Г(x) + // ================================================ + double gr; + static const double g[25] = { + 1.0e0, + 0.5772156649015329e0, + -0.6558780715202538e0, + -0.420026350340952e-1, + 0.1665386113822915e0, + -0.421977345555443e-1, + -0.96219715278770e-2, + 0.72189432466630e-2, + -0.11651675918591e-2, + -0.2152416741149e-3, + 0.1280502823882e-3, + -0.201348547807e-4, + -0.12504934821e-5, + 0.11330272320e-5, + -0.2056338417e-6, + 0.61160950e-8, + 0.50020075e-8, + -0.11812746e-8, + 0.1043427e-9, + 0.77823e-11, + -0.36968e-11, + 0.51e-12, + -0.206e-13, + -0.54e-14, + 0.14e-14 + }; + gr = g[24]; + for (int k = 23; k >= 0; k--) { + gr = gr * x + g[k]; + } + return 1.0 / (gr * x); + } + + inline double gamma2(double x) { + + // ================================================== + // Purpose: Compute gamma function Г(x) + // Input : x --- Argument of Г(x) + // ( x is not equal to 0,-1,-2,…) + // Output: GA --- Г(x) + // ================================================== + + double ga, gr, r, z; + int k, m; + const double pi = 3.141592653589793; + static const double g[26] = {1.0000000000000000e+00, 0.5772156649015329e+00, -0.6558780715202538e+00, + -0.4200263503409520e-01, 0.1665386113822915e+00, -0.4219773455554430e-01, + -0.9621971527877000e-02, 0.7218943246663000e-02, -0.1165167591859100e-02, + -0.2152416741149000e-03, 0.1280502823882000e-03, -0.2013485478070000e-04, + -0.1250493482100000e-05, 0.1133027232000000e-05, -0.2056338417000000e-06, + 0.6116095000000000e-08, 0.5002007500000000e-08, -0.1181274600000000e-08, + 0.1043427000000000e-09, 0.7782300000000000e-11, -0.3696800000000000e-11, + 0.5100000000000000e-12, -0.2060000000000000e-13, -0.5400000000000000e-14, + 0.1400000000000000e-14, 0.1000000000000000e-15}; + if (x == (int)x) { + if (x > 0.0) { + ga = 1.0; + m = (int)(x - 1); + for (k = 2; k < (m + 1); k++) { + ga *= k; + } + } else { + ga = 1e300; } - z -= m; } else { - z = x; + r = 1.0; + if (fabs(x) > 1.0) { + z = fabs(x); + m = (int)z; + for (k = 1; k < (m + 1); k++) { + r *= (z - k); + } + z -= m; + } else { + z = x; + } + gr = g[25]; + for (k = 25; k > 0; k--) { + gr *= z; + gr += g[k - 1]; + } + ga = 1.0 / (gr * z); + if (fabs(x) > 1.0) { + ga *= r; + if (x < 0.0) { + ga = -pi / (x * ga * sin(pi * x)); + } + } } - gr = g[25]; - for ( k = 25; k > 0; k--) { - gr *= z; - gr += g[k-1]; + return ga; + } + + template + inline void gmn(int m, int n, T c, T x, T *bk, T *gf, T *gd) { + + // =========================================================== + // Purpose: Compute gmn(-ic,ix) and its derivative for oblate + // radial functions with a small argument + // =========================================================== + + int ip, k, nm; + T xm, gf0, gw, gd0, gd1; + const T eps = 1.0e-14; + ip = ((n - m) % 2 == 0 ? 0 : 1); + nm = 25 + (int)(0.5 * (n - m) + c); + xm = pow(1.0 + x * x, -0.5 * m); + gf0 = 0.0; + gw = 0.0; + + for (k = 1; k <= nm; k++) { + gf0 += bk[k - 1] * pow(x, 2.0 * k - 2.0); + if ((fabs((gf0 - gw) / gf0) < eps) && (k >= 10)) { + break; + } + gw = gf0; } - ga = 1.0 / (gr*z); - if (fabs(x) > 1.0) { - ga *= r; - if (x < 0.0) { - ga = -pi / (x*ga*sin(pi*x)); + + *gf = xm * gf0 * pow(x, 1 - ip); + gd1 = -m * x / (1.0 + x * x) * (*gf); + gd0 = 0.0; + + for (k = 1; k < nm; ++k) { + if (ip == 0) { + gd0 += (2.0 * k - 1.0) * bk[k - 1] * pow(x, 2.0 * k - 2.0); + } else { + gd0 += 2.0 * k * bk[k - 1] * pow(x, 2.0 * k - 1.0); + } + if ((fabs((gd0 - gw) / gd0) < eps) && (k >= 10)) { + break; } + gw = gd0; } - } - return ga; -} - - -template -inline void gmn(int m, int n, T c, T x, T *bk, T *gf, T *gd) { - - // =========================================================== - // Purpose: Compute gmn(-ic,ix) and its derivative for oblate - // radial functions with a small argument - // =========================================================== - - int ip, k, nm; - T xm, gf0, gw, gd0, gd1; - const T eps = 1.0e-14; - ip = ((n - m) % 2 == 0 ? 0 : 1); - nm = 25 + (int)(0.5 * (n - m) + c); - xm = pow(1.0 + x * x, -0.5 * m); - gf0 = 0.0; - gw = 0.0; - - for (k = 1; k <= nm; k++) { - gf0 += bk[k - 1] * pow(x, 2.0 * k - 2.0); - if ((fabs((gf0 - gw) / gf0) < eps) && (k >= 10)) { break; } - gw = gf0; + *gd = gd1 + xm * gd0; } - *gf = xm * gf0 * pow(x, 1 - ip); - gd1 = -m * x / (1.0 + x * x) * (*gf); - gd0 = 0.0; + inline std::complex hygfz(double a, double b, double c, std::complex z, int *isfer) { - for (k = 1; k < nm; ++k) { - if (ip == 0) { - gd0 += (2.0 * k - 1.0) * bk[k - 1] * pow(x, 2.0 * k - 2.0); - } else { - gd0 += 2.0 * k * bk[k - 1] * pow(x, 2.0 * k - 1.0); + // ====================================================== + // Purpose: Compute the hypergeometric function for a + // complex argument, F(a,b,c,z) + // Input : a --- Parameter + // b --- Parameter + // c --- Parameter, c <> 0,-1,-2,... + // z --- Complex argument + // Output: ZHF --- F(a,b,c,z) + // ISFER --- Error flag + // Routines called: + // (1) GAMMA2 for computing gamma function + // (2) PSI_SPEC for computing psi function + // ====================================================== + + int L0 = 0, L1 = 0, L2 = 0, L3 = 0, L4 = 0, L5 = 0, L6 = 0; + int j, k = 1, m, mab, mcab, nca, ncb, nm; + double a0, aa, bb, ca, cb, g0, g1, g2, g3, ga, gab, gam, gabc, gb, gba, gbm, gc, gcab, gca, gcb, gm, pa, pac, + pb, pca, rk1, rk2, rm, sp0, sm, sp, sq, sj1, sj2, w0, ws; + std::complex z00, z1, zc0, zc1, zf0, zf1, zhf = 0.0, zp, zr, zp0, zr0, zr1, zw = 0.0; + double x = z.real(); + double y = z.imag(); + double eps = 1e-15; + double pi = 3.141592653589793; + double el = 0.5772156649015329; + *isfer = 0; + + if ((c == (int)c) && (c < 0.0)) { + L0 = 1; + } + if ((fabs(1 - x) < eps) && (y == 0.0) && (c - a - b <= 0.0)) { + L1 = 1; + } + if ((std::abs(z + 1.0) < eps) && (fabs(c - a + b - 1.0) < eps)) { + L2 = 1; + } + if ((a == (int)a) && (a < 0.0)) { + L3 = 1; + } + if ((b == (int)b) && (b < 0.0)) { + L4 = 1; + } + if (((c - a) == (int)(c - a)) && (c - a <= 0.0)) { + L5 = 1; + } + if (((c - b) == (int)(c - b)) && (c - b <= 0.0)) { + L6 = 1; + } + aa = a; + bb = b; + a0 = std::abs(z); + if (a0 > 0.95) { + eps = 1e-8; + } + if (L0 || L1) { + *isfer = 3; + return 0.0; } - if ((fabs((gd0 - gw) / gd0) < eps) && (k >= 10)) { break; } - gw = gd0; - } - *gd = gd1 + xm * gd0; -} - - -inline std::complex hygfz(double a, double b, double c, std::complex z, int *isfer) { - - // ====================================================== - // Purpose: Compute the hypergeometric function for a - // complex argument, F(a,b,c,z) - // Input : a --- Parameter - // b --- Parameter - // c --- Parameter, c <> 0,-1,-2,... - // z --- Complex argument - // Output: ZHF --- F(a,b,c,z) - // ISFER --- Error flag - // Routines called: - // (1) GAMMA2 for computing gamma function - // (2) PSI_SPEC for computing psi function - // ====================================================== - - int L0 = 0, L1 = 0, L2 = 0, L3 = 0, L4 = 0, L5 = 0, L6 = 0; - int j, k=1, m, mab, mcab, nca, ncb, nm; - double a0, aa, bb, ca, cb, g0, g1, g2, g3, ga, gab, gam, gabc, gb, gba, gbm, gc, gcab,\ - gca, gcb, gm, pa, pac, pb, pca, rk1, rk2, rm, sp0, sm, sp, sq, sj1, sj2, w0, ws; - std::complex z00, z1, zc0, zc1, zf0, zf1, zhf = 0.0, zp, zr, zp0, zr0, zr1, zw = 0.0; - double x = z.real(); - double y = z.imag(); - double eps = 1e-15; - double pi = 3.141592653589793; - double el = 0.5772156649015329; - *isfer = 0; - - if ((c == (int)c) && (c < 0.0)) { L0 = 1; } - if ((fabs(1 - x) < eps) && (y == 0.0) && (c-a-b <= 0.0)) { L1 = 1; } - if ((std::abs(z+1.0) < eps) && (fabs(c-a+b - 1.0) < eps)) { L2 = 1; } - if ((a == (int)a) && (a < 0.0)) { L3 = 1; } - if ((b == (int)b) && (b < 0.0)) { L4 = 1; } - if (((c-a) == (int)(c-a)) && (c-a <= 0.0)) { L5 = 1; } - if (((c-b) == (int)(c-b)) && (c-b <= 0.0)) { L6 = 1; } - aa = a; - bb = b; - a0 = std::abs(z); - if (a0 > 0.95) { eps = 1e-8; } - if (L0 || L1) { - *isfer = 3; - return 0.0; - } - if ((a0 == 0.0) || (a == 0.0) || (b == 0.0)) { - zhf = 1.0; - } else if ((z == 1.0) && (c-a-b > 0.0)) { - gc = gamma2(c); - gcab = gamma2(c-a-b); - gca = gamma2(c-a); - gcb = gamma2(c-b); - zhf = gc*gcab/(gca*gcb); - } else if (L2) { - g0 = sqrt(pi)*pow(2.0, -a); - g1 = gamma2(c); - g2 = gamma2(1.0 + 0.5*a - b); - g3 = gamma2(0.5 + 0.5*a); - zhf = g0*g1/(g2*g3); - } else if (L3 || L4) { - if (L3) { nm = (int)fabs(a); } - if (L4) { nm = (int)fabs(b); } - zhf = 1.0; - zr = 1.0; - for (k = 1; k < (nm+1); k++) { - zr = zr*(c-a+k-1.0)*(c-b+k-1.0)/(k*(c+k-1.0))*z; - zhf += zr; - } - } else if (L5 || L6) { - if (L5) { nm = (int)fabs(c-a); } - if (L6) { nm = (int)fabs(c-b); } - zhf = 1.0; - zr = 1.0; - for (k = 1; k < (nm+1); k++) { - zr = zr*(c-a+k-1.0)*(c-b+k-1.0)/(k*(c+k-1.0))*z; - zhf += zr; - } - zhf *= std::pow(1.0-z, c-a-b); - } else if (a0 <= 1.0) { - if (x < 0.0) { - z1 = z / (z - 1.0); - if ((c > a) && (b < a) && (b > 0.0)) { - a = aa; - b = bb; + if ((a0 == 0.0) || (a == 0.0) || (b == 0.0)) { + zhf = 1.0; + } else if ((z == 1.0) && (c - a - b > 0.0)) { + gc = gamma2(c); + gcab = gamma2(c - a - b); + gca = gamma2(c - a); + gcb = gamma2(c - b); + zhf = gc * gcab / (gca * gcb); + } else if (L2) { + g0 = sqrt(pi) * pow(2.0, -a); + g1 = gamma2(c); + g2 = gamma2(1.0 + 0.5 * a - b); + g3 = gamma2(0.5 + 0.5 * a); + zhf = g0 * g1 / (g2 * g3); + } else if (L3 || L4) { + if (L3) { + nm = (int)fabs(a); + } + if (L4) { + nm = (int)fabs(b); } - zc0 = 1.0 / std::pow(1.0 - z, a); zhf = 1.0; - zr0 = 1.0; - zw = 0.0; - for (k = 1; k <501; k++) { - zr0 = zr0*(a+k-1.0)*(c-b+k-1.0)/(k*(c+k-1.0))*z1; - zhf += zr0; - if (std::abs(zhf-zw) < std::abs(zhf)*eps) { break; } - zw = zhf; - } - zhf *= zc0; - } else if (a0 >= 0.9) { - gm = 0.0; - mcab = (int)(c-a-b + eps*copysign(1.0, c-a-b)); - if (fabs(c-a-b-mcab) < eps) { - m = (int)(c-a-b); - ga = gamma2(a); - gb = gamma2(b); - gc = gamma2(c); - gam = gamma2(a+m); - gbm = gamma2(b+m); - pa = psi_spec(a); - pb = psi_spec(b); - if (m != 0) { gm = 1.0; } - for (j = 1; j < abs(m); j++) { - gm *= j; - } - rm = 1.0; - for (j = 1; j < abs(m)+1; j++) { - rm *= j; + zr = 1.0; + for (k = 1; k < (nm + 1); k++) { + zr = zr * (c - a + k - 1.0) * (c - b + k - 1.0) / (k * (c + k - 1.0)) * z; + zhf += zr; + } + } else if (L5 || L6) { + if (L5) { + nm = (int)fabs(c - a); + } + if (L6) { + nm = (int)fabs(c - b); + } + zhf = 1.0; + zr = 1.0; + for (k = 1; k < (nm + 1); k++) { + zr = zr * (c - a + k - 1.0) * (c - b + k - 1.0) / (k * (c + k - 1.0)) * z; + zhf += zr; + } + zhf *= std::pow(1.0 - z, c - a - b); + } else if (a0 <= 1.0) { + if (x < 0.0) { + z1 = z / (z - 1.0); + if ((c > a) && (b < a) && (b > 0.0)) { + a = aa; + b = bb; } - zf0 = 1.0; + zc0 = 1.0 / std::pow(1.0 - z, a); + zhf = 1.0; zr0 = 1.0; - zr1 = 1.0; - sp0 = 0.0; - sp = 0.0; - if (m >= 0) { - zc0 = gm*gc/(gam*gbm); - zc1 = -gc*std::pow(z-1.0, m)/(ga*gb*rm); - for (k = 1; k < m; k++) { - zr0 = zr0*(a+k-1.0)*(b+k-1.0)/static_cast(k*(k-m))*(1.0-z); - zf0 += zr0; + zw = 0.0; + for (k = 1; k < 501; k++) { + zr0 = zr0 * (a + k - 1.0) * (c - b + k - 1.0) / (k * (c + k - 1.0)) * z1; + zhf += zr0; + if (std::abs(zhf - zw) < std::abs(zhf) * eps) { + break; } - for (k = 1; k < (m+1); k++) { - sp0 += 1.0/(a+k-1.0) + 1.0/(b+k-1.0) - 1.0/k; + zw = zhf; + } + zhf *= zc0; + } else if (a0 >= 0.9) { + gm = 0.0; + mcab = (int)(c - a - b + eps * copysign(1.0, c - a - b)); + if (fabs(c - a - b - mcab) < eps) { + m = (int)(c - a - b); + ga = gamma2(a); + gb = gamma2(b); + gc = gamma2(c); + gam = gamma2(a + m); + gbm = gamma2(b + m); + pa = psi_spec(a); + pb = psi_spec(b); + if (m != 0) { + gm = 1.0; } - zf1 = pa + pb + sp0 + 2.0*el + std::log(1.0 - z); - zw = 0.0; - for (k = 1; k <501; k++) { - sp += (1.0-a)/(k*(a+k-1.0)) + (1.0-b)/(k*(b+k-1.0)); - sm = 0.0; - for (j = 1; j < (m+1); j++) { - sm += (1.0-a)/((j+k)*(a+j+k-1.0)) + 1.0/(b+j+k-1.0); - } - zp = pa + pb + 2.0*el + sp + sm + std::log(1.0 - z); - zr1 = zr1*(a+m+k-1.0)*(b+m+k-1.0) / static_cast(k*(m+k))*(1.0-z); - zf1 += zr1*zp; - if (std::abs(zf1-zw) < std::abs(zf1)*eps) { break; } - zw = zf1; + for (j = 1; j < abs(m); j++) { + gm *= j; } - zhf = zf0*zc0 + zf1*zc1; - } else if (m < 0) { - m = -m; - zc0 = gm*gc/(ga*gb*std::pow(1.0 - z, m)); - zc1 = -(pow(-1.0, m))*gc/(gam*gbm*rm); - for (k = 1; k < m; k++) { - zr0 = zr0*(a-m+k-1.0)*(b-m+k-1.0)/static_cast(k*(k-m))*(1.0-z); - zf0 += zr0; + rm = 1.0; + for (j = 1; j < abs(m) + 1; j++) { + rm *= j; } - for (k = 1; k < (m+1); k++) { - sp0 += 1.0 / k; + zf0 = 1.0; + zr0 = 1.0; + zr1 = 1.0; + sp0 = 0.0; + sp = 0.0; + if (m >= 0) { + zc0 = gm * gc / (gam * gbm); + zc1 = -gc * std::pow(z - 1.0, m) / (ga * gb * rm); + for (k = 1; k < m; k++) { + zr0 = zr0 * (a + k - 1.0) * (b + k - 1.0) / static_cast(k * (k - m)) * (1.0 - z); + zf0 += zr0; + } + for (k = 1; k < (m + 1); k++) { + sp0 += 1.0 / (a + k - 1.0) + 1.0 / (b + k - 1.0) - 1.0 / k; + } + zf1 = pa + pb + sp0 + 2.0 * el + std::log(1.0 - z); + zw = 0.0; + for (k = 1; k < 501; k++) { + sp += (1.0 - a) / (k * (a + k - 1.0)) + (1.0 - b) / (k * (b + k - 1.0)); + sm = 0.0; + for (j = 1; j < (m + 1); j++) { + sm += (1.0 - a) / ((j + k) * (a + j + k - 1.0)) + 1.0 / (b + j + k - 1.0); + } + zp = pa + pb + 2.0 * el + sp + sm + std::log(1.0 - z); + zr1 = zr1 * (a + m + k - 1.0) * (b + m + k - 1.0) / static_cast(k * (m + k)) * + (1.0 - z); + zf1 += zr1 * zp; + if (std::abs(zf1 - zw) < std::abs(zf1) * eps) { + break; + } + zw = zf1; + } + zhf = zf0 * zc0 + zf1 * zc1; + } else if (m < 0) { + m = -m; + zc0 = gm * gc / (ga * gb * std::pow(1.0 - z, m)); + zc1 = -(pow(-1.0, m)) * gc / (gam * gbm * rm); + for (k = 1; k < m; k++) { + zr0 = zr0 * (a - m + k - 1.0) * (b - m + k - 1.0) / static_cast(k * (k - m)) * + (1.0 - z); + zf0 += zr0; + } + for (k = 1; k < (m + 1); k++) { + sp0 += 1.0 / k; + } + zf1 = pa + pb - sp0 + 2.0 * el + std::log(1.0 - z); + zw = 0.0; + for (k = 1; k < 501; k++) { + sp += (1.0 - a) / (k * (a + k - 1.0)) + (1.0 - b) / (k * (b + k - 1.0)); + sm = 0.0; + for (j = 1; j < (m + 1); j++) { + sm += 1.0 / (j + k); + } + zp = pa + pb + 2.0 * el + sp - sm + std::log(1.0 - z); + zr1 = zr1 * (a + k - 1.0) * (b + k - 1.0) / static_cast(k * (m + k)) * (1.0 - z); + zf1 += zr1 * zp; + if (std::abs(zf1 - zw) < std::abs(zf1) * eps) { + break; + } + zw = zf1; + } + zhf = zf0 * zc0 + zf1 * zc1; } - zf1 = pa + pb -sp0 + 2.0*el + std::log(1.0 - z); + } else { + ga = gamma2(a); + gb = gamma2(b); + gc = gamma2(c); + gca = gamma2(c - a); + gcb = gamma2(c - b); + gcab = gamma2(c - a - b); + gabc = gamma2(a + b - c); + zc0 = gc * gcab / (gca * gcb); + zc1 = gc * gabc / (ga * gb) * std::pow(1.0 - z, c - a - b); + zhf = 0.0; + zr0 = zc0; + zr1 = zc1; zw = 0.0; - for (k = 1; k <501; k++) { - sp += (1.0-a)/(k*(a+k-1.0)) + (1.0-b)/(k*(b+k-1.0)); - sm = 0.0; - for (j = 1; j < (m+1); j++) { - sm += 1.0/(j+k); + for (k = 1; k < 501; k++) { + zr0 = zr0 * (a + k - 1.0) * (b + k - 1.0) / (k * (a + b - c + k)) * (1.0 - z); + zr1 = zr1 * (c - a + k - 1.0) * (c - b + k - 1.0) / (k * (c - a - b + k)) * (1.0 - z); + zhf += zr0 + zr1; + if (std::abs(zhf - zw) < std::abs(zhf) * eps) { + break; } - zp = pa + pb+2.0*el + sp - sm + std::log(1.0 -z ); - zr1 = zr1*(a+k-1.0)*(b+k-1.0)/static_cast(k*(m+k))*(1.0-z); - zf1 += zr1*zp; - if (std::abs(zf1-zw) < std::abs(zf1)*eps) { break; } - zw = zf1; + zw = zhf; } - zhf = zf0*zc0 + zf1*zc1; + zhf += zc0 + zc1; } } else { + z00 = 1.0; + if ((c - a < a) && (c - b < b)) { + z00 = std::pow(1.0 - z, c - a - b); + a = c - a; + b = c - b; + } + zhf = 1.0; + zr = 1.0; + zw = 0.0; + for (k = 1; k < 1501; k++) { + zr = zr * (a + k - 1.0) * (b + k - 1.0) / (k * (c + k - 1.0)) * z; + zhf += zr; + if (std::abs(zhf - zw) < std::abs(zhf) * eps) { + break; + } + zw = zhf; + } + zhf *= z00; + } + } else if (a0 > 1.0) { + mab = (int)(a - b + eps * copysign(1.0, a - b)); + if ((fabs(a - b - mab) < eps) && (a0 <= 1.1)) { + b += eps; + } + if (fabs(a - b - mab) > eps) { ga = gamma2(a); gb = gamma2(b); gc = gamma2(c); - gca = gamma2(c-a); - gcb = gamma2(c-b); - gcab = gamma2(c-a-b); - gabc = gamma2(a+b-c); - zc0 = gc*gcab/(gca*gcb); - zc1 = gc*gabc/(ga*gb)*std::pow(1.0-z, c-a-b); - zhf = 0.0; + gab = gamma2(a - b); + gba = gamma2(b - a); + gca = gamma2(c - a); + gcb = gamma2(c - b); + zc0 = gc * gba / (gca * gb * std::pow(-z, a)); + zc1 = gc * gab / (gcb * ga * std::pow(-z, b)); zr0 = zc0; zr1 = zc1; - zw = 0.0; + zhf = 0.0; for (k = 1; k < 501; k++) { - zr0 = zr0*(a+k-1.0)*(b+k-1.0)/(k*(a+b-c+k))*(1.0-z); - zr1 = zr1*(c-a+k-1.0)*(c-b+k-1.0)/(k*(c-a-b+k))*(1.0-z); - zhf += zr0+zr1; - if (std::abs(zhf-zw) < std::abs(zhf)*eps) { break; } + zr0 = zr0 * (a + k - 1.0) * (a - c + k) / ((a - b + k) * k * z); + zr1 = zr1 * (b + k - 1.0) * (b - c + k) / ((b - a + k) * k * z); + zhf += zr0 + zr1; + if (std::abs(zhf - zw) < std::abs(zhf) * eps) { + break; + } zw = zhf; } zhf += zc0 + zc1; + } else { + if (a - b < 0.0) { + a = bb; + b = aa; + } + ca = c - a; + cb = c - b; + nca = (int)(ca + eps * copysign(1.0, ca)); + ncb = (int)(cb + eps * copysign(1.0, cb)); + if ((fabs(ca - nca) < eps) || (fabs(cb - ncb) < eps)) { + c += eps; + } + ga = gamma2(a); + gc = gamma2(c); + gcb = gamma2(c - b); + pa = psi_spec(a); + pca = psi_spec(c - a); + pac = psi_spec(a - c); + mab = (int)(a - b + eps); + zc0 = gc / (ga * std::pow(-z, b)); + gm = gamma2(a - b); + zf0 = gm / gcb * zc0; + zr = zc0; + for (k = 1; k < mab; k++) { + zr = zr * (b + k - 1.0) / (static_cast(k) * z); + g0 = gamma2(a - b - k); + zf0 += zr * g0 / gamma2(c - b - k); + } + if (mab == 0) { + zf0 = 0.0; + } + zc1 = gc / (ga * gcb * std::pow(-z, a)); + sp = -2.0 * el - pa - pca; + for (j = 1; j < (mab + 1); j++) { + sp += 1.0 / j; + } + zp0 = sp + std::log(-z); + sq = 1.0; + for (j = 1; j < (mab + 1); j++) { + sq = sq * (b + j - 1.0) * (b - c + j) / j; + } + zf1 = (sq * zp0) * zc1; + zr = zc1; + rk1 = 1.0; + sj1 = 0.0; + w0 = 0.0; + for (k = 1; k < 10001; k++) { + zr /= z; + rk1 = rk1 * (b + k - 1.0) * (b - c + k) / (k * k); + rk2 = rk1; + for (j = k + 1; j <= (k + mab); j++) { + rk2 = rk2 * (b + j - 1.0) * (b - c + j) / j; + } + sj1 += (a - 1.0) / (k * (a + k - 1.0)) + (a - c - 1.0) / (k * (a - c + k - 1.0)); + sj2 = sj1; + for (j = k + 1; j <= (k + mab); j++) { + sj2 += 1.0 / j; + } + zp = -2.0 * el - pa - pac + sj2 - 1.0 / (k + a - c) - pi / tan(pi * (k + a - c)) + std::log(-z); + zf1 += rk2 * zr * zp; + ws = std::abs(zf1); + if (fabs((ws - w0) / ws) < eps) { + break; + } + w0 = ws; + } + zhf = zf0 + zf1; } - } else { - z00 = 1.0; - if ((c-a < a) && (c-b < b)) { - z00 = std::pow(1.0 - z, c-a-b); - a = c-a; - b = c-b; - } - zhf = 1.0; - zr = 1.0; - zw = 0.0; - for (k = 1; k < 1501; k++) { - zr = zr*(a+k-1.0)*(b+k-1.0)/(k*(c+k-1.0))*z; - zhf += zr; - if (std::abs(zhf-zw) < std::abs(zhf)*eps) { break; } - zw = zhf; - } - zhf *= z00; } - } else if (a0 > 1.0) { - mab = (int)(a - b + eps*copysign(1.0, a - b)); - if ((fabs(a-b-mab) < eps) && (a0 <= 1.1)) { b += eps; } - if (fabs(a-b-mab) > eps) { - ga = gamma2(a); - gb = gamma2(b); - gc = gamma2(c); - gab = gamma2(a-b); - gba = gamma2(b-a); - gca = gamma2(c-a); - gcb = gamma2(c-b); - zc0 = gc*gba/(gca*gb*std::pow(-z, a)); - zc1 = gc*gab/(gcb*ga*std::pow(-z, b)); - zr0 = zc0; - zr1 = zc1; - zhf = 0.0; - for (k = 1; k < 501; k++) { - zr0 = zr0*(a+k-1.0)*(a-c+k)/((a-b+k)*k*z); - zr1 = zr1*(b+k-1.0)*(b-c+k)/((b-a+k)*k*z); - zhf += zr0+zr1; - if (std::abs(zhf-zw) < std::abs(zhf)*eps) { break; } - zw = zhf; - } - zhf += zc0 + zc1; + a = aa; + b = bb; + if (k > 150) { + *isfer = 5; + } + return zhf; + } + + inline Status jdzo(int nt, double *zo, int *n, int *m, int *p) { + + // =========================================================== + // Purpose: Compute the zeros of Bessel functions Jn(x) and + // Jn'(x), and arrange them in the order of their + // magnitudes + // Input : NT --- Number of total zeros ( NT ≤ 1200 ) + // Output: ZO(L) --- Value of the L-th zero of Jn(x) + // and Jn'(x) + // N(L) --- n, order of Jn(x) or Jn'(x) associated + // with the L-th zero + // M(L) --- m, serial number of the zeros of Jn(x) + // or Jn'(x) associated with the L-th zero + // ( L is the serial number of all the + // zeros of Jn(x) and Jn'(x) ) + // P(L) --- 0 (TM) or 1 (TE), a code for designating the + // zeros of Jn(x) or Jn'(x). + // In the waveguide applications, the zeros + // of Jn(x) correspond to TM modes and + // those of Jn'(x) correspond to TE modes + // Return value: + // Status::OK + // Normal return. + // Status::NoMemory + // An internal memory allocation failed. + // + // Routine called: BJNDD for computing Jn(x), Jn'(x) and + // Jn''(x) + // ============================================================= + + int i, j, k, L, L0, L1, L2, mm, nm; + double x, x0, x1, x2, xm; + + auto p1 = std::unique_ptr{new (std::nothrow) int[70]()}; + + // Compared to specfun.f we use a single array instead of separate + // three arrays and use pointer arithmetic to access. Their usage + // is pretty much one-shot hence does not complicate the code. + + // Note: ZO and ZOC arrays are 0-indexed in specfun.f + + // m1, n1, zoc -> 70 + 70 + 71 + auto mnzoc = std::unique_ptr{new (std::nothrow) double[211]()}; + + // bj, dj, fj -> 101 + 101 + 101 + auto bdfj = std::unique_ptr{new (std::nothrow) double[303]()}; + + if (p1.get() == nullptr || mnzoc.get() == nullptr || bdfj.get() == nullptr) { + return Status::NoMemory; + } + + x = 0; + + if (nt < 600) { + xm = -1.0 + 2.248485 * sqrt(nt) - 0.0159382 * nt + 3.208775e-4 * pow(nt, 1.5); + nm = (int)(14.5 + 0.05875 * nt); + mm = (int)(0.02 * nt) + 6; } else { - if (a-b < 0.0) { - a = bb; - b = aa; - } - ca = c - a; - cb = c - b; - nca = (int)(ca + eps*copysign(1.0, ca)); - ncb = (int)(cb + eps*copysign(1.0, cb)); - if ((fabs(ca-nca) < eps) || (fabs(cb-ncb) < eps)) { c += eps; } - ga = gamma2(a); - gc = gamma2(c); - gcb = gamma2(c-b); - pa = psi_spec(a); - pca = psi_spec(c-a); - pac = psi_spec(a-c); - mab = (int)(a-b+eps); - zc0 = gc / (ga*std::pow(-z, b)); - gm = gamma2(a-b); - zf0 = gm/gcb*zc0; - zr = zc0; - for (k = 1; k < mab; k++) { - zr = zr*(b+k-1.0)/(static_cast(k)*z); - g0 = gamma2(a-b-k); - zf0 += zr*g0/gamma2(c-b-k); - } - if (mab == 0) { zf0 = 0.0; } - zc1 = gc/(ga*gcb*std::pow(-z, a)); - sp = -2.0*el - pa- pca; - for (j = 1; j < (mab+1); j++) { - sp += 1.0 / j; - } - zp0 = sp + std::log(-z); - sq = 1.0; - for (j = 1; j < (mab+1); j++) { - sq = sq * (b+j-1.0)*(b-c+j)/j; - } - zf1 = (sq*zp0)*zc1; - zr = zc1; - rk1 = 1.0; - sj1 = 0.0; - w0 = 0.0; - for (k = 1; k < 10001; k++) { - zr /= z; - rk1 = rk1*(b+k-1.0)*(b-c+k)/(k*k); - rk2 = rk1; - for (j = k+1; j <= (k+mab); j++) { - rk2 = rk2 * (b+j-1.0)*(b-c+j)/j; + xm = 5.0 + 1.445389 * sqrt(nt) + 0.01889876 * nt - 2.147763e-4 * pow(nt, 1.5); + nm = (int)(27.8 + 0.0327 * nt); + mm = (int)(0.01088 * nt) + 10; + } + + L0 = 0; + /* 45 LOOP */ + for (i = 1; i < (nm + 1); i++) { + x1 = 0.407658 + 0.4795504 * sqrt(i - 1.0) + 0.983618 * (i - 1); + x2 = 1.99535 + 0.8333883 * sqrt(i - 1.0) + 0.984584 * (i - 1); + L1 = 0; + + /* 30 LOOP */ + for (j = 1; j < (mm + 1); j++) { + if ((i != 1) || (j != 1)) { + x = x1; + do { + bjndd(x, i, &bdfj[0], &bdfj[101], &bdfj[202]); + x0 = x; + x -= bdfj[100 + i] / bdfj[201 + i]; + if (x1 > xm) { + goto L20; + } + } while (fabs(x - x0) > 1e-10); + } + /* 15 */ + L1 += 1; + mnzoc[69 + L1] = i - 1; /* N[L1] */ + mnzoc[L1 - 1] = j; /* M[L1] */ + if (i == 1) { + mnzoc[L1 - 1] = j - 1; + } + p1[L1 - 1] = 1; + mnzoc[140 + L1] = x; /* ZOC[L1] */ + if (i <= 15) { + x1 = x + 3.057 + 0.0122 * (i - 1) + (1.555 + 0.41575 * (i - 1)) / pow(j + 1, 2.0); + } else { + x1 = x + 2.918 + 0.01924 * (i - 1) + (6.26 + 0.13205 * (i - 1)) / pow(j + 1, 2.0); } - sj1 += (a-1.0)/(k*(a+k-1.0)) + (a-c-1.0)/(k*(a-c+k-1.0)); - sj2 = sj1; - for (j = k+1; j <= (k+mab); j++) { - sj2 += 1.0 / j; + L20: + x = x2; + do { + bjndd(x, i, &bdfj[0], &bdfj[101], &bdfj[202]); + x0 = x; + x -= bdfj[i - 1] / bdfj[100 + i]; + if (x > xm) { + goto L30; + } /* Need to "continue;" twice hence goto is simpler */ + } while (fabs(x - x0) > 1e-10); + L1 += 1; + mnzoc[69 + L1] = i - 1; + mnzoc[L1 - 1] = j; + p1[L1 - 1] = 0; + mnzoc[140 + L1] = x; + if (i <= 15) { + x2 = x + 3.11 + 0.0138 * (i - 1) + (0.04832 + 0.2804 * (i - 1)) / pow(j + 1, 2); + } else { + x2 = x + 3.001 + 0.0105 * (i - 1) + (11.52 + 0.48525 * (i - 1)) / pow(j + 3, 2); } - zp= -2.0*el -pa - pac + sj2 - 1.0/(k+a-c) - pi/tan(pi*(k+a-c)) + std::log(-z); - zf1 += rk2*zr*zp; - ws = std::abs(zf1); - if (fabs((ws-w0)/ws) < eps) { break; } - w0 = ws; + L30:; /* Do nothing line to silence compiler */ } - zhf = zf0 + zf1; + L = L0 + L1; + L2 = L; + do { + if (L0 == 0) { + for (k = 1; k < (L + 1); k++) { + p[k - 1] = p1[k - 1]; + m[k - 1] = mnzoc[k - 1]; /* m[k-1] = mnzoc[k-1] */ + n[k - 1] = mnzoc[69 + k]; /* n[k-1] = mnzoc[70 + (k-1)] */ + zo[k] = mnzoc[140 + k]; + } + L1 = 0; + } else if (L0 != 0) { + if (zo[L0] >= mnzoc[140 + L1]) { + p[L0 + L1 - 1] = p[L0 - 1]; + m[L0 + L1 - 1] = m[L0 - 1]; + n[L0 + L1 - 1] = n[L0 - 1]; + zo[L0 + L1] = zo[L0]; + L0 -= 1; + } else { + p[L0 + L1 - 1] = p1[L1 - 1]; + m[L0 + L1 - 1] = mnzoc[L1 - 1]; + n[L0 + L1 - 1] = mnzoc[69 + L1]; + zo[L0 + L1] = mnzoc[140 + L1]; + L1 -= 1; + } + } + } while (L1 != 0); + /* 45 */ + L0 = L2; } + return Status::OK; } - a = aa; - b = bb; - if (k > 150) { *isfer = 5; } - return zhf; -} - -inline Status jdzo(int nt, double *zo, int *n, int *m, int *p) { - - // =========================================================== - // Purpose: Compute the zeros of Bessel functions Jn(x) and - // Jn'(x), and arrange them in the order of their - // magnitudes - // Input : NT --- Number of total zeros ( NT ≤ 1200 ) - // Output: ZO(L) --- Value of the L-th zero of Jn(x) - // and Jn'(x) - // N(L) --- n, order of Jn(x) or Jn'(x) associated - // with the L-th zero - // M(L) --- m, serial number of the zeros of Jn(x) - // or Jn'(x) associated with the L-th zero - // ( L is the serial number of all the - // zeros of Jn(x) and Jn'(x) ) - // P(L) --- 0 (TM) or 1 (TE), a code for designating the - // zeros of Jn(x) or Jn'(x). - // In the waveguide applications, the zeros - // of Jn(x) correspond to TM modes and - // those of Jn'(x) correspond to TE modes - // Return value: - // Status::OK - // Normal return. - // Status::NoMemory - // An internal memory allocation failed. - // - // Routine called: BJNDD for computing Jn(x), Jn'(x) and - // Jn''(x) - // ============================================================= - - int i, j, k, L, L0, L1, L2, mm, nm; - double x, x0, x1, x2, xm; - - auto p1 = std::unique_ptr{new (std::nothrow) int[70]()}; - - // Compared to specfun.f we use a single array instead of separate - // three arrays and use pointer arithmetic to access. Their usage - // is pretty much one-shot hence does not complicate the code. - - // Note: ZO and ZOC arrays are 0-indexed in specfun.f - - // m1, n1, zoc -> 70 + 70 + 71 - auto mnzoc = std::unique_ptr{new (std::nothrow) double[211]()}; - - // bj, dj, fj -> 101 + 101 + 101 - auto bdfj = std::unique_ptr{new (std::nothrow) double[303]()}; - - if (p1.get() == nullptr || mnzoc.get() == nullptr || bdfj.get() == nullptr) { - return Status::NoMemory; + + template + void jynb(int n, T x, int *nm, T *bj, T *dj, T *by, T *dy) { + + // ===================================================== + // Purpose: Compute Bessel functions Jn(x), Yn(x) and + // their derivatives + // Input : x --- Argument of Jn(x) and Yn(x) ( x ≥ 0 ) + // n --- Order of Jn(x) and Yn(x) + // Output: BJ(n) --- Jn(x) + // DJ(n) --- Jn'(x) + // BY(n) --- Yn(x) + // DY(n) --- Yn'(x) + // NM --- Highest order computed + // Routines called: + // JYNBH to calculate the Jn and Yn + // ===================================================== + + int k; + jynbh(n, 0, x, nm, bj, by); + // Compute derivatives by differentiation formulas + if (x < 1.0e-100) { + for (k = 0; k <= n; k++) { + dj[k] = 0.0; + dy[k] = 1.0e+300; + } + dj[1] = 0.5; + } else { + dj[0] = -bj[1]; + for (k = 1; k <= *nm; k++) { + dj[k] = bj[k - 1] - k / x * bj[k]; + } + + dy[0] = -by[1]; + for (k = 1; k <= *nm; k++) { + dy[k] = by[k - 1] - k * by[k] / x; + } + } + return; } - x = 0; + template + void jynbh(int n, int nmin, T x, int *nm, T *bj, T *by) { + + // ===================================================== + // Purpose: Compute Bessel functions Jn(x), Yn(x) + // Input : x --- Argument of Jn(x) and Yn(x) ( x ≥ 0 ) + // n --- Highest order of Jn(x) and Yn(x) computed ( n ≥ 0 ) + // nmin -- Lowest order computed ( nmin ≥ 0 ) + // Output: BJ(n-NMIN) --- Jn(x) ; if indexing starts at 0 + // BY(n-NMIN) --- Yn(x) ; if indexing starts at 0 + // NM --- Highest order computed + // Routines called: + // MSTA1 and MSTA2 to calculate the starting + // point for backward recurrence + // ===================================================== + + int k, m, ky; + T pi = 3.141592653589793; + T r2p = 0.63661977236758; + T bs, s0, su, sv, f2, f1, f; + T bj0, bj1, ec, by0, by1, bjk, byk; + T p0, q0, cu, t1, p1, q1, t2; + + T a[4] = {-0.0703125, 0.112152099609375, -0.5725014209747314, 0.6074042001273483e+01}; + T b[4] = {0.0732421875, -0.2271080017089844, 0.1727727502584457e+01, -0.2438052969955606e+02}; + T a1[4] = {0.1171875, -0.144195556640625, 0.6765925884246826, -0.6883914268109947e+01}; + T b1[4] = {-0.1025390625, 0.2775764465332031, -0.1993531733751297e+01, 0.2724882731126854e+02}; + + *nm = n; + if (x < 1.0e-100) { + for (k = nmin; k <= n; k++) { + bj[k - nmin] = 0.0; + by[k - nmin] = -1.0e+300; + } + + if (nmin == 0) { + bj[0] = 1.0; + } + return; + } + + if ((x <= 300.0) || (n > (int)(0.9 * x))) { + // Backward recurrence for Jn + if (n == 0) { + *nm = 1; + } + m = msta1(x, 200); + if (m < *nm) { + *nm = m; + } else { + m = msta2(x, *nm, 15); + } + bs = 0.0; + su = 0.0; + sv = 0.0; + f2 = 0.0; + f1 = 1.0e-100; + f = 0.0; + + for (k = m; k >= 0; k--) { + f = 2.0 * (k + 1.0) / x * f1 - f2; + if ((k <= *nm) && (k >= nmin)) { + bj[k - nmin] = f; + } + if (k == 2 * (int)(k / 2) && k != 0) { + bs += 2.0 * f; + su += pow(-1, k / 2) * f / k; + } else if (k > 1) { + sv += pow(-1, k / 2) * k / (k * k - 1.0) * f; + } + f2 = f1; + f1 = f; + } + s0 = bs + f; + + for (k = nmin; k <= *nm; k++) { + bj[k - nmin] /= s0; + } + // Estimates for Yn at start of recurrence + bj0 = f1 / s0; + bj1 = f2 / s0; + ec = log(x / 2.0) + 0.5772156649015329; + by0 = r2p * (ec * bj0 - 4.0 * su / s0); + by1 = r2p * ((ec - 1.0) * bj1 - bj0 / x - 4.0 * sv / s0); + + if (0 >= nmin) { + by[0 - nmin] = by0; + } + if (1 >= nmin) { + by[1 - nmin] = by1; + } + ky = 2; + } else { + // Hankel expansion + t1 = x - 0.25 * pi; + p0 = 1.0; + q0 = -0.125 / x; + + for (k = 1; k <= 4; k++) { + p0 += a[k - 1] * pow(x, -2 * k); + q0 += b[k - 1] * pow(x, -2 * k - 1); + } + + cu = sqrt(r2p / x); + bj0 = cu * (p0 * cos(t1) - q0 * sin(t1)); + by0 = cu * (p0 * sin(t1) + q0 * cos(t1)); + + if (0 >= nmin) { + bj[0 - nmin] = bj0; + by[0 - nmin] = by0; + } + + t2 = x - 0.75 * pi; + p1 = 1.0; + q1 = 0.375 / x; + + for (k = 1; k <= 4; k++) { + p1 += a1[k - 1] * pow(x, -2 * k); + q1 += b1[k - 1] * pow(x, -2 * k - 1); + } - if (nt < 600) { - xm = -1.0 + 2.248485*sqrt(nt) - 0.0159382*nt + 3.208775e-4*pow(nt, 1.5); - nm = (int)(14.5 + 0.05875*nt); - mm = (int)(0.02*nt) + 6; - } else { - xm = 5.0 + 1.445389*sqrt(nt) + 0.01889876*nt - 2.147763e-4*pow(nt, 1.5); - nm = (int)(27.8 + 0.0327*nt); - mm = (int)(0.01088*nt) + 10; - } + bj1 = cu * (p1 * cos(t2) - q1 * sin(t2)); + by1 = cu * (p1 * sin(t2) + q1 * cos(t2)); - L0 = 0; - /* 45 LOOP */ - for (i = 1; i < (nm+1); i++) { - x1 = 0.407658 + 0.4795504*sqrt(i-1.0) + 0.983618*(i-1); - x2 = 1.99535 + 0.8333883*sqrt(i-1.0) + 0.984584*(i-1); - L1 = 0; - - /* 30 LOOP */ - for (j = 1; j < (mm+1); j++) { - if ((i != 1) || (j != 1)) { - x = x1; - do - { - bjndd(x, i, &bdfj[0], &bdfj[101], &bdfj[202]); - x0 = x; - x -= bdfj[100+i]/bdfj[201+i]; - if (x1 > xm) { goto L20; } - } while (fabs(x-x0) > 1e-10); - } - /* 15 */ - L1 += 1; - mnzoc[69 + L1] = i-1; /* N[L1] */ - mnzoc[L1-1] = j; /* M[L1] */ - if (i == 1) { mnzoc[L1 - 1] = j-1; } - p1[L1-1] = 1; - mnzoc[140+L1] = x; /* ZOC[L1] */ - if (i <= 15) { - x1 = x + 3.057 + 0.0122*(i-1) + (1.555 + 0.41575*(i-1))/pow(j+1, 2.0); - } else { - x1 = x + 2.918 + 0.01924*(i-1) + (6.26 + 0.13205*(i-1))/pow(j+1, 2.0); + if (1 >= nmin) { + bj[1 - nmin] = bj1; + by[1 - nmin] = by1; } -L20: - x = x2; - do { - bjndd(x, i, &bdfj[0], &bdfj[101], &bdfj[202]); - x0 = x; - x -= bdfj[i-1]/bdfj[100+i]; - if (x > xm) { goto L30; } /* Need to "continue;" twice hence goto is simpler */ - } while (fabs(x-x0) > 1e-10); - L1 += 1; - mnzoc[69 + L1] = i-1; - mnzoc[L1-1] = j; - p1[L1-1] = 0; - mnzoc[140+L1] = x; - if (i <= 15) { - x2 = x + 3.11 + 0.0138*(i-1) + (0.04832 + 0.2804*(i-1))/pow(j+1, 2); - } else { - x2 = x + 3.001 + 0.0105*(i-1) + (11.52 + 0.48525*(i-1))/pow(j+3, 2); - } -L30: - ; /* Do nothing line to silence compiler */ - } - L = L0 + L1; - L2 = L; - do { - if (L0 == 0) { - for (k = 1; k < (L+1); k++) { - p[k-1] = p1[k-1]; - m[k-1] = mnzoc[k-1]; /* m[k-1] = mnzoc[k-1] */ - n[k-1] = mnzoc[69+k]; /* n[k-1] = mnzoc[70 + (k-1)] */ - zo[k] = mnzoc[140+k]; - } - L1 = 0; - } else if (L0 != 0) { - if (zo[L0] >= mnzoc[140+L1]) { - p[L0+L1-1] = p[L0-1]; - m[L0+L1-1] = m[L0-1]; - n[L0+L1-1] = n[L0-1]; - zo[L0+L1] = zo[L0]; - L0 -= 1; - } else { - p[L0+L1-1] = p1[L1-1]; - m[L0+L1-1] = mnzoc[L1-1]; - n[L0+L1-1] = mnzoc[69+L1]; - zo[L0+L1] = mnzoc[140+L1]; - L1 -= 1; + + for (k = 2; k <= *nm; k++) { + bjk = 2.0 * (k - 1.0) / x * bj1 - bj0; + if (k >= nmin) { + bj[k - nmin] = bjk; } + bj0 = bj1; + bj1 = bjk; } - } while (L1 != 0); - /* 45 */ - L0 = L2; - } - return Status::OK; -} - - -template -void jynb(int n, T x, int *nm, T *bj, T *dj, T *by, T *dy) { - - // ===================================================== - // Purpose: Compute Bessel functions Jn(x), Yn(x) and - // their derivatives - // Input : x --- Argument of Jn(x) and Yn(x) ( x ≥ 0 ) - // n --- Order of Jn(x) and Yn(x) - // Output: BJ(n) --- Jn(x) - // DJ(n) --- Jn'(x) - // BY(n) --- Yn(x) - // DY(n) --- Yn'(x) - // NM --- Highest order computed - // Routines called: - // JYNBH to calculate the Jn and Yn - // ===================================================== - - int k; - jynbh(n, 0, x, nm, bj, by); - // Compute derivatives by differentiation formulas - if (x < 1.0e-100) { - for (k = 0; k <= n; k++) { - dj[k] = 0.0; - dy[k] = 1.0e+300; - } - dj[1] = 0.5; - } else { - dj[0] = -bj[1]; - for (k = 1; k <= *nm; k++) { - dj[k] = bj[k - 1] - k / x * bj[k]; - } - - dy[0] = -by[1]; - for (k = 1; k <= *nm; k++) { - dy[k] = by[k - 1] - k * by[k] / x; - } - } - return; -} - - -template -void jynbh(int n, int nmin, T x, int *nm, T *bj, T *by) { - - // ===================================================== - // Purpose: Compute Bessel functions Jn(x), Yn(x) - // Input : x --- Argument of Jn(x) and Yn(x) ( x ≥ 0 ) - // n --- Highest order of Jn(x) and Yn(x) computed ( n ≥ 0 ) - // nmin -- Lowest order computed ( nmin ≥ 0 ) - // Output: BJ(n-NMIN) --- Jn(x) ; if indexing starts at 0 - // BY(n-NMIN) --- Yn(x) ; if indexing starts at 0 - // NM --- Highest order computed - // Routines called: - // MSTA1 and MSTA2 to calculate the starting - // point for backward recurrence - // ===================================================== - - int k, m, ky; - T pi = 3.141592653589793; - T r2p = 0.63661977236758; - T bs, s0, su, sv, f2, f1, f; - T bj0, bj1, ec, by0, by1, bjk, byk; - T p0, q0, cu, t1, p1, q1, t2; - - T a[4] = { -0.0703125, 0.112152099609375, -0.5725014209747314, 0.6074042001273483e+01 }; - T b[4] = { 0.0732421875, -0.2271080017089844, 0.1727727502584457e+01, -0.2438052969955606e+02 }; - T a1[4] = { 0.1171875, -0.144195556640625, 0.6765925884246826, -0.6883914268109947e+01 }; - T b1[4] = { -0.1025390625, 0.2775764465332031, -0.1993531733751297e+01, 0.2724882731126854e+02 }; - - *nm = n; - if (x < 1.0e-100) { - for (k = nmin; k <= n; k++) { - bj[k - nmin] = 0.0; - by[k - nmin] = -1.0e+300; - } - - if (nmin == 0) { bj[0] = 1.0; } + ky = 2; + } + // Forward recurrence for Yn + for (k = ky; k <= *nm; k++) { + byk = 2.0 * (k - 1.0) * by1 / x - by0; + + if (k >= nmin) + by[k - nmin] = byk; + + by0 = by1; + by1 = byk; + } + } + + inline void jyndd(int n, double x, double *bjn, double *djn, double *fjn, double *byn, double *dyn, double *fyn) { + + // =========================================================== + // purpose: compute bessel functions jn(x) and yn(x), and + // their first and second derivatives + // input: x --- argument of jn(x) and yn(x) ( x > 0 ) + // n --- order of jn(x) and yn(x) + // output: bjn --- jn(x) + // djn --- jn'(x) + // fjn --- jn"(x) + // byn --- yn(x) + // dyn --- yn'(x) + // fyn --- yn"(x) + // routines called: + // jynbh to compute jn and yn + // =========================================================== + + int nm = 0; + double bj[2], by[2]; + + jynbh(n + 1, n, x, &nm, bj, by); + // compute derivatives by differentiation formulas + *bjn = bj[0]; + *byn = by[0]; + *djn = -bj[1] + n * bj[0] / x; + *dyn = -by[1] + n * by[0] / x; + *fjn = (n * n / (x * x) - 1.0) * (*bjn) - (*djn) / x; + *fyn = (n * n / (x * x) - 1.0) * (*byn) - (*dyn) / x; return; } - if ((x <= 300.0) || (n > (int)(0.9 * x))) { - // Backward recurrence for Jn + inline void jyzo(int n, int nt, double *rj0, double *rj1, double *ry0, double *ry1) { + + // ====================================================== + // Purpose: Compute the zeros of Bessel functions Jn(x), + // Yn(x), and their derivatives + // Input : n --- Order of Bessel functions (n >= 0) + // NT --- Number of zeros (roots) + // Output: RJ0(L) --- L-th zero of Jn(x), L=1,2,...,NT + // RJ1(L) --- L-th zero of Jn'(x), L=1,2,...,NT + // RY0(L) --- L-th zero of Yn(x), L=1,2,...,NT + // RY1(L) --- L-th zero of Yn'(x), L=1,2,...,NT + // Routine called: JYNDD for computing Jn(x), Yn(x), and + // their first and second derivatives + // ====================================================== + + /* + * SciPy Note: + * See GH-18859 for additional changes done by SciPy for + * better initial condition selection in Newton iteration + */ + + int L; + double b, h, x, x0, bjn, djn, fjn, byn, dyn, fyn; + const double pi = 3.141592653589793; + // -- Newton method for j_{N,L} + // initial guess for j_{N,1} if (n == 0) { - *nm = 1; - } - m = msta1(x, 200); - if (m < *nm) { - *nm = m; + x = 2.4; } else { - m = msta2(x, *nm, 15); + // https://dlmf.nist.gov/10.21#E40 + x = n + 1.85576 * pow(n, 0.33333) + 1.03315 / pow(n, 0.33333); + } + // iterate + L = 0; + L10: + x0 = x; + jyndd(n, x, &bjn, &djn, &fjn, &byn, &dyn, &fyn); + x -= bjn / djn; + if (fabs(x - x0) > 1e-11) { + goto L10; } - bs = 0.0; - su = 0.0; - sv = 0.0; - f2 = 0.0; - f1 = 1.0e-100; - f = 0.0; - for (k = m; k >= 0; k--) { - f = 2.0*(k + 1.0)/x*f1 - f2; - if ((k <= *nm) && (k >= nmin)) { - bj[k - nmin] = f; - } - if (k == 2 * (int)(k / 2) && k != 0) { - bs += 2.0 * f; - su += pow(-1, k / 2) * f / k; - } else if (k > 1) { - sv += pow(-1, k / 2) * k / (k * k - 1.0) * f; + L += 1; + rj0[L - 1] = x; + // initial guess for j_{N,L+1} + if (L == 1) { + if (n == 0) { + x = 5.52; + } else { + // Expansion from https://dlmf.nist.gov/10.21#E32 and + // coefficients from Olver 1951 + x = n + 3.24460 * pow(n, 0.33333) + 3.15824 / pow(n, 0.33333); } - f2 = f1; - f1 = f; + } else { + // growth of roots is approximately linear (https://dlmf.nist.gov/10.21#E19) + x = rj0[L - 1] + (rj0[L - 1] - rj0[L - 2]); } - s0 = bs + f; - - for (k = nmin; k <= *nm; k++) { - bj[k - nmin] /= s0; + if (L <= (n + 10)) { + jyndd(n, x, &bjn, &djn, &fjn, &byn, &dyn, &fyn); + h = atan(fabs(djn) / sqrt(fabs(fjn * bjn))); + b = -djn / (bjn * atan(h)); + x -= (h - pi / 2) / b; } - // Estimates for Yn at start of recurrence - bj0 = f1 / s0; - bj1 = f2 / s0; - ec = log(x / 2.0) + 0.5772156649015329; - by0 = r2p * (ec * bj0 - 4.0*su/s0); - by1 = r2p * ((ec - 1.0)*bj1 - bj0/x - 4.0*sv/s0); - if (0 >= nmin) { by[0 - nmin] = by0; } - if (1 >= nmin) { by[1 - nmin] = by1; } - ky = 2; - } else { - // Hankel expansion - t1 = x - 0.25*pi; - p0 = 1.0; - q0 = -0.125/x; - - for (k = 1; k <= 4; k++) { - p0 += a[k - 1] * pow(x,-2*k); - q0 += b[k - 1] * pow(x, -2*k - 1); + if (L < nt) { + goto L10; } - cu = sqrt(r2p / x); - bj0 = cu * (p0*cos(t1) - q0*sin(t1)); - by0 = cu * (p0*sin(t1) + q0*cos(t1)); - - if (0 >= nmin) { - bj[0 - nmin] = bj0; - by[0 - nmin] = by0; + // -- Newton method for j_{N,L+1}' + if (n == 0) { + x = 3.8317; + } else { + // https://dlmf.nist.gov/10.21#E40 + x = n + 0.80861 * pow(n, 0.33333) + 0.07249 / pow(n, 0.33333); } - - t2 = x - 0.75*pi; - p1 = 1.0; - q1 = 0.375/x; - - for (k = 1; k <= 4; k++) { - p1 += a1[k - 1] * pow(x, -2*k); - q1 += b1[k - 1] * pow(x, -2*k - 1); + // iterate + L = 0; + L15: + x0 = x; + jyndd(n, x, &bjn, &djn, &fjn, &byn, &dyn, &fyn); + x -= djn / fjn; + if (fabs(x - x0) > 1e-11) + goto L15; + L += 1; + rj1[L - 1] = x; + if (L < nt) { + // https://dlmf.nist.gov/10.21#E20 + x = rj1[L - 1] + (rj0[L] - rj0[L - 1]); + goto L15; + } + + // -- Newton method for y_{N,L} + // initial guess for y_{N,1} + if (n == 0) { + x = 0.89357697; + } else { + // https://dlmf.nist.gov/10.21#E40 + x = n + 0.93158 * pow(n, 0.33333) + 0.26035 / pow(n, 0.33333); } - - bj1 = cu * (p1*cos(t2) - q1*sin(t2)); - by1 = cu * (p1*sin(t2) + q1*cos(t2)); - - if (1 >= nmin) { - bj[1 - nmin] = bj1; - by[1 - nmin] = by1; + // iterate + L = 0; + L20: + x0 = x; + jyndd(n, x, &bjn, &djn, &fjn, &byn, &dyn, &fyn); + x -= byn / dyn; + if (fabs(x - x0) > 1.0e-11) + goto L20; + L += 1; + ry0[L - 1] = x; + // initial guess for y_{N,L+1} + if (L == 1) { + if (n == 0) { + x = 3.957678419314858; + } else { + // Expansion from https://dlmf.nist.gov/10.21#E33 and + // coefficients from Olver 1951 + x = n + 2.59626 * pow(n, 0.33333) + 2.022183 / pow(n, 0.33333); + } + } else { + // growth of roots is approximately linear (https://dlmf.nist.gov/10.21#E19) + x = ry0[L - 1] + (ry0[L - 1] - ry0[L - 2]); } - - for (k = 2; k <= *nm; k++) { - bjk = 2.0*(k - 1.0)/x*bj1 - bj0; - if (k >= nmin) { bj[k - nmin] = bjk; } - bj0 = bj1; - bj1 = bjk; + if (L <= n + 10) { + jyndd(n, x, &bjn, &djn, &fjn, &byn, &dyn, &fyn); + h = atan(fabs(dyn) / sqrt(fabs(fyn * byn))); + b = -dyn / (byn * tan(h)); + x -= (h - pi / 2) / b; } - ky = 2; - } - // Forward recurrence for Yn - for (k = ky; k <= *nm; k++) { - byk = 2.0 * (k - 1.0) * by1 / x - by0; - if (k >= nmin) - by[k - nmin] = byk; + if (L < nt) + goto L20; - by0 = by1; - by1 = byk; - } -} - - -inline void jyndd(int n, double x, double *bjn, double *djn, double *fjn, double *byn, double *dyn, double *fyn) { - - // =========================================================== - // purpose: compute bessel functions jn(x) and yn(x), and - // their first and second derivatives - // input: x --- argument of jn(x) and yn(x) ( x > 0 ) - // n --- order of jn(x) and yn(x) - // output: bjn --- jn(x) - // djn --- jn'(x) - // fjn --- jn"(x) - // byn --- yn(x) - // dyn --- yn'(x) - // fyn --- yn"(x) - // routines called: - // jynbh to compute jn and yn - // =========================================================== - - int nm = 0; - double bj[2], by[2]; - - jynbh(n+1, n, x, &nm, bj, by); - // compute derivatives by differentiation formulas - *bjn = bj[0]; - *byn = by[0]; - *djn = -bj[1] + n*bj[0]/x; - *dyn = -by[1] + n*by[0]/x; - *fjn = (n*n/(x*x) - 1.0)*(*bjn) - (*djn)/x; - *fyn = (n*n/(x*x) - 1.0)*(*byn) - (*dyn)/x; - return; -} - - -inline void jyzo(int n, int nt, double *rj0, double *rj1, double *ry0, double *ry1) { - - // ====================================================== - // Purpose: Compute the zeros of Bessel functions Jn(x), - // Yn(x), and their derivatives - // Input : n --- Order of Bessel functions (n >= 0) - // NT --- Number of zeros (roots) - // Output: RJ0(L) --- L-th zero of Jn(x), L=1,2,...,NT - // RJ1(L) --- L-th zero of Jn'(x), L=1,2,...,NT - // RY0(L) --- L-th zero of Yn(x), L=1,2,...,NT - // RY1(L) --- L-th zero of Yn'(x), L=1,2,...,NT - // Routine called: JYNDD for computing Jn(x), Yn(x), and - // their first and second derivatives - // ====================================================== - - /* - * SciPy Note: - * See GH-18859 for additional changes done by SciPy for - * better initial condition selection in Newton iteration - */ - - int L; - double b, h, x, x0, bjn, djn, fjn, byn, dyn, fyn; - const double pi = 3.141592653589793; - // -- Newton method for j_{N,L} - // initial guess for j_{N,1} - if (n == 0) { - x = 2.4; - } else { - // https://dlmf.nist.gov/10.21#E40 - x = n + 1.85576*pow(n, 0.33333) + 1.03315/ pow(n, 0.33333); - } - // iterate - L = 0; -L10: - x0 = x; - jyndd(n, x, &bjn, &djn, &fjn, &byn, &dyn, &fyn); - x -= bjn/djn; - if (fabs(x - x0) > 1e-11) { goto L10; } - - L += 1; - rj0[L - 1] = x; - // initial guess for j_{N,L+1} - if (L == 1) { + // -- Newton method for y_{N,L+1}' if (n == 0) { - x = 5.52; + x = 2.67257; } else { - // Expansion from https://dlmf.nist.gov/10.21#E32 and - // coefficients from Olver 1951 - x= n + 3.24460 * pow(n, 0.33333) + 3.15824 / pow(n, 0.33333); + // https://dlmf.nist.gov/10.21#E40 + x = n + 1.8211 * pow(n, 0.33333) + 0.94001 / pow(n, 0.33333); } - } else { - // growth of roots is approximately linear (https://dlmf.nist.gov/10.21#E19) - x = rj0[L - 1] + (rj0[L - 1] - rj0[L - 2]); - } - if (L <= (n + 10)) { + // iterate + L = 0; + L25: + x0 = x; jyndd(n, x, &bjn, &djn, &fjn, &byn, &dyn, &fyn); - h = atan(fabs(djn) / sqrt(fabs(fjn * bjn))); - b = -djn / (bjn * atan(h)); - x -= (h - pi/2) / b; + x -= dyn / fyn; + if (fabs(x - x0) > 1.0e-11) + goto L25; + L += 1; + ry1[L - 1] = x; + if (L < nt) { + // https://dlmf.nist.gov/10.21#E20 + x = ry1[L - 1] + (ry0[L] - ry0[L - 1]); + goto L25; + } + return; } - if (L < nt) { goto L10; } + template + inline Status kmn(int m, int n, T c, T cv, int kd, T *df, T *dn, T *ck1, T *ck2) { - // -- Newton method for j_{N,L+1}' - if (n == 0) { - x = 3.8317; - } else { - // https://dlmf.nist.gov/10.21#E40 - x = n + 0.80861 * pow(n, 0.33333) + 0.07249 / pow(n, 0.33333); - } - // iterate - L=0; -L15: - x0 = x; - jyndd(n, x, &bjn, &djn, &fjn, &byn, &dyn, &fyn); - x -= djn/fjn; - if (fabs(x-x0) > 1e-11) goto L15; - L += 1; - rj1[L - 1] = x; - if (L < nt) { - // https://dlmf.nist.gov/10.21#E20 - x = rj1[L - 1] + (rj0[L] - rj0[L - 1]); - goto L15; - } - - // -- Newton method for y_{N,L} - // initial guess for y_{N,1} - if (n == 0) { - x = 0.89357697; - } else { - // https://dlmf.nist.gov/10.21#E40 - x = n + 0.93158 * pow(n, 0.33333) + 0.26035 / pow(n, 0.33333); - } - // iterate - L=0; -L20: - x0 = x; - jyndd(n, x, &bjn, &djn, &fjn, &byn, &dyn, &fyn); - x -= byn/dyn; - if (fabs(x - x0) > 1.0e-11) goto L20; - L += 1; - ry0[L - 1] = x; - // initial guess for y_{N,L+1} - if (L == 1) { - if (n == 0) { - x = 3.957678419314858; - } else { - // Expansion from https://dlmf.nist.gov/10.21#E33 and - // coefficients from Olver 1951 - x = n + 2.59626 * pow(n, 0.33333) + 2.022183 / pow(n, 0.33333); + // =================================================== + // Purpose: Compute the expansion coefficients of the + // prolate and oblate spheroidal functions + // and joining factors + // + // Return value: + // Status::OK + // Normal return. + // Status::NoMemory + // An internal memory allocation failed. + // =================================================== + + int nm, nn, ip, k, i, l, j; + T cs, gk0, gk1, gk2, gk3, t, r, dnp, su0, sw, r1, r2, r3, sa0, r4, r5, g0, sb0; + nm = 25 + (int)(0.5 * (n - m) + c); + nn = nm + m; + auto u = std::unique_ptr{new (std::nothrow) T[nn + 4]}; + auto v = std::unique_ptr{new (std::nothrow) T[nn + 4]}; + auto w = std::unique_ptr{new (std::nothrow) T[nn + 4]}; + auto tp = std::unique_ptr{new (std::nothrow) T[nn + 4]}; + auto rk = std::unique_ptr{new (std::nothrow) T[nn + 4]}; + if (u.get() == nullptr || v.get() == nullptr || w.get() == nullptr || tp.get() == nullptr || + rk.get() == nullptr) { + return Status::NoMemory; } - } else { - // growth of roots is approximately linear (https://dlmf.nist.gov/10.21#E19) - x = ry0[L - 1] + (ry0[L - 1] - ry0[L - 2]); - } - if (L <= n+10) { - jyndd(n, x, &bjn, &djn, &fjn, &byn, &dyn, &fyn); - h = atan(fabs(dyn) / sqrt(fabs(fyn * byn))); - b = -dyn / (byn * tan(h)); - x -= (h - pi/2) / b; - } - - if (L < nt) goto L20; - // -- Newton method for y_{N,L+1}' - if (n == 0) { - x = 2.67257; - } else { - // https://dlmf.nist.gov/10.21#E40 - x = n + 1.8211 * pow(n, 0.33333) + 0.94001 / pow(n, 0.33333); - } - // iterate - L=0; -L25: - x0 = x; - jyndd(n, x, &bjn, &djn, &fjn, &byn, &dyn, &fyn); - x -= dyn/fyn; - if (fabs(x-x0) > 1.0e-11) goto L25; - L += 1; - ry1[L - 1] = x; - if (L < nt) { - // https://dlmf.nist.gov/10.21#E20 - x=ry1[L - 1] + (ry0[L] - ry0[L - 1]); - goto L25; - } - return; -} - - -template -inline Status kmn(int m, int n, T c, T cv, int kd, T *df, T *dn, T *ck1, T *ck2) { - - // =================================================== - // Purpose: Compute the expansion coefficients of the - // prolate and oblate spheroidal functions - // and joining factors - // - // Return value: - // Status::OK - // Normal return. - // Status::NoMemory - // An internal memory allocation failed. - // =================================================== - - int nm, nn, ip, k, i, l, j; - T cs, gk0, gk1, gk2, gk3, t, r, dnp, su0, sw, r1, r2, r3, sa0, r4, r5, g0, sb0; - nm = 25 + (int)(0.5 * (n - m) + c); - nn = nm + m; - auto u = std::unique_ptr{new (std::nothrow) T[nn + 4]}; - auto v = std::unique_ptr{new (std::nothrow) T[nn + 4]}; - auto w = std::unique_ptr{new (std::nothrow) T[nn + 4]}; - auto tp = std::unique_ptr{new (std::nothrow) T[nn + 4]}; - auto rk = std::unique_ptr{new (std::nothrow) T[nn + 4]}; - if (u.get() == nullptr || v.get() == nullptr || w.get() == nullptr - || tp.get() == nullptr || rk.get() == nullptr) { - return Status::NoMemory; - } + const T eps = 1.0e-14; - const T eps = 1.0e-14; + cs = c * c * kd; + *ck1 = 0.0; + *ck2 = 0.0; - cs = c * c * kd; - *ck1 = 0.0; - *ck2 = 0.0; + ip = ((n - m) % 2 == 0 ? 0 : 1); + k = 0; - ip = ((n - m) % 2 == 0 ? 0 : 1); - k = 0; + for (i = 1; i <= nn + 3; i++) { + k = (ip == 0 ? -2 * (i - 1) : -(2 * i - 3)); + gk0 = 2.0 * m + k; + gk1 = (m + k) * (m + k + 1.0); + gk2 = 2.0 * (m + k) - 1.0; + gk3 = 2.0 * (m + k) + 3.0; - for (i = 1; i <= nn + 3; i++) { - k = (ip == 0 ? -2 * (i - 1) : -(2 * i - 3)); - gk0 = 2.0 * m + k; - gk1 = (m + k) * (m + k + 1.0); - gk2 = 2.0 * (m + k) - 1.0; - gk3 = 2.0 * (m + k) + 3.0; + u[i - 1] = gk0 * (gk0 - 1.0) * cs / (gk2 * (gk2 + 2.0)); + v[i - 1] = gk1 - cv + (2.0 * (gk1 - m * m) - 1.0) * cs / (gk2 * gk3); + w[i - 1] = (k + 1.0) * (k + 2.0) * cs / ((gk2 + 2.0) * gk3); + } - u[i - 1] = gk0 * (gk0 - 1.0) * cs / (gk2 * (gk2 + 2.0)); - v[i - 1] = gk1 - cv + (2.0 * (gk1 - m * m) - 1.0) * cs / (gk2 * gk3); - w[i - 1] = (k + 1.0) * (k + 2.0) * cs / ((gk2 + 2.0) * gk3); - } + for (k = 1; k <= m; k++) { + t = v[m]; + for (l = 0; l <= m - k - 1; l++) + t = v[m - l - 1] - w[m - l] * u[m - l - 1] / t; - for (k = 1; k <= m; k++) { - t = v[m]; - for (l = 0; l <= m - k - 1; l++) - t = v[m - l - 1] - w[m - l] * u[m - l - 1] / t; + rk[k - 1] = -u[k - 1] / t; + } - rk[k - 1] = -u[k - 1] / t; - } + r = 1.0; + for (k = 1; k <= m; k++) { + r = r * rk[k - 1]; + dn[k - 1] = df[0] * r; + } - r = 1.0; - for (k = 1; k <= m; k++) { - r = r * rk[k - 1]; - dn[k - 1] = df[0] * r; - } + tp[nn - 1] = v[nn]; - tp[nn - 1] = v[nn]; + for (k = nn - 1; k >= m + 1; k--) { + tp[k - 1] = v[k] - w[k + 1] * u[k] / tp[k]; - for (k = nn - 1; k >= m + 1; k--) { - tp[k - 1] = v[k] - w[k + 1] * u[k] / tp[k]; + if (k > m + 1) + rk[k - 1] = -u[k - 1] / tp[k - 1]; + } - if (k > m + 1) - rk[k - 1] = -u[k - 1] / tp[k - 1]; - } + dnp = (m == 0 ? df[0] : dn[m - 1]); + dn[m] = pow(-1, ip) * dnp * cs / ((2.0 * m - 1.0) * (2.0 * m + 1.0 - 4.0 * ip) * tp[m]); - dnp = (m == 0 ? df[0] : dn[m - 1]); - dn[m] = pow(-1, ip) * dnp * cs / ((2.0 * m - 1.0) * (2.0 * m + 1.0 - 4.0 * ip) * tp[m]); + for (k = m + 2; k <= nn; k++) + dn[k - 1] = rk[k - 1] * dn[k - 2]; - for (k = m + 2; k <= nn; k++) - dn[k - 1] = rk[k - 1] * dn[k - 2]; + r1 = 1.0; + for (j = 1; j <= (n + m + ip) / 2; j++) { + r1 = r1 * (j + 0.5 * (n + m + ip)); + } + r = 1.0; + for (j = 1; j <= 2 * m + ip; ++j) { + r *= j; + } + su0 = r * df[0]; + sw = 0.0; - r1 = 1.0; - for (j = 1; j <= (n + m + ip) / 2; j++) { - r1 = r1*(j + 0.5 * (n + m + ip)); - } - r = 1.0; - for (j = 1; j <= 2 * m + ip; ++j){ - r *= j; - } - su0 = r * df[0]; - sw = 0.0; - - for (k = 2; k <= nm; ++k) { - r = r * (m + k - 1.0) * (m + k + ip - 1.5) / (k - 1.0) / (k + ip - 1.5); - su0 = su0 + r * df[k - 1]; - if (k > (n - m) / 2 && fabs((su0 - sw) / su0) < eps) { break; } - sw = su0; - } + for (k = 2; k <= nm; ++k) { + r = r * (m + k - 1.0) * (m + k + ip - 1.5) / (k - 1.0) / (k + ip - 1.5); + su0 = su0 + r * df[k - 1]; + if (k > (n - m) / 2 && fabs((su0 - sw) / su0) < eps) { + break; + } + sw = su0; + } - if (kd != 1) { - r2 = 1.0; + if (kd != 1) { + r2 = 1.0; - for (j = 1; j <= m; ++j) - r2 = 2.0 * c * r2 * j; + for (j = 1; j <= m; ++j) + r2 = 2.0 * c * r2 * j; - r3 = 1.0; + r3 = 1.0; - for (j = 1; j <= (n - m - ip) / 2; ++j) - r3 = r3 * j; + for (j = 1; j <= (n - m - ip) / 2; ++j) + r3 = r3 * j; - sa0 = (2.0 * (m + ip) + 1.0) * r1 / (pow(2.0, n) * pow(c, ip) * r2 * r3 * df[0]); - *ck1 = sa0 * su0; + sa0 = (2.0 * (m + ip) + 1.0) * r1 / (pow(2.0, n) * pow(c, ip) * r2 * r3 * df[0]); + *ck1 = sa0 * su0; - if (kd == -1) { - return Status::OK; + if (kd == -1) { + return Status::OK; + } } - } - r4 = 1.0; - for (j = 1; j <= (n - m - ip) / 2; ++j) { - r4 *= 4.0 * j; - } - r5 = 1.0; - for (j = 1; j <= m; ++j) - r5 = r5 * (j + m) / c; - - if (m == 0) - g0 = df[0]; - else - g0 = dn[m - 1]; + r4 = 1.0; + for (j = 1; j <= (n - m - ip) / 2; ++j) { + r4 *= 4.0 * j; + } + r5 = 1.0; + for (j = 1; j <= m; ++j) + r5 = r5 * (j + m) / c; - sb0 = (ip + 1.0) * pow(c, ip + 1) / (2.0 * ip * (m - 2.0) + 1.0) / (2.0 * m - 1.0); - *ck2 = pow(-1, ip) * sb0 * r4 * r5 * g0 / r1 * su0; + if (m == 0) + g0 = df[0]; + else + g0 = dn[m - 1]; - return Status::OK; -} + sb0 = (ip + 1.0) * pow(c, ip + 1) / (2.0 * ip * (m - 2.0) + 1.0) / (2.0 * m - 1.0); + *ck2 = pow(-1, ip) * sb0 * r4 * r5 * g0 / r1 * su0; + return Status::OK; + } -inline void lamn(int n, double x, int *nm, double *bl, double *dl) { + inline void lamn(int n, double x, int *nm, double *bl, double *dl) { - // ========================================================= - // Purpose: Compute lambda functions and their derivatives - // Input: x --- Argument of lambda function - // n --- Order of lambda function - // Output: BL(n) --- Lambda function of order n - // DL(n) --- Derivative of lambda function - // NM --- Highest order computed - // Routines called: - // MSTA1 and MSTA2 for computing the start - // point for backward recurrence - // ========================================================= + // ========================================================= + // Purpose: Compute lambda functions and their derivatives + // Input: x --- Argument of lambda function + // n --- Order of lambda function + // Output: BL(n) --- Lambda function of order n + // DL(n) --- Derivative of lambda function + // NM --- Highest order computed + // Routines called: + // MSTA1 and MSTA2 for computing the start + // point for backward recurrence + // ========================================================= - int i, k, m; - double bk, r, uk, bs, f, f0, f1, bg, r0, x2; + int i, k, m; + double bk, r, uk, bs, f, f0, f1, bg, r0, x2; - *nm = n; - if (fabs(x) < 1e-100) { - for (k = 0; k <= n; k++) { - bl[k] = 0.0; - dl[k] = 0.0; + *nm = n; + if (fabs(x) < 1e-100) { + for (k = 0; k <= n; k++) { + bl[k] = 0.0; + dl[k] = 0.0; + } + bl[0] = 1.0; + dl[1] = 0.5; + return; } - bl[0] = 1.0; - dl[1] = 0.5; - return; - } - if (x <= 12.0) { - x2 = x * x; - for (k = 0; k <= n; k++) { - bk = 1.0; + if (x <= 12.0) { + x2 = x * x; + for (k = 0; k <= n; k++) { + bk = 1.0; + r = 1.0; + for (i = 1; i <= 50; i++) { + r = -0.25 * r * x2 / (i * (i + k)); + bk += r; + + if (fabs(r) < fabs(bk) * 1.0e-15) { + break; + } + } + bl[k] = bk; + if (k >= 1) { + dl[k - 1] = -0.5 * x / k * bk; + } + } + uk = 1.0; r = 1.0; for (i = 1; i <= 50; i++) { - r = -0.25 * r * x2 / (i * (i + k)); - bk += r; + r = -0.25 * r * x2 / (i * (i + n + 1.0)); + uk += r; - if (fabs(r) < fabs(bk) * 1.0e-15) { break; } + if (fabs(r) < fabs(uk) * 1.0e-15) { + break; + } + } + dl[n] = -0.5 * x / (n + 1.0) * uk; + return; + } + if (n == 0) { + *nm = 1; + } + m = msta1(x, 200); + if (m < *nm) { + *nm = m; + } else { + m = msta2(x, *nm, 15); + } + bs = 0.0; + f = 0.0; + f0 = 0.0; + f1 = 1e-100; + for (k = m; k >= 0; k--) { + f = 2.0 * (k + 1.0) * f1 / x - f0; + if (k <= *nm) { + bl[k] = f; } - bl[k] = bk; - if (k >= 1) { - dl[k - 1] = -0.5 * x / k * bk; + if (k % 2 == 0) { + bs += 2.0 * f; } + f0 = f1; + f1 = f; } - uk = 1.0; - r = 1.0; - for (i = 1; i <= 50; i++) { - r = -0.25 * r * x2 / (i * (i + n + 1.0)); - uk += r; - - if (fabs(r) < fabs(uk) * 1.0e-15) { break; } + bg = bs - f; + for (k = 0; k <= *nm; k++) { + bl[k] /= bg; + } + r0 = 1.0; + for (k = 1; k <= *nm; k++) { + r0 = 2.0 * r0 * k / x; + bl[k] *= r0; + } + dl[0] = -0.5 * x * bl[1]; + for (k = 1; k <= *nm; k++) { + dl[k] = 2.0 * k / x * (bl[k - 1] - bl[k]); } - dl[n] = -0.5 * x / (n + 1.0) * uk; return; } - if (n == 0) { - *nm = 1; - } - m = msta1(x, 200); - if (m < *nm) { - *nm = m; - } else { - m = msta2(x, *nm, 15); - } - bs = 0.0; - f = 0.0; - f0 = 0.0; - f1 = 1e-100; - for (k = m; k >= 0; k--) { - f = 2.0 * (k + 1.0) * f1 / x - f0; - if (k <= *nm) { - bl[k] = f; - } - if (k % 2 == 0) { - bs += 2.0 * f; - } - f0 = f1; - f1 = f; - } - bg = bs - f; - for (k = 0; k <= *nm; k++) { - bl[k] /= bg; - } - r0 = 1.0; - for (k = 1; k <= *nm; k++) { - r0 = 2.0 * r0 * k / x; - bl[k] *= r0; - } - dl[0] = -0.5 * x * bl[1]; - for (k = 1; k <= *nm; k++) { - dl[k] = 2.0 * k / x * (bl[k - 1] - bl[k]); - } - return; -} - - -inline void lamv(double v, double x, double *vm, double *vl, double *dl) { - - // ========================================================= - // Purpose: Compute lambda function with arbitrary order v, - // and their derivative - // Input : x --- Argument of lambda function - // v --- Order of lambda function - // Output: VL(n) --- Lambda function of order n+v0 - // DL(n) --- Derivative of lambda function - // VM --- Highest order computed - // Routines called: - // (1) MSTA1 and MSTA2 for computing the starting - // point for backward recurrence - // (2) GAM0 for computing gamma function (|x| ≤ 1) - // ========================================================= - - int i, n, k, j, k0, m; - double cs, ga, fac, r0, f0, f1, f2, f, xk, vv; - double x2, v0, vk, bk, r, uk, qx, px, rp, a0, ck, sk, bjv0, bjv1; - const double pi = 3.141592653589793; - const double rp2 = 0.63661977236758; - - x = fabs(x); - x2 = x * x; - n = (int)v; - v0 = v - n; - *vm = v; - - if (x <= 12.0) { - for (k = 0; k <= n; k++) { - vk = v0 + k; - bk = 1.0; - r = 1.0; - for (i = 1; i <= 50; i++) { - r = -0.25 * r * x2 / (i * (i + vk)); - bk = bk + r; + inline void lamv(double v, double x, double *vm, double *vl, double *dl) { + + // ========================================================= + // Purpose: Compute lambda function with arbitrary order v, + // and their derivative + // Input : x --- Argument of lambda function + // v --- Order of lambda function + // Output: VL(n) --- Lambda function of order n+v0 + // DL(n) --- Derivative of lambda function + // VM --- Highest order computed + // Routines called: + // (1) MSTA1 and MSTA2 for computing the starting + // point for backward recurrence + // (2) GAM0 for computing gamma function (|x| ≤ 1) + // ========================================================= + + int i, n, k, j, k0, m; + double cs, ga, fac, r0, f0, f1, f2, f, xk, vv; + double x2, v0, vk, bk, r, uk, qx, px, rp, a0, ck, sk, bjv0, bjv1; + const double pi = 3.141592653589793; + const double rp2 = 0.63661977236758; - if (fabs(r) < fabs(bk) * 1.0e-15) - break; - } - vl[k] = bk; + x = fabs(x); + x2 = x * x; + n = (int)v; + v0 = v - n; + *vm = v; + + if (x <= 12.0) { + for (k = 0; k <= n; k++) { + vk = v0 + k; + bk = 1.0; + r = 1.0; + + for (i = 1; i <= 50; i++) { + r = -0.25 * r * x2 / (i * (i + vk)); + bk = bk + r; + + if (fabs(r) < fabs(bk) * 1.0e-15) + break; + } + vl[k] = bk; - uk = 1.0; - r = 1.0; + uk = 1.0; + r = 1.0; - for (i = 1; i <= 50; i++) { - r = -0.25 * r * x2 / (i * (i + vk + 1.0)); - uk = uk + r; + for (i = 1; i <= 50; i++) { + r = -0.25 * r * x2 / (i * (i + vk + 1.0)); + uk = uk + r; - if (fabs(r) < fabs(uk) * 1.0e-15) - break; + if (fabs(r) < fabs(uk) * 1.0e-15) + break; + } + dl[k] = -0.5 * x / (vk + 1.0) * uk; } - dl[k] = -0.5 * x / (vk + 1.0) * uk; + return; } - return; - } - k0 = (x >= 50.0) ? 8 : ((x >= 35.0) ? 10 : 11); - bjv0 = 0.0; - bjv1 = 0.0; + k0 = (x >= 50.0) ? 8 : ((x >= 35.0) ? 10 : 11); + bjv0 = 0.0; + bjv1 = 0.0; - for (j = 0; j <= 1; j++) { - vv = 4.0 * (j + v0) * (j + v0); - px = 1.0; - rp = 1.0; - for (k = 1; k <= k0; k++) { - rp = -0.78125e-2 * rp * (vv - pow((4.0 * k - 3.0), 2.0)) * (vv - pow((4.0 * k - 1.0), 2.0)) / (k * (2.0 * k - 1.0) * x2); - px += rp; - } + for (j = 0; j <= 1; j++) { + vv = 4.0 * (j + v0) * (j + v0); + px = 1.0; + rp = 1.0; + for (k = 1; k <= k0; k++) { + rp = -0.78125e-2 * rp * (vv - pow((4.0 * k - 3.0), 2.0)) * (vv - pow((4.0 * k - 1.0), 2.0)) / + (k * (2.0 * k - 1.0) * x2); + px += rp; + } - qx = 1.0; - rp = 1.0; - for (k = 1; k <= k0; k++) { - rp = -0.78125e-2 * rp * (vv - pow((4.0 * k - 1.0), 2.0)) * (vv - pow((4.0 * k + 1.0), 2.0)) / (k * (2.0 * k + 1.0) * x2); - qx += rp; - } + qx = 1.0; + rp = 1.0; + for (k = 1; k <= k0; k++) { + rp = -0.78125e-2 * rp * (vv - pow((4.0 * k - 1.0), 2.0)) * (vv - pow((4.0 * k + 1.0), 2.0)) / + (k * (2.0 * k + 1.0) * x2); + qx += rp; + } - qx = 0.125 * (vv - 1.0) * qx / x; - xk = x - (0.5 * (j + v0) + 0.25) * pi; - a0 = sqrt(rp2 / x); - ck = cos(xk); - sk = sin(xk); + qx = 0.125 * (vv - 1.0) * qx / x; + xk = x - (0.5 * (j + v0) + 0.25) * pi; + a0 = sqrt(rp2 / x); + ck = cos(xk); + sk = sin(xk); - if (j == 0) bjv0 = a0 * (px * ck - qx * sk); - if (j == 1) bjv1 = a0 * (px * ck - qx * sk); - } + if (j == 0) + bjv0 = a0 * (px * ck - qx * sk); + if (j == 1) + bjv1 = a0 * (px * ck - qx * sk); + } - if (v0 == 0.0) { - ga = 1.0; - } else { - ga = gam0(v0); - ga *= v0; - } + if (v0 == 0.0) { + ga = 1.0; + } else { + ga = gam0(v0); + ga *= v0; + } + + fac = pow(2.0 / x, v0) * ga; + vl[0] = bjv0; + dl[0] = -bjv1 + v0 / x * bjv0; + vl[1] = bjv1; + dl[1] = bjv0 - (1.0 + v0) / x * bjv1; + r0 = 2.0 * (1.0 + v0) / x; + + if (n <= 1) { + vl[0] *= fac; + dl[0] = fac * dl[0] - v0 / x * vl[0]; + vl[1] *= fac * r0; + dl[1] = fac * r0 * dl[1] - (1.0 + v0) / x * vl[1]; + return; + } - fac = pow(2.0 / x, v0) * ga; - vl[0] = bjv0; - dl[0] = -bjv1 + v0 / x * bjv0; - vl[1] = bjv1; - dl[1] = bjv0 - (1.0 + v0) / x * bjv1; - r0 = 2.0 * (1.0 + v0) / x; + if (n >= 2 && n <= (int)(0.9 * x)) { + f0 = bjv0; + f1 = bjv1; - if (n <= 1) { - vl[0] *= fac; - dl[0] = fac * dl[0] - v0 / x * vl[0]; - vl[1] *= fac * r0; - dl[1] = fac * r0 * dl[1] - (1.0 + v0) / x * vl[1]; - return; - } + for (k = 2; k <= n; k++) { + f = 2.0 * (k + v0 - 1.0) / x * f1 - f0; + f0 = f1; + f1 = f; + vl[k] = f; + } + } else if (n >= 2) { + m = msta1(x, 200); + if (m < n) { + n = m; + } else { + m = msta2(x, n, 15); + } - if (n >= 2 && n <= (int)(0.9 * x)) { - f0 = bjv0; - f1 = bjv1; + f = 0.0; + f2 = 0.0; + f1 = 1.0e-100; - for (k = 2; k <= n; k++) { - f = 2.0 * (k + v0 - 1.0) / x * f1 - f0; - f0 = f1; - f1 = f; - vl[k] = f; - } - } else if (n >= 2) { - m = msta1(x, 200); - if (m < n) { - n = m; - } else { - m = msta2(x, n, 15); - } + for (k = m; k >= 0; k--) { + f = 2.0 * (v0 + k + 1.0) / x * f1 - f2; + if (k <= n) + vl[k] = f; + f2 = f1; + f1 = f; + } - f = 0.0; - f2 = 0.0; - f1 = 1.0e-100; + cs = 0.0; + if (fabs(bjv0) > fabs(bjv1)) { + cs = bjv0 / f; + } else { + cs = bjv1 / f2; + } - for (k = m; k >= 0; k--) { - f = 2.0 * (v0 + k + 1.0) / x * f1 - f2; - if (k <= n) vl[k] = f; - f2 = f1; - f1 = f; + for (k = 0; k <= n; k++) { + vl[k] *= cs; + } } - cs = 0.0; - if (fabs(bjv0) > fabs(bjv1)) { - cs = bjv0 / f; - } else { - cs = bjv1 / f2; + vl[0] *= fac; + for (j = 1; j <= n; j++) { + vl[j] *= fac * r0; + dl[j - 1] = -0.5 * x / (j + v0) * vl[j]; + r0 = 2.0 * (j + v0 + 1) / x * r0; } - for (k = 0; k <= n; k++) { - vl[k] *= cs; - } + dl[n] = 2.0 * (v0 + n) * (vl[n - 1] - vl[n]) / x; + *vm = n + v0; + return; } - vl[0] *= fac; - for (j = 1; j <= n; j++) { - vl[j] *= fac * r0; - dl[j - 1] = -0.5 * x / (j + v0) * vl[j]; - r0 = 2.0 * (j + v0 + 1) / x * r0; - } + template + void lpmns(int m, int n, T x, T *pm, T *pd) { - dl[n] = 2.0 * (v0 + n) * (vl[n - 1] - vl[n]) / x; - *vm = n + v0; - return; -} - - -template -void lpmns(int m, int n, T x, T* pm, T* pd) { - - // ======================================================== - // Purpose: Compute associated Legendre functions Pmn(x) - // and Pmn'(x) for a given order - // Input : x --- Argument of Pmn(x) - // m --- Order of Pmn(x), m = 0,1,2,...,n - // n --- Degree of Pmn(x), n = 0,1,2,...,N - // Output: PM(n) --- Pmn(x) - // PD(n) --- Pmn'(x) - // ======================================================== - - int k; - T coef, x0, pm0, pm1, pm2, pmk; - for (k = 0; k <= n; k++) { - pm[k] = 0.0; - pd[k] = 0.0; - } + // ======================================================== + // Purpose: Compute associated Legendre functions Pmn(x) + // and Pmn'(x) for a given order + // Input : x --- Argument of Pmn(x) + // m --- Order of Pmn(x), m = 0,1,2,...,n + // n --- Degree of Pmn(x), n = 0,1,2,...,N + // Output: PM(n) --- Pmn(x) + // PD(n) --- Pmn'(x) + // ======================================================== - if (fabs(x) == 1.0) { + int k; + T coef, x0, pm0, pm1, pm2, pmk; for (k = 0; k <= n; k++) { - if (m == 0) { - pm[k] = 1.0; - pd[k] = 0.5 * k * (k + 1.0); - if (x < 0.0) { - pm[k] *= ((k % 2) == 0 ? 1 : -1 ); - pd[k] *= (((k + 1) % 2) == 0 ? 1 : -1 ); + pm[k] = 0.0; + pd[k] = 0.0; + } + + if (fabs(x) == 1.0) { + for (k = 0; k <= n; k++) { + if (m == 0) { + pm[k] = 1.0; + pd[k] = 0.5 * k * (k + 1.0); + if (x < 0.0) { + pm[k] *= ((k % 2) == 0 ? 1 : -1); + pd[k] *= (((k + 1) % 2) == 0 ? 1 : -1); + } + } else if (m == 1) { + pd[k] = 1e300; + } else if (m == 2) { + pd[k] = -0.25 * (k + 2.0) * (k + 1.0) * k * (k - 1.0); + if (x < 0.0) + pd[k] *= (((k + 1) % 2) == 0 ? 1 : -1); } - } else if (m == 1) { - pd[k] = 1e300; - } else if (m == 2) { - pd[k] = -0.25 * (k + 2.0) * (k + 1.0) * k * (k - 1.0); - if (x < 0.0) - pd[k] *= (((k + 1) % 2) == 0 ? 1 : -1 ); } + return; + } + + x0 = fabs(1.0 - x * x); + pm0 = 1.0; + pmk = pm0; + for (k = 1; k <= m; k++) { + pmk = (2.0 * k - 1.0) * sqrt(x0) * pm0; + pm0 = pmk; + } + pm1 = (2.0 * m + 1.0) * x * pm0; + pm[m] = pmk; + pm[m + 1] = pm1; + for (k = m + 2; k <= n; k++) { + pm2 = ((2.0 * k - 1.0) * x * pm1 - (k + m - 1.0) * pmk) / (k - m); + pm[k] = pm2; + pmk = pm1; + pm1 = pm2; + } + + pd[0] = ((1.0 - m) * pm[1] - x * pm[0]) / (x * x - 1.0); + for (k = 1; k <= n; k++) { + pd[k] = (k * x * pm[k] - (k + m) * pm[k - 1]) / (x * x - 1.0); + } + coef = ((m % 2) == 0 ? 1 : -1); + for (k = 1; k <= n; k++) { + pm[k] *= coef; + pd[k] *= coef; } return; } - x0 = fabs(1.0 - x * x); - pm0 = 1.0; - pmk = pm0; - for (k = 1; k <= m; k++) { - pmk = (2.0 * k - 1.0) * sqrt(x0) * pm0; - pm0 = pmk; - } - pm1 = (2.0 * m + 1.0) * x * pm0; - pm[m] = pmk; - pm[m + 1] = pm1; - for (k = m + 2; k <= n; k++) { - pm2 = ((2.0 * k - 1.0) * x * pm1 - (k + m - 1.0) * pmk) / (k - m); - pm[k] = pm2; - pmk = pm1; - pm1 = pm2; - } + inline double lpmv(double x, int m, double v) { - pd[0] = ((1.0 - m) * pm[1] - x * pm[0]) / (x * x - 1.0); - for (k = 1; k <= n; k++) { - pd[k] = (k * x * pm[k] - (k + m) * pm[k - 1]) / (x * x - 1.0); - } - coef = ((m % 2) == 0 ? 1 : -1 ); - for (k = 1; k <= n; k++) { - pm[k] *= coef; - pd[k] *= coef; - } - return; -} - - -inline double lpmv(double x, int m, double v) { - - // ======================================================= - // Purpose: Compute the associated Legendre function - // Pmv(x) with an integer order and an arbitrary - // degree v, using recursion for large degrees - // Input : x --- Argument of Pm(x) ( -1 ≤ x ≤ 1 ) - // m --- Order of Pmv(x) - // v --- Degree of Pmv(x) - // Output: PMV --- Pmv(x) - // Routine called: LPMV0 - // ======================================================= - - int mx, neg_m, nv, j; - double vx, pmv, v0, p0, p1, g1, g2; - if ((x == -1.0) && (v != (int)v)) { - if (m == 0) { - pmv = -1e300; - } else { - pmv = 1e300; + // ======================================================= + // Purpose: Compute the associated Legendre function + // Pmv(x) with an integer order and an arbitrary + // degree v, using recursion for large degrees + // Input : x --- Argument of Pm(x) ( -1 ≤ x ≤ 1 ) + // m --- Order of Pmv(x) + // v --- Degree of Pmv(x) + // Output: PMV --- Pmv(x) + // Routine called: LPMV0 + // ======================================================= + + int mx, neg_m, nv, j; + double vx, pmv, v0, p0, p1, g1, g2; + if ((x == -1.0) && (v != (int)v)) { + if (m == 0) { + pmv = -1e300; + } else { + pmv = 1e300; + } + return pmv; + } + vx = v; + mx = m; + // DLMF 14.9.5 + if (v < 0) { + vx = -vx - 1.0; + } + neg_m = 0; + if (m < 0) { + if (((vx + m + 1) > 0) || (vx != (int)vx)) { + neg_m = 1; + mx = -m; + } else { + // We don't handle cases where DLMF 14.9.3 doesn't help + return NAN; + } } - return pmv; - } - vx = v; - mx = m; - // DLMF 14.9.5 - if (v < 0) { vx = -vx -1.0; } - neg_m = 0; - if (m < 0) { - if (((vx+m+1) > 0) || (vx != (int)vx)) { - neg_m = 1; - mx = -m; + nv = (int)vx; + v0 = vx - nv; + if ((nv > 2) && (nv > mx)) { + // Up-recursion on degree, AMS 8.5.3 / DLMF 14.10.3 + p0 = lpmv0(v0 + mx, mx, x); + p1 = lpmv0(v0 + mx + 1, mx, x); + pmv = p1; + for (j = mx + 2; j <= nv; j++) { + pmv = ((2 * (v0 + j) - 1) * x * p1 - (v0 + j - 1 + mx) * p0) / (v0 + j - mx); + p0 = p1; + p1 = pmv; + } } else { - // We don't handle cases where DLMF 14.9.3 doesn't help - return NAN; + pmv = lpmv0(vx, mx, x); } + if ((neg_m != 0) && (fabs(pmv) < 1.e300)) { + // DLMF 14.9.3 + g1 = gamma2(vx - mx + 1); + g2 = gamma2(vx + mx + 1); + pmv = pmv * g1 / g2 * pow(-1, mx); + } + return pmv; } - nv = (int)vx; - v0 = vx - nv; - if ((nv > 2) && (nv > mx)) { - // Up-recursion on degree, AMS 8.5.3 / DLMF 14.10.3 - p0 = lpmv0(v0+mx, mx, x); - p1 = lpmv0(v0+mx+1, mx, x); - pmv = p1; - for (j = mx+2; j <= nv; j++) { - pmv = ((2*(v0+j)-1)*x*p1 - (v0+j-1+mx)*p0) / (v0+j-mx); - p0 = p1; - p1 = pmv; - } - } else { - pmv = lpmv0(vx, mx, x); - } - if ((neg_m != 0) && (fabs(pmv) < 1.e300)) { - // DLMF 14.9.3 - g1 = gamma2(vx-mx+1); - g2 = gamma2(vx+mx+1); - pmv = pmv*g1/g2 * pow(-1, mx); - } - return pmv; -} - -inline double lpmv0(double v, int m, double x) { + inline double lpmv0(double v, int m, double x) { - // ======================================================= - // Purpose: Compute the associated Legendre function - // Pmv(x) with an integer order and an arbitrary - // nonnegative degree v - // Input : x --- Argument of Pm(x) ( -1 ≤ x ≤ 1 ) - // m --- Order of Pmv(x) - // v --- Degree of Pmv(x) - // Output: PMV --- Pmv(x) - // Routine called: PSI_SPEC for computing Psi function - // ======================================================= + // ======================================================= + // Purpose: Compute the associated Legendre function + // Pmv(x) with an integer order and an arbitrary + // nonnegative degree v + // Input : x --- Argument of Pm(x) ( -1 ≤ x ≤ 1 ) + // m --- Order of Pmv(x) + // v --- Degree of Pmv(x) + // Output: PMV --- Pmv(x) + // Routine called: PSI_SPEC for computing Psi function + // ======================================================= - int j, k, nv; - double c0, v0, vs, pa, pss, pv0, pmv, r, r0, r1, r2, s, s0, s1, s2, qr, rg, xq; + int j, k, nv; + double c0, v0, vs, pa, pss, pv0, pmv, r, r0, r1, r2, s, s0, s1, s2, qr, rg, xq; - const double pi = 3.141592653589793; - const double el = 0.5772156649015329; - const double eps = 1e-14; + const double pi = 3.141592653589793; + const double el = 0.5772156649015329; + const double eps = 1e-14; - nv = (int)v; - v0 = v - nv; - - if (x == -1.0 && v != nv) { - if (m == 0) - return -1.0e+300; - if (m != 0) - return 1.0e+300; - } + nv = (int)v; + v0 = v - nv; - c0 = 1.0; - if (m != 0) { - rg = v * (v + m); - for (j = 1; j <= m - 1; j++) { - rg *= (v * v - j * j); + if (x == -1.0 && v != nv) { + if (m == 0) + return -1.0e+300; + if (m != 0) + return 1.0e+300; } - xq = sqrt(1.0 - x*x); - r0 = 1.0; - for (j = 1; j <= m; j++) { - r0 = 0.5*r0*xq/j; + + c0 = 1.0; + if (m != 0) { + rg = v * (v + m); + for (j = 1; j <= m - 1; j++) { + rg *= (v * v - j * j); + } + xq = sqrt(1.0 - x * x); + r0 = 1.0; + for (j = 1; j <= m; j++) { + r0 = 0.5 * r0 * xq / j; + } + c0 = r0 * rg; } - c0 = r0*rg; - } - if (v0 == 0.0) { - // DLMF 14.3.4, 14.7.17, 15.2.4 - pmv = 1.0; - r = 1.0; - for (k = 1; k <= nv - m; k++) { - r = 0.5 * r * (-nv + m + k - 1.0) * (nv + m + k) / (k * (k + m)) * (1.0 + x); - pmv += r; - } - return pow(-1, nv)*c0*pmv; - } else { - if (x >= -0.35) { - // DLMF 14.3.4, 15.2.1 + if (v0 == 0.0) { + // DLMF 14.3.4, 14.7.17, 15.2.4 pmv = 1.0; r = 1.0; - for (k = 1; k <= 100; k++) { - r = 0.5 * r * (-v + m + k - 1.0) * (v + m + k) / (k * (m + k)) * (1.0 - x); + for (k = 1; k <= nv - m; k++) { + r = 0.5 * r * (-nv + m + k - 1.0) * (nv + m + k) / (k * (k + m)) * (1.0 + x); pmv += r; - if (k > 12 && fabs(r / pmv) < eps) { break; } } - return pow(-1, m)*c0*pmv; + return pow(-1, nv) * c0 * pmv; } else { - // DLMF 14.3.5, 15.8.10 - vs = sin(v * pi) / pi; - pv0 = 0.0; - if (m != 0) { - qr = sqrt((1.0 - x) / (1.0 + x)); - r2 = 1.0; - for (j = 1; j <= m; j++) { - r2 *= qr * j; + if (x >= -0.35) { + // DLMF 14.3.4, 15.2.1 + pmv = 1.0; + r = 1.0; + for (k = 1; k <= 100; k++) { + r = 0.5 * r * (-v + m + k - 1.0) * (v + m + k) / (k * (m + k)) * (1.0 - x); + pmv += r; + if (k > 12 && fabs(r / pmv) < eps) { + break; + } } - s0 = 1.0; - r1 = 1.0; - for (k = 1; k <= m - 1; k++) { - r1 = 0.5 * r1 * (-v + k - 1) * (v + k) / (k * (k - m)) * (1.0 + x); - s0 += r1; + return pow(-1, m) * c0 * pmv; + } else { + // DLMF 14.3.5, 15.8.10 + vs = sin(v * pi) / pi; + pv0 = 0.0; + if (m != 0) { + qr = sqrt((1.0 - x) / (1.0 + x)); + r2 = 1.0; + for (j = 1; j <= m; j++) { + r2 *= qr * j; + } + s0 = 1.0; + r1 = 1.0; + for (k = 1; k <= m - 1; k++) { + r1 = 0.5 * r1 * (-v + k - 1) * (v + k) / (k * (k - m)) * (1.0 + x); + s0 += r1; + } + pv0 = -vs * r2 / m * s0; } - pv0 = -vs * r2 / m * s0; - } - - pa = 2.0 * (psi_spec(v) + el) + pi / tan(pi * v) + 1.0 / v; - s1 = 0.0; - for (j = 1; j <= m; j++) { - s1 += (j * j + v * v) / (j * (j * j - v * v)); - } - pmv = pa + s1 - 1.0 / (m - v) + log(0.5 * (1.0 + x)); - r = 1.0; - for (k = 1; k <= 100; k++) { - r = 0.5 * r * (-v + m + k - 1.0) * (v + m + k) / (k * (k + m)) * (1.0 + x); - s = 0.0; - for (j = 1; j <= m; j++) - s += ((k + j) * (k + j) + v * v) / ((k + j) * ((k + j) * (k + j) - v * v)); - - s2 = 0.0; - for (j = 1; j <= k; j++) - s2 = s2 + 1.0 / (j * (j * j - v * v)); - pss = pa + s + 2.0 * v * v * s2 - 1.0 / (m + k - v) + log(0.5 * (1.0 + x)); - r2 = pss * r; - pmv += r2; - if (fabs(r2 / pmv) < eps) { break; } + pa = 2.0 * (psi_spec(v) + el) + pi / tan(pi * v) + 1.0 / v; + s1 = 0.0; + for (j = 1; j <= m; j++) { + s1 += (j * j + v * v) / (j * (j * j - v * v)); + } + pmv = pa + s1 - 1.0 / (m - v) + log(0.5 * (1.0 + x)); + r = 1.0; + for (k = 1; k <= 100; k++) { + r = 0.5 * r * (-v + m + k - 1.0) * (v + m + k) / (k * (k + m)) * (1.0 + x); + s = 0.0; + for (j = 1; j <= m; j++) + s += ((k + j) * (k + j) + v * v) / ((k + j) * ((k + j) * (k + j) - v * v)); + + s2 = 0.0; + for (j = 1; j <= k; j++) + s2 = s2 + 1.0 / (j * (j * j - v * v)); + + pss = pa + s + 2.0 * v * v * s2 - 1.0 / (m + k - v) + log(0.5 * (1.0 + x)); + r2 = pss * r; + pmv += r2; + if (fabs(r2 / pmv) < eps) { + break; + } + } + return pv0 + pmv * vs * c0; } - return pv0 + pmv * vs * c0; } } -} - - -template -inline void lqmns(int m, int n, T x, T *qm, T *qd) { - - // ======================================================== - // Purpose: Compute associated Legendre functions Qmn(x) - // and Qmn'(x) for a given order - // Input : x --- Argument of Qmn(x) - // m --- Order of Qmn(x), m = 0,1,2,... - // n --- Degree of Qmn(x), n = 0,1,2,... - // Output: QM(n) --- Qmn(x) - // QD(n) --- Qmn'(x) - // ======================================================== - - int l, ls, k, km; - T xq, q0, q00, q10, q01, q11, qf0, qf1, qm0, qm1, qg0, qg1, qh0, qh1,\ - qh2, qmk, q0l, q1l, qf2, val; - - val = 0.0; - if (fabs(x) == 1.0) { val = 1e300; } - for (k = 0; k <= n; k++) { - qm[k] = val; - qd[k] = val; - } - if (fabs(x) == 1.0) { - return; - } - ls = (fabs(x) > 1.0 ? -1 : 1); - - xq = sqrt(ls*(1.0 - x*x)); - q0 = 0.5 * log(fabs((x + 1.0) / (x - 1.0))); - q00 = q0; - q10 = -1.0 / xq; - q01 = x*q0 - 1.0; - q11 = -ls*xq*(q0 + x / (1.0 - x*x)); - qf0 = q00; - qf1 = q10; - qm0 = 0.0; - qm1 = 0.0; - - for (k = 2; k <= m; k++) { - qm0 = -2.0 * (k-1.0) / xq * x * qf1 - ls * (k-1.0) * (2.0 - k) * qf0; - qf0 = qf1; - qf1 = qm0; - } + template + inline void lqmns(int m, int n, T x, T *qm, T *qd) { - if (m == 0) { - qm0 = q00; - } - if (m == 1) { - qm0 = q10; - } + // ======================================================== + // Purpose: Compute associated Legendre functions Qmn(x) + // and Qmn'(x) for a given order + // Input : x --- Argument of Qmn(x) + // m --- Order of Qmn(x), m = 0,1,2,... + // n --- Degree of Qmn(x), n = 0,1,2,... + // Output: QM(n) --- Qmn(x) + // QD(n) --- Qmn'(x) + // ======================================================== - qm[0] = qm0; + int l, ls, k, km; + T xq, q0, q00, q10, q01, q11, qf0, qf1, qm0, qm1, qg0, qg1, qh0, qh1, qh2, qmk, q0l, q1l, qf2, val; - if (fabs(x) < 1.0001) { - if ((m == 0) && (n > 0)) { - qf0 = q00; - qf1 = q01; - for (k = 2; k <= n; k++) { - qf2 = ((2.0 * k - 1.0) * x * qf1 - (k - 1.0) * qf0) / k; - qm[k] = qf2; - qf0 = qf1; - qf1 = qf2; - } + val = 0.0; + if (fabs(x) == 1.0) { + val = 1e300; } + for (k = 0; k <= n; k++) { + qm[k] = val; + qd[k] = val; + } + + if (fabs(x) == 1.0) { + return; + } + ls = (fabs(x) > 1.0 ? -1 : 1); + + xq = sqrt(ls * (1.0 - x * x)); + q0 = 0.5 * log(fabs((x + 1.0) / (x - 1.0))); + q00 = q0; + q10 = -1.0 / xq; + q01 = x * q0 - 1.0; + q11 = -ls * xq * (q0 + x / (1.0 - x * x)); + qf0 = q00; + qf1 = q10; + qm0 = 0.0; + qm1 = 0.0; - qg0 = q01; - qg1 = q11; for (k = 2; k <= m; k++) { - qm1 = -2.0 * (k - 1.0) / xq * x * qg1 - ls * k * (3.0 - k) * qg0; - qg0 = qg1; - qg1 = qm1; + qm0 = -2.0 * (k - 1.0) / xq * x * qf1 - ls * (k - 1.0) * (2.0 - k) * qf0; + qf0 = qf1; + qf1 = qm0; } if (m == 0) { - qm1 = q01; + qm0 = q00; } if (m == 1) { - qm1 = q11; + qm0 = q10; } - qm[1] = qm1; + qm[0] = qm0; - if ((m == 1) && (n > 1)) { - qh0 = q10; - qh1 = q11; - for (k = 2; k <= n; k++) { - qh2 = ((2.0 * k - 1.0) * x * qh1 - k * qh0) / (k - 1.0); - qm[k] = qh2; - qh0 = qh1; - qh1 = qh2; - } - } else if (m >= 2) { - qg0 = q00; - qg1 = q01; - qh0 = q10; - qh1 = q11; - qmk = 0.0; - for (l = 2; l <= n; l++) { - q0l = ((2.0 * l - 1.0) * x * qg1 - (l - 1.0) * qg0) / l; - q1l = ((2.0 * l - 1.0) * x * qh1 - l * qh0) / (l - 1.0); - qf0 = q0l; - qf1 = q1l; - for (k = 2; k <= m; k++) { - qmk = -2.0 * (k - 1.0) / xq * x * qf1 - ls * (k + l - 1.0) * (l + 2.0 - k) * qf0; + if (fabs(x) < 1.0001) { + if ((m == 0) && (n > 0)) { + qf0 = q00; + qf1 = q01; + for (k = 2; k <= n; k++) { + qf2 = ((2.0 * k - 1.0) * x * qf1 - (k - 1.0) * qf0) / k; + qm[k] = qf2; qf0 = qf1; - qf1 = qmk; + qf1 = qf2; } - qm[l] = qmk; + } + + qg0 = q01; + qg1 = q11; + for (k = 2; k <= m; k++) { + qm1 = -2.0 * (k - 1.0) / xq * x * qg1 - ls * k * (3.0 - k) * qg0; qg0 = qg1; - qg1 = q0l; - qh0 = qh1; - qh1 = q1l; + qg1 = qm1; + } + + if (m == 0) { + qm1 = q01; + } + if (m == 1) { + qm1 = q11; + } + + qm[1] = qm1; + + if ((m == 1) && (n > 1)) { + qh0 = q10; + qh1 = q11; + for (k = 2; k <= n; k++) { + qh2 = ((2.0 * k - 1.0) * x * qh1 - k * qh0) / (k - 1.0); + qm[k] = qh2; + qh0 = qh1; + qh1 = qh2; + } + } else if (m >= 2) { + qg0 = q00; + qg1 = q01; + qh0 = q10; + qh1 = q11; + qmk = 0.0; + for (l = 2; l <= n; l++) { + q0l = ((2.0 * l - 1.0) * x * qg1 - (l - 1.0) * qg0) / l; + q1l = ((2.0 * l - 1.0) * x * qh1 - l * qh0) / (l - 1.0); + qf0 = q0l; + qf1 = q1l; + for (k = 2; k <= m; k++) { + qmk = -2.0 * (k - 1.0) / xq * x * qf1 - ls * (k + l - 1.0) * (l + 2.0 - k) * qf0; + qf0 = qf1; + qf1 = qmk; + } + qm[l] = qmk; + qg0 = qg1; + qg1 = q0l; + qh0 = qh1; + qh1 = q1l; + } + } + } else { + if (fabs(x) > 1.1) { + km = 40 + m + n; + } else { + km = (40 + m + n) * (int)(-1.0 - 1.8 * log(x - 1.0)); + } + qf2 = 0.0; + qf1 = 1.0; + for (k = km; k >= 0; k--) { + qf0 = ((2.0 * k + 3.0) * x * qf1 - (k + 2.0 - m) * qf2) / (k + m + 1.0); + if (k <= n) { + qm[k] = qf0; + } + qf2 = qf1; + qf1 = qf0; + } + for (k = 0; k <= n; k++) { + qm[k] = qm[k] * qm0 / qf0; } } - } else { - if (fabs(x) > 1.1) { - km = 40 + m + n; - } - else { - km = (40 + m + n) * (int)(-1.0 - 1.8 * log(x - 1.0)); - } - qf2 = 0.0; - qf1 = 1.0; - for (k = km; k >= 0; k--) { - qf0 = ((2.0 * k + 3.0) * x * qf1 - (k + 2.0 - m) * qf2) / (k + m + 1.0); - if (k <= n) { - qm[k] = qf0; + + if (fabs(x) < 1.0) { + for (k = 0; k <= n; k++) { + qm[k] = pow(-1, m) * qm[k]; } - qf2 = qf1; - qf1 = qf0; } - for (k = 0; k <= n; k++) { - qm[k] = qm[k] * qm0 / qf0; + + qd[0] = ((1.0 - m) * qm[1] - x * qm[0]) / (x * x - 1.0); + for (k = 1; k <= n; k++) { + qd[k] = (k * x * qm[k] - (k + m) * qm[k - 1]) / (x * x - 1.0); } + return; } - if (fabs(x) < 1.0) { - for (k = 0; k <= n; k++) { - qm[k] = pow(-1, m) * qm[k]; + inline int msta1(double x, int mp) { + + // =================================================== + // Purpose: Determine the starting point for backward + // recurrence such that the magnitude of + // Jn(x) at that point is about 10^(-MP) + // Input : x --- Argument of Jn(x) + // MP --- Value of magnitude + // Output: MSTA1 --- Starting point + // =================================================== + + int it, nn, n0, n1; + double a0, f, f0, f1; + + a0 = fabs(x); + n0 = (int)(1.1 * a0) + 1; + f0 = 0.5 * log10(6.28 * n0) - n0 * log10(1.36 * a0 / n0) - mp; + n1 = n0 + 5; + f1 = 0.5 * log10(6.28 * n1) - n1 * log10(1.36 * a0 / n1) - mp; + for (it = 1; it <= 20; it++) { + nn = n1 - (n1 - n0) / (1.0 - f0 / f1); + f = 0.5 * log10(6.28 * nn) - nn * log10(1.36 * a0 / nn) - mp; + if (abs(nn - n1) < 1) { + break; + } + n0 = n1; + f0 = f1; + n1 = nn; + f1 = f; } + return nn; } - qd[0] = ((1.0 - m) * qm[1] - x * qm[0]) / (x*x - 1.0); - for (k = 1; k <= n; k++) { - qd[k] = (k * x * qm[k] - (k + m) * qm[k-1]) / (x*x - 1.0); - } - return; -} - - -inline int msta1(double x, int mp) { - - // =================================================== - // Purpose: Determine the starting point for backward - // recurrence such that the magnitude of - // Jn(x) at that point is about 10^(-MP) - // Input : x --- Argument of Jn(x) - // MP --- Value of magnitude - // Output: MSTA1 --- Starting point - // =================================================== - - int it, nn, n0, n1; - double a0, f, f0, f1; - - a0 = fabs(x); - n0 = (int)(1.1*a0) + 1; - f0 = 0.5*log10(6.28*n0) - n0*log10(1.36*a0/n0)- mp; - n1 = n0 + 5; - f1 = 0.5*log10(6.28*n1) - n1*log10(1.36*a0/n1) - mp; - for (it = 1; it <= 20; it++) { - nn = n1 - (n1 - n0) / (1.0 - f0/f1); - f = 0.5*log10(6.28*nn) - nn*log10(1.36*a0/nn) - mp; - if (abs(nn-n1) < 1) { break; } - n0 = n1; - f0 = f1; - n1 = nn; - f1 = f; - } - return nn; -} - - -inline int msta2(double x, int n, int mp) { - - // =================================================== - // Purpose: Determine the starting point for backward - // recurrence such that all Jn(x) has MP - // significant digits - // Input : x --- Argument of Jn(x) - // n --- Order of Jn(x) - // MP --- Significant digit - // Output: MSTA2 --- Starting point - // =================================================== - - int it, n0, n1, nn; - double a0, hmp, ejn, obj, f, f0, f1; - - a0 = fabs(x); - hmp = 0.5*mp; - ejn = 0.5*log10(6.28*n) - n*log10(1.36*a0/n); - if (ejn <= hmp ) { - obj = mp; - n0 = (int)(1.1*a0) + 1; - } else { - obj = hmp + ejn; - n0 = n; - } - f0 = 0.5*log10(6.28*n0) - n0*log10(1.36*a0/n0) - obj; - n1 = n0 + 5; - f1 = 0.5*log10(6.28*n1) - n1*log10(1.36*a0/n1) - obj; - for (it = 1; it <= 20; it++) { - nn = n1 - (n1 - n0) / (1.0 - f0/f1); - f = 0.5*log10(6.28*nn) - nn*log10(1.36*a0/nn) - obj; - if (abs(nn-n1) < 1) { break; } - n0 = n1; - f0 = f1; - n1 = nn; - f1 = f; - } - return nn + 10; -} - - -template -Status mtu0(int kf, int m, T q, T x, T *csf, T *csd) { - - // =============================================================== - // Purpose: Compute Mathieu functions cem(x,q) and sem(x,q) - // and their derivatives ( q ≥ 0 ) - // Input : KF --- Function code - // KF=1 for computing cem(x,q) and cem'(x,q) - // KF=2 for computing sem(x,q) and sem'(x,q) - // m --- Order of Mathieu functions - // q --- Parameter of Mathieu functions - // x --- Argument of Mathieu functions (in degrees) - // Output: CSF --- cem(x,q) or sem(x,q) - // CSD --- cem'x,q) or sem'x,q) - // Return value: - // Status::OK - // Normal return. - // Status::NoMemory - // An internal memory allocation failed. The output - // values will be set to nan. - // Status::Other - // An internal check failed. For mtu0, this occurs - // when km (see the code) is too big. km is a - // function of q and m. The output values will be - // set to nan. - // - // Routines called: - // (1) CVA2 for computing the characteristic values - // (2) FCOEF for computing the expansion coefficients - // =============================================================== - - int kd = 0, km = 0, ic, k; - T a, qm, xr; - const T eps = 1.0e-14; - const T rd = 1.74532925199433e-2; - - if (kf == 1 && m == 2 * (int)(m / 2)) { kd = 1; } - if (kf == 1 && m != 2 * (int)(m / 2)) { kd = 2; } - if (kf == 2 && m != 2 * (int)(m / 2)) { kd = 3; } - if (kf == 2 && m == 2 * (int)(m / 2)) { kd = 4; } - - a = cva2(kd, m, q); - - if (q <= 1.0) { - qm = 7.5 + 56.1 * sqrt(q) - 134.7 * q + 90.7 * sqrt(q) * q; - } else { - qm = 17.0 + 3.1 * sqrt(q) - 0.126 * q + 0.0037 * sqrt(q) * q; - } + inline int msta2(double x, int n, int mp) { - km = (int)(qm + 0.5 * m); + // =================================================== + // Purpose: Determine the starting point for backward + // recurrence such that all Jn(x) has MP + // significant digits + // Input : x --- Argument of Jn(x) + // n --- Order of Jn(x) + // MP --- Significant digit + // Output: MSTA2 --- Starting point + // =================================================== - if (km > 251) { - *csf = NAN; - *csd = NAN; - return Status::Other; - } + int it, n0, n1, nn; + double a0, hmp, ejn, obj, f, f0, f1; - auto fg = std::unique_ptr{new (std::nothrow) T[251]()}; - if (fg.get() == nullptr) { - *csf = NAN; - *csd = NAN; - return Status::NoMemory; - } - fcoef(kd, m, q, a, fg.get()); + a0 = fabs(x); + hmp = 0.5 * mp; + ejn = 0.5 * log10(6.28 * n) - n * log10(1.36 * a0 / n); + if (ejn <= hmp) { + obj = mp; + n0 = (int)(1.1 * a0) + 1; + } else { + obj = hmp + ejn; + n0 = n; + } + f0 = 0.5 * log10(6.28 * n0) - n0 * log10(1.36 * a0 / n0) - obj; + n1 = n0 + 5; + f1 = 0.5 * log10(6.28 * n1) - n1 * log10(1.36 * a0 / n1) - obj; + for (it = 1; it <= 20; it++) { + nn = n1 - (n1 - n0) / (1.0 - f0 / f1); + f = 0.5 * log10(6.28 * nn) - nn * log10(1.36 * a0 / nn) - obj; + if (abs(nn - n1) < 1) { + break; + } + n0 = n1; + f0 = f1; + n1 = nn; + f1 = f; + } + return nn + 10; + } + + template + Status mtu0(int kf, int m, T q, T x, T *csf, T *csd) { + + // =============================================================== + // Purpose: Compute Mathieu functions cem(x,q) and sem(x,q) + // and their derivatives ( q ≥ 0 ) + // Input : KF --- Function code + // KF=1 for computing cem(x,q) and cem'(x,q) + // KF=2 for computing sem(x,q) and sem'(x,q) + // m --- Order of Mathieu functions + // q --- Parameter of Mathieu functions + // x --- Argument of Mathieu functions (in degrees) + // Output: CSF --- cem(x,q) or sem(x,q) + // CSD --- cem'x,q) or sem'x,q) + // Return value: + // Status::OK + // Normal return. + // Status::NoMemory + // An internal memory allocation failed. The output + // values will be set to nan. + // Status::Other + // An internal check failed. For mtu0, this occurs + // when km (see the code) is too big. km is a + // function of q and m. The output values will be + // set to nan. + // + // Routines called: + // (1) CVA2 for computing the characteristic values + // (2) FCOEF for computing the expansion coefficients + // =============================================================== - ic = (int)(m / 2) + 1; - xr = x * rd; - *csf = 0.0; - for (k = 1; k <= km; k++) { - if (kd == 1) { - *csf += fg[k - 1] * cos((2*k - 2) * xr); - } else if (kd == 2) { - *csf += fg[k - 1] * cos((2*k - 1) * xr); - } else if (kd == 3) { - *csf += fg[k - 1] * sin((2*k - 1) * xr); - } else if (kd == 4) { - *csf += fg[k - 1] * sin(2*k*xr); + int kd = 0, km = 0, ic, k; + T a, qm, xr; + const T eps = 1.0e-14; + const T rd = 1.74532925199433e-2; + + if (kf == 1 && m == 2 * (int)(m / 2)) { + kd = 1; } - if ((k >= ic) && (fabs(fg[k]) < fabs(*csf) * eps)) { - break; + if (kf == 1 && m != 2 * (int)(m / 2)) { + kd = 2; + } + if (kf == 2 && m != 2 * (int)(m / 2)) { + kd = 3; + } + if (kf == 2 && m == 2 * (int)(m / 2)) { + kd = 4; } - } - *csd = 0.0; - for (k = 1; k <= km; k++) { - if (kd == 1) { - *csd -= (2*k - 2) * fg[k - 1] * sin((2*k - 2) * xr); - } else if (kd == 2) { - *csd -= (2*k - 1) * fg[k - 1] * sin((2*k - 1) * xr); - } else if (kd == 3) { - *csd += (2*k - 1) * fg[k - 1] * cos((2*k - 1) * xr); - } else if (kd == 4) { - *csd += 2.0 * k * fg[k - 1] * cos(2*k*xr); + a = cva2(kd, m, q); + + if (q <= 1.0) { + qm = 7.5 + 56.1 * sqrt(q) - 134.7 * q + 90.7 * sqrt(q) * q; + } else { + qm = 17.0 + 3.1 * sqrt(q) - 0.126 * q + 0.0037 * sqrt(q) * q; + } + + km = (int)(qm + 0.5 * m); + + if (km > 251) { + *csf = NAN; + *csd = NAN; + return Status::Other; } - if ((k >= ic) && (fabs(fg[k - 1]) < fabs(*csd) * eps)) { - break; + + auto fg = std::unique_ptr{new (std::nothrow) T[251]()}; + if (fg.get() == nullptr) { + *csf = NAN; + *csd = NAN; + return Status::NoMemory; } - } - return Status::OK; -} - - -template -Status mtu12(int kf, int kc, int m, T q, T x, T *f1r, T *d1r, T *f2r, T *d2r) { - - // ============================================================== - // Purpose: Compute modified Mathieu functions of the first and - // second kinds, Mcm(1)(2)(x,q) and Msm(1)(2)(x,q), - // and their derivatives - // Input: KF --- Function code - // KF=1 for computing Mcm(x,q) - // KF=2 for computing Msm(x,q) - // KC --- Function Code - // KC=1 for computing the first kind - // KC=2 for computing the second kind - // or Msm(2)(x,q) and Msm(2)'(x,q) - // KC=3 for computing both the first - // and second kinds - // m --- Order of Mathieu functions - // q --- Parameter of Mathieu functions ( q ≥ 0 ) - // x --- Argument of Mathieu functions - // Output: F1R --- Mcm(1)(x,q) or Msm(1)(x,q) - // D1R --- Derivative of Mcm(1)(x,q) or Msm(1)(x,q) - // F2R --- Mcm(2)(x,q) or Msm(2)(x,q) - // D2R --- Derivative of Mcm(2)(x,q) or Msm(2)(x,q) - // Return value: - // Status::OK - // Normal return. - // Status::NoMemory - // An internal memory allocation failed. The output - // values will be set to nan. - // Status::Other - // An internal check failed. For mtu12, this occurs - // when km (see the code) is too big. km is a - // function of q and m. The output values will be - // set to nan. - // Routines called: - // (1) CVA2 for computing the characteristic values - // (2) FCOEF for computing expansion coefficients - // (3) JYNB for computing Jn(x), Yn(x) and their - // derivatives - // ============================================================== - - T eps = 1.0e-14; - T a, qm, c1, c2, u1, u2, w1, w2; - int kd, km, ic, k, nm = 0; - - if ((kf == 1) && (m % 2 == 0)) { kd = 1; } - if ((kf == 1) && (m % 2 != 0)) { kd = 2; } - if ((kf == 2) && (m % 2 != 0)) { kd = 3; } - if ((kf == 2) && (m % 2 == 0)) { kd = 4; } - - a = cva2(kd, m, q); - - if (q <= 1.0) { - qm = 7.5 + 56.1 * sqrt(q) - 134.7 * q + 90.7 * sqrt(q) * q; - } else { - qm = 17.0 + 3.1 * sqrt(q) - 0.126 * q + 0.0037 * sqrt(q) * q; - } + fcoef(kd, m, q, a, fg.get()); - km = (int)(qm + 0.5 * m); - if (km >= 251) { - *f1r = NAN; - *d1r = NAN; - *f2r = NAN; - *d2r = NAN; - return Status::Other; - } + ic = (int)(m / 2) + 1; + xr = x * rd; + *csf = 0.0; + for (k = 1; k <= km; k++) { + if (kd == 1) { + *csf += fg[k - 1] * cos((2 * k - 2) * xr); + } else if (kd == 2) { + *csf += fg[k - 1] * cos((2 * k - 1) * xr); + } else if (kd == 3) { + *csf += fg[k - 1] * sin((2 * k - 1) * xr); + } else if (kd == 4) { + *csf += fg[k - 1] * sin(2 * k * xr); + } + if ((k >= ic) && (fabs(fg[k]) < fabs(*csf) * eps)) { + break; + } + } - // allocate memory after a possible NAN return - auto fg = std::unique_ptr{new (std::nothrow) T[251]()}; - auto bj1 = std::unique_ptr{new (std::nothrow) T[252]()}; - auto dj1 = std::unique_ptr{new (std::nothrow) T[252]()}; - auto bj2 = std::unique_ptr{new (std::nothrow) T[252]()}; - auto dj2 = std::unique_ptr{new (std::nothrow) T[252]()}; - auto by1 = std::unique_ptr{new (std::nothrow) T[252]()}; - auto dy1 = std::unique_ptr{new (std::nothrow) T[252]()}; - auto by2 = std::unique_ptr{new (std::nothrow) T[252]()}; - auto dy2 = std::unique_ptr{new (std::nothrow) T[252]()}; - - if (fg.get() == nullptr || bj1.get() == nullptr || dj1.get() == nullptr - || bj2.get() == nullptr || dj2.get() == nullptr - || by1.get() == nullptr || dy1.get() == nullptr - || by2.get() == nullptr || dy2.get() == nullptr) { - *f1r = NAN; - *d1r = NAN; - *f2r = NAN; - *d2r = NAN; - return Status::NoMemory; + *csd = 0.0; + for (k = 1; k <= km; k++) { + if (kd == 1) { + *csd -= (2 * k - 2) * fg[k - 1] * sin((2 * k - 2) * xr); + } else if (kd == 2) { + *csd -= (2 * k - 1) * fg[k - 1] * sin((2 * k - 1) * xr); + } else if (kd == 3) { + *csd += (2 * k - 1) * fg[k - 1] * cos((2 * k - 1) * xr); + } else if (kd == 4) { + *csd += 2.0 * k * fg[k - 1] * cos(2 * k * xr); + } + if ((k >= ic) && (fabs(fg[k - 1]) < fabs(*csd) * eps)) { + break; + } + } + return Status::OK; } - fcoef(kd, m, q, a, fg.get()); - ic = (int)(m / 2) + 1; - if (kd == 4) { ic = m / 2; } - - c1 = exp(-x); - c2 = exp(x); - u1 = sqrt(q) * c1; - u2 = sqrt(q) * c2; - jynb(km+1, u1, &nm, bj1.get(), dj1.get(), by1.get(), dy1.get()); - jynb(km+1, u2, &nm, bj2.get(), dj2.get(), by2.get(), dy2.get()); - w1 = 0.0; - w2 = 0.0; - - if (kc != 2) { - *f1r = 0.0; + template + Status mtu12(int kf, int kc, int m, T q, T x, T *f1r, T *d1r, T *f2r, T *d2r) { + + // ============================================================== + // Purpose: Compute modified Mathieu functions of the first and + // second kinds, Mcm(1)(2)(x,q) and Msm(1)(2)(x,q), + // and their derivatives + // Input: KF --- Function code + // KF=1 for computing Mcm(x,q) + // KF=2 for computing Msm(x,q) + // KC --- Function Code + // KC=1 for computing the first kind + // KC=2 for computing the second kind + // or Msm(2)(x,q) and Msm(2)'(x,q) + // KC=3 for computing both the first + // and second kinds + // m --- Order of Mathieu functions + // q --- Parameter of Mathieu functions ( q ≥ 0 ) + // x --- Argument of Mathieu functions + // Output: F1R --- Mcm(1)(x,q) or Msm(1)(x,q) + // D1R --- Derivative of Mcm(1)(x,q) or Msm(1)(x,q) + // F2R --- Mcm(2)(x,q) or Msm(2)(x,q) + // D2R --- Derivative of Mcm(2)(x,q) or Msm(2)(x,q) + // Return value: + // Status::OK + // Normal return. + // Status::NoMemory + // An internal memory allocation failed. The output + // values will be set to nan. + // Status::Other + // An internal check failed. For mtu12, this occurs + // when km (see the code) is too big. km is a + // function of q and m. The output values will be + // set to nan. + // Routines called: + // (1) CVA2 for computing the characteristic values + // (2) FCOEF for computing expansion coefficients + // (3) JYNB for computing Jn(x), Yn(x) and their + // derivatives + // ============================================================== + + T eps = 1.0e-14; + T a, qm, c1, c2, u1, u2, w1, w2; + int kd, km, ic, k, nm = 0; + + if ((kf == 1) && (m % 2 == 0)) { + kd = 1; + } + if ((kf == 1) && (m % 2 != 0)) { + kd = 2; + } + if ((kf == 2) && (m % 2 != 0)) { + kd = 3; + } + if ((kf == 2) && (m % 2 == 0)) { + kd = 4; + } + + a = cva2(kd, m, q); + + if (q <= 1.0) { + qm = 7.5 + 56.1 * sqrt(q) - 134.7 * q + 90.7 * sqrt(q) * q; + } else { + qm = 17.0 + 3.1 * sqrt(q) - 0.126 * q + 0.0037 * sqrt(q) * q; + } + + km = (int)(qm + 0.5 * m); + if (km >= 251) { + *f1r = NAN; + *d1r = NAN; + *f2r = NAN; + *d2r = NAN; + return Status::Other; + } + + // allocate memory after a possible NAN return + auto fg = std::unique_ptr{new (std::nothrow) T[251]()}; + auto bj1 = std::unique_ptr{new (std::nothrow) T[252]()}; + auto dj1 = std::unique_ptr{new (std::nothrow) T[252]()}; + auto bj2 = std::unique_ptr{new (std::nothrow) T[252]()}; + auto dj2 = std::unique_ptr{new (std::nothrow) T[252]()}; + auto by1 = std::unique_ptr{new (std::nothrow) T[252]()}; + auto dy1 = std::unique_ptr{new (std::nothrow) T[252]()}; + auto by2 = std::unique_ptr{new (std::nothrow) T[252]()}; + auto dy2 = std::unique_ptr{new (std::nothrow) T[252]()}; + + if (fg.get() == nullptr || bj1.get() == nullptr || dj1.get() == nullptr || bj2.get() == nullptr || + dj2.get() == nullptr || by1.get() == nullptr || dy1.get() == nullptr || by2.get() == nullptr || + dy2.get() == nullptr) { + *f1r = NAN; + *d1r = NAN; + *f2r = NAN; + *d2r = NAN; + return Status::NoMemory; + } + + fcoef(kd, m, q, a, fg.get()); + ic = (int)(m / 2) + 1; + if (kd == 4) { + ic = m / 2; + } + + c1 = exp(-x); + c2 = exp(x); + u1 = sqrt(q) * c1; + u2 = sqrt(q) * c2; + jynb(km + 1, u1, &nm, bj1.get(), dj1.get(), by1.get(), dy1.get()); + jynb(km + 1, u2, &nm, bj2.get(), dj2.get(), by2.get(), dy2.get()); + w1 = 0.0; + w2 = 0.0; + + if (kc != 2) { + *f1r = 0.0; + for (k = 1; k <= km; k++) { + if (kd == 1) { + *f1r += pow(-1, ic + k) * fg[k - 1] * bj1[k - 1] * bj2[k - 1]; + } else if (kd == 2 || kd == 3) { + *f1r += pow(-1, ic + k) * fg[k - 1] * (bj1[k - 1] * bj2[k] + pow(-1, kd) * bj1[k] * bj2[k - 1]); + } else { + *f1r += pow(-1, ic + k) * fg[k - 1] * (bj1[k - 1] * bj2[k + 1] - bj1[k + 1] * bj2[k - 1]); + } + + if (k >= 5 && fabs(*f1r - w1) < fabs(*f1r) * eps) { + break; + } + w1 = *f1r; + } + + *f1r /= fg[0]; + + *d1r = 0.0; + for (k = 1; k <= km; k++) { + if (kd == 1) { + *d1r += pow(-1, ic + k) * fg[k - 1] * (c2 * bj1[k - 1] * dj2[k - 1] - c1 * dj1[k - 1] * bj2[k - 1]); + } else if (kd == 2 || kd == 3) { + *d1r += pow(-1, ic + k) * fg[k - 1] * + (c2 * (bj1[k - 1] * dj2[k] + pow(-1, kd) * bj1[k] * dj2[k - 1]) - + c1 * (dj1[k - 1] * bj2[k] + pow(-1, kd) * dj1[k] * bj2[k - 1])); + } else { + *d1r += pow(-1, ic + k) * fg[k - 1] * + (c2 * (bj1[k - 1] * dj2[k + 1] - bj1[k + 1] * dj2[k - 1]) - + c1 * (dj1[k - 1] * bj2[k + 1] - dj1[k + 1] * bj2[k - 1])); + } + + if (k >= 5 && fabs(*d1r - w2) < fabs(*d1r) * eps) { + break; + } + w2 = *d1r; + } + *d1r *= sqrt(q) / fg[0]; + if (kc == 1) { + return Status::OK; + } + } + + *f2r = 0.0; for (k = 1; k <= km; k++) { if (kd == 1) { - *f1r += pow(-1, ic + k) * fg[k - 1] * bj1[k - 1] * bj2[k - 1]; + *f2r += pow(-1, ic + k) * fg[k - 1] * bj1[k - 1] * by2[k - 1]; } else if (kd == 2 || kd == 3) { - *f1r += pow(-1, ic + k) * fg[k - 1] * (bj1[k - 1] * bj2[k] + pow(-1, kd) * bj1[k] * bj2[k - 1]); + *f2r += pow(-1, ic + k) * fg[k - 1] * (bj1[k - 1] * by2[k] + pow(-1, kd) * bj1[k] * by2[k - 1]); } else { - *f1r += pow(-1, ic + k) * fg[k - 1] * (bj1[k - 1] * bj2[k + 1] - bj1[k + 1] * bj2[k - 1]); + *f2r += pow(-1, ic + k) * fg[k - 1] * (bj1[k - 1] * by2[k + 1] - bj1[k + 1] * by2[k - 1]); } - if (k >= 5 && fabs(*f1r - w1) < fabs(*f1r) * eps) { break; } - w1 = *f1r; + if (k >= 5 && fabs(*f2r - w1) < fabs(*f2r) * eps) { + break; + } + w1 = *f2r; } + *f2r /= fg[0]; - *f1r /= fg[0]; - - *d1r = 0.0; + *d2r = 0.0; for (k = 1; k <= km; k++) { if (kd == 1) { - *d1r += pow(-1, ic + k) * fg[k - 1] * (c2 * bj1[k - 1] * dj2[k - 1] - c1 * dj1[k - 1] * bj2[k - 1]); + *d2r += pow(-1, ic + k) * fg[k - 1] * (c2 * bj1[k - 1] * dy2[k - 1] - c1 * dj1[k - 1] * by2[k - 1]); } else if (kd == 2 || kd == 3) { - *d1r += pow(-1, ic + k) * fg[k - 1] * (c2 * (bj1[k - 1] * dj2[k] + pow(-1, kd) * bj1[k] * dj2[k - 1]) - - c1 * (dj1[k - 1] * bj2[k] + pow(-1, kd) * dj1[k] * bj2[k - 1])); + *d2r += pow(-1, ic + k) * fg[k - 1] * + (c2 * (bj1[k - 1] * dy2[k] + pow(-1, kd) * bj1[k] * dy2[k - 1]) - + c1 * (dj1[k - 1] * by2[k] + pow(-1, kd) * dj1[k] * by2[k - 1])); } else { - *d1r += pow(-1, ic + k) * fg[k - 1] * (c2 * (bj1[k - 1] * dj2[k + 1] - bj1[k + 1] * dj2[k - 1]) - - c1 * (dj1[k - 1] * bj2[k + 1] - dj1[k + 1] * bj2[k - 1])); + *d2r += pow(-1, ic + k) * fg[k - 1] * + (c2 * (bj1[k - 1] * dy2[k + 1] - bj1[k + 1] * dy2[k - 1]) - + c1 * (dj1[k - 1] * by2[k + 1] - dj1[k + 1] * by2[k - 1])); } - if (k >= 5 && fabs(*d1r - w2) < fabs(*d1r) * eps) { break; } - w2 = *d1r; - } - *d1r *= sqrt(q) / fg[0]; - if (kc == 1) { - return Status::OK; + if (k >= 5 && fabs(*d2r - w2) < fabs(*d2r) * eps) { + break; + } + w2 = *d2r; } + *d2r = *d2r * sqrt(q) / fg[0]; + return Status::OK; } - *f2r = 0.0; - for (k = 1; k <= km; k++) { - if (kd == 1) { - *f2r += pow(-1, ic + k) * fg[k - 1] * bj1[k - 1] * by2[k - 1]; - } else if (kd == 2 || kd == 3) { - *f2r += pow(-1, ic + k) * fg[k - 1] * (bj1[k - 1] * by2[k] + pow(-1, kd) * bj1[k] * by2[k - 1]); + inline double psi_spec(double x) { + + // ====================================== + // Purpose: Compute Psi function + // Input : x --- Argument of psi(x) + // Output: PS --- psi(x) + // ====================================== + + int k, n; + double ps, s = 0.0, x2, xa = fabs(x); + const double pi = 3.141592653589793; + const double el = 0.5772156649015329; + static const double a[8] = {-0.8333333333333e-01, 0.83333333333333333e-02, -0.39682539682539683e-02, + 0.41666666666666667e-02, -0.75757575757575758e-02, 0.21092796092796093e-01, + -0.83333333333333333e-01, 0.4432598039215686}; + + if ((x == (int)x) && (x <= 0.0)) { + return 1e300; + } else if (xa == (int)xa) { + n = (int)xa; + for (k = 1; k < n; k++) { + s += 1.0 / k; + } + ps = -el + s; + } else if ((xa + 0.5) == (int)(xa + 0.5)) { + n = (int)(xa - 0.5); + for (k = 1; k < (n + 1); k++) { + s += 1.0 / (2.0 * k - 1.0); + } + ps = -el + 2.0 * s - 1.386294361119891; /* 2*log(2) */ } else { - *f2r += pow(-1, ic + k) * fg[k - 1] * (bj1[k - 1] * by2[k + 1] - bj1[k + 1] * by2[k - 1]); + if (xa < 10.0) { + n = (10.0 - (int)xa); + for (k = 0; k < n; k++) { + s += 1.0 / (xa + k); + } + xa += n; + } + x2 = 1.0 / (xa * xa); + ps = log(xa) - 0.5 / xa; + ps += x2 * (((((((a[7] * x2 + a[6]) * x2 + a[5]) * x2 + a[4]) * x2 + a[3]) * x2 + a[2]) * x2 + a[1]) * x2 + + a[0]); + ps -= s; } - - if (k >= 5 && fabs(*f2r - w1) < fabs(*f2r) * eps) { break; } - w1 = *f2r; - } - *f2r /= fg[0]; - - *d2r = 0.0; - for (k = 1; k <= km; k++) { - if (kd == 1) { - *d2r += pow(-1, ic + k) * fg[k - 1] * (c2 * bj1[k - 1] * dy2[k - 1] - c1 * dj1[k - 1] * by2[k - 1]); - } else if (kd == 2 || kd == 3) { - *d2r += pow(-1, ic + k) * fg[k - 1] * (c2 * (bj1[k - 1] * dy2[k] + pow(-1, kd) * bj1[k] * dy2[k - 1]) - - c1 * (dj1[k - 1] * by2[k] + pow(-1, kd) * dj1[k] * by2[k - 1])); - } else { - *d2r += pow(-1, ic + k) * fg[k - 1] * (c2 * (bj1[k - 1] * dy2[k + 1 ] - bj1[k + 1] * dy2[k - 1]) - - c1 * (dj1[k - 1] * by2[k + 1] - dj1[k + 1] * by2[k - 1])); + if (x < 0.0) { + ps -= pi * cos(pi * x) / sin(pi * x) + 1.0 / x; } - - if (k >= 5 && fabs(*d2r - w2) < fabs(*d2r) * eps) { break; } - w2 = *d2r; + return ps; } - *d2r = *d2r * sqrt(q) / fg[0]; - return Status::OK; -} - - -inline double psi_spec(double x) { - - // ====================================== - // Purpose: Compute Psi function - // Input : x --- Argument of psi(x) - // Output: PS --- psi(x) - // ====================================== - - int k, n; - double ps, s = 0.0, x2, xa = fabs(x); - const double pi = 3.141592653589793; - const double el = 0.5772156649015329; - static const double a[8] = { - -0.8333333333333e-01, - 0.83333333333333333e-02, - -0.39682539682539683e-02, - 0.41666666666666667e-02, - -0.75757575757575758e-02, - 0.21092796092796093e-01, - -0.83333333333333333e-01, - 0.4432598039215686 - }; - - if ((x == (int)x) && (x <= 0.0)) { - return 1e300; - } else if (xa == (int)xa) { - n = (int)xa; - for (k = 1; k < n; k++) { - s += 1.0 / k; - } - ps = -el + s; - } else if ((xa + 0.5) == (int)(xa + 0.5)) { - n = (int)(xa - 0.5); - for (k = 1; k < (n+1); k++) { - s += 1.0 / (2.0*k - 1.0); - } - ps = -el + 2.0*s - 1.386294361119891; /* 2*log(2) */ - } else { - if (xa < 10.0) { - n = (10.0 - (int)xa); - for (k = 0; k < n; k++) { - s += 1.0 / (xa + k); - } - xa += n; - } - x2 = 1.0 / (xa*xa); - ps = log(xa) - 0.5 / xa; - ps += x2*(((((((a[7]*x2+a[6])*x2+a[5])*x2+a[4])*x2+a[3])*x2+a[2])*x2+a[1])*x2+a[0]); - ps -= s; - } - if (x < 0.0) { - ps -= pi*cos(pi*x)/sin(pi*x) + 1.0 / x; - } - return ps; -} + template + Status qstar(int m, int n, T c, T ck1, T *ck, T *qs, T *qt) { -template -Status qstar(int m, int n, T c, T ck1, T *ck, T *qs, T *qt) { + // ========================================================== + // Return value: + // Status::OK + // Normal return. + // Status::NoMemory + // An internal memory allocation failed. + // ========================================================== - // ========================================================== - // Return value: - // Status::OK - // Normal return. - // Status::NoMemory - // An internal memory allocation failed. - // ========================================================== + int ip, i, l, k; + T r, s, sk, qs0; - int ip, i, l, k; - T r, s, sk, qs0; + auto ap = std::unique_ptr{new (std::nothrow) T[200]}; + if (ap.get() == nullptr) { + return Status::NoMemory; + } + ip = ((n - m) == 2 * ((n - m) / 2) ? 0 : 1); + r = 1.0 / pow(ck[0], 2); + ap[0] = r; - auto ap = std::unique_ptr{new (std::nothrow) T[200]}; - if (ap.get() == nullptr) { - return Status::NoMemory; - } - ip = ((n - m) == 2 * ((n - m) / 2) ? 0 : 1); - r = 1.0 / pow(ck[0], 2); - ap[0] = r; + for (i = 1; i <= m; i++) { + s = 0.0; + for (l = 1; l <= i; l++) { + sk = 0.0; + for (k = 0; k <= l; k++) + sk += ck[k] * ck[l - k]; + s += sk * ap[i - l]; + } + ap[i] = -r * s; + } + qs0 = ap[m - 1]; - for (i = 1; i <= m; i++) { - s = 0.0; - for (l = 1; l <= i; l++) { - sk = 0.0; - for (k = 0; k <= l; k++) - sk += ck[k] * ck[l - k]; - s += sk * ap[i - l]; + for (l = 1; l < m; l++) { + r = 1.0; + for (k = 1; k <= l; ++k) { + r = r * (2.0 * k + ip) * (2.0 * k - 1.0 + ip) / pow(2.0 * k, 2); + } + qs0 += ap[m - l] * r; } - ap[i] = -r * s; + *qs = pow(-1, ip) * (ck1) * (ck1 * qs0) / c; + *qt = -2.0 / (ck1) * (*qs); + return Status::OK; } - qs0 = ap[m - 1]; - for (l = 1; l < m; l++) { - r = 1.0; - for (k = 1; k <= l; ++k) { - r = r * (2.0 * k + ip) * (2.0 * k - 1.0 + ip) / pow(2.0 * k, 2); + inline double refine(int kd, int m, double q, double a) { + + // ===================================================== + // Purpose: calculate the accurate characteristic value + // by the secant method + // Input : m --- Order of Mathieu functions + // q --- Parameter of Mathieu functions + // A --- Initial characteristic value + // Output: A --- Refineed characteristic value + // Routine called: CVF for computing the value of F for + // characteristic equation + // ======================================================== + + int it, mj; + double x1, x0, x, f, f0, f1; + const double eps = 1e-14; + + mj = 10 + m; + x0 = a; + f0 = cvf(kd, m, q, x0, mj); + x1 = 1.002 * a; + f1 = cvf(kd, m, q, x1, mj); + for (it = 1; it <= 100; it++) { + mj += 1; + x = x1 - (x1 - x0) / (1.0 - f0 / f1); + f = cvf(kd, m, q, x, mj); + if ((fabs(1.0 - x1 / x) < eps) || (f == 0.0)) { + break; + } + x0 = x1; + f0 = f1; + x1 = x; + f1 = f; } - qs0 += ap[m - l] * r; - } - *qs = pow(-1, ip) * (ck1) * (ck1 * qs0) / c; - *qt = -2.0 / (ck1) * (*qs); - return Status::OK; -} - - -inline double refine(int kd, int m, double q, double a) { - - // ===================================================== - // Purpose: calculate the accurate characteristic value - // by the secant method - // Input : m --- Order of Mathieu functions - // q --- Parameter of Mathieu functions - // A --- Initial characteristic value - // Output: A --- Refineed characteristic value - // Routine called: CVF for computing the value of F for - // characteristic equation - // ======================================================== - - int it, mj; - double x1, x0, x, f, f0, f1; - const double eps = 1e-14; - - mj = 10 + m; - x0 = a; - f0 = cvf(kd, m, q, x0, mj); - x1 = 1.002*a; - f1 = cvf(kd, m, q, x1, mj); - for (it = 1; it <= 100; it++) { - mj += 1; - x = x1 - (x1-x0)/(1.0 - f0/f1); - f = cvf(kd, m, q, x, mj); - if ((fabs(1.0 - x1/x) < eps) || (f == 0.0)) { break; } - x0 = x1; - f0 = f1; - x1 = x; - f1 = f; - } - return x; -} - - -template -inline Status rmn1(int m, int n, T c, T x, int kd, T *df, T *r1f, T *r1d) { - - // ======================================================= - // Purpose: Compute prolate and oblate spheroidal radial - // functions of the first kind for given m, n, - // c and x - // - // Return value: - // Status::OK - // Normal return. - // Status::NoMemory - // An internal memory allocation failed. - // - // Routines called: - // (1) SCKB for computing expansion coefficients c2k - // (2) SPHJ for computing the spherical Bessel - // functions of the first kind - // ======================================================= - - T a0, b0, cx, r, r0, r1, r2, r3, reg, sa0, suc, sud, sum, sw, sw1; - int ip, j, k, l, lg, nm, nm1, nm2, np; - - auto ck = std::unique_ptr{new (std::nothrow) T[200]()}; - auto dj = std::unique_ptr{new (std::nothrow) T[252]()}; - auto sj = std::unique_ptr{new (std::nothrow) T[252]()}; - if (ck.get() == nullptr || dj.get() == nullptr || sj.get() == nullptr) { - return Status::NoMemory; + return x; } - const T eps = 1.0e-14; - nm1 = (int)((n - m) / 2); - ip = (n - m == 2 * nm1 ? 0 : 1); - nm = 25 + nm1 + (int)c; - reg = (m + nm > 80 ? 1.0e-200 : 1.0); - r0 = reg; + template + inline Status rmn1(int m, int n, T c, T x, int kd, T *df, T *r1f, T *r1d) { - for (j = 1; j <= 2 * m + ip; ++j) { - r0 *= j; - } - r = r0; - suc = r * df[0]; - sw = 0.0; - - for (k = 2; k <= nm; k++) { - r = r * (m + k - 1.0) * (m + k + ip - 1.5) / (k - 1.0) / (k + ip - 1.5); - suc += r * df[k - 1]; - if ((k > nm1) && (fabs(suc - sw) < fabs(suc) * eps)) { break; } - sw = suc; - } + // ======================================================= + // Purpose: Compute prolate and oblate spheroidal radial + // functions of the first kind for given m, n, + // c and x + // + // Return value: + // Status::OK + // Normal return. + // Status::NoMemory + // An internal memory allocation failed. + // + // Routines called: + // (1) SCKB for computing expansion coefficients c2k + // (2) SPHJ for computing the spherical Bessel + // functions of the first kind + // ======================================================= + + T a0, b0, cx, r, r0, r1, r2, r3, reg, sa0, suc, sud, sum, sw, sw1; + int ip, j, k, l, lg, nm, nm1, nm2, np; + + auto ck = std::unique_ptr{new (std::nothrow) T[200]()}; + auto dj = std::unique_ptr{new (std::nothrow) T[252]()}; + auto sj = std::unique_ptr{new (std::nothrow) T[252]()}; + if (ck.get() == nullptr || dj.get() == nullptr || sj.get() == nullptr) { + return Status::NoMemory; + } + const T eps = 1.0e-14; - if (x == 0.0) { - sckb(m, n, c, df, ck.get()); + nm1 = (int)((n - m) / 2); + ip = (n - m == 2 * nm1 ? 0 : 1); + nm = 25 + nm1 + (int)c; + reg = (m + nm > 80 ? 1.0e-200 : 1.0); + r0 = reg; - sum = 0.0; - sw1 = 0.0; - for (j = 1; j <= nm; ++j) { - sum += ck[j - 1]; - if (fabs(sum - sw1) < fabs(sum) * eps) { break; } - sw1 = sum; + for (j = 1; j <= 2 * m + ip; ++j) { + r0 *= j; } + r = r0; + suc = r * df[0]; + sw = 0.0; - r1 = 1.0; - for (j = 1; j <= (n + m + ip) / 2; j++) { - r1 = r1 * (j + 0.5 * (n + m + ip)); + for (k = 2; k <= nm; k++) { + r = r * (m + k - 1.0) * (m + k + ip - 1.5) / (k - 1.0) / (k + ip - 1.5); + suc += r * df[k - 1]; + if ((k > nm1) && (fabs(suc - sw) < fabs(suc) * eps)) { + break; + } + sw = suc; } - r2 = 1.0; - for (j = 1; j <= m; j++) { - r2 *= 2.0 * c * j; - } + if (x == 0.0) { + sckb(m, n, c, df, ck.get()); - r3 = 1.0; - for (j = 1; j <= (n - m - ip) / 2; j++) { - r3 *= j; - } - sa0 = (2.0 * (m + ip) + 1.0) * r1 / (pow(2.0, n) * pow(c, ip) * r2 * r3); + sum = 0.0; + sw1 = 0.0; + for (j = 1; j <= nm; ++j) { + sum += ck[j - 1]; + if (fabs(sum - sw1) < fabs(sum) * eps) { + break; + } + sw1 = sum; + } - if (ip == 0) { - *r1f = sum / (sa0 * suc) * df[0] * reg; - *r1d = 0.0; - } else if (ip == 1) { - *r1f = 0.0; - *r1d = sum / (sa0 * suc) * df[0] * reg; + r1 = 1.0; + for (j = 1; j <= (n + m + ip) / 2; j++) { + r1 = r1 * (j + 0.5 * (n + m + ip)); + } + + r2 = 1.0; + for (j = 1; j <= m; j++) { + r2 *= 2.0 * c * j; + } + + r3 = 1.0; + for (j = 1; j <= (n - m - ip) / 2; j++) { + r3 *= j; + } + sa0 = (2.0 * (m + ip) + 1.0) * r1 / (pow(2.0, n) * pow(c, ip) * r2 * r3); + + if (ip == 0) { + *r1f = sum / (sa0 * suc) * df[0] * reg; + *r1d = 0.0; + } else if (ip == 1) { + *r1f = 0.0; + *r1d = sum / (sa0 * suc) * df[0] * reg; + } + return Status::OK; } - return Status::OK; - } - cx = c * x; - nm2 = 2 * nm + m; - sphj(cx, nm2, &nm2, sj.get(), dj.get()); + cx = c * x; + nm2 = 2 * nm + m; + sphj(cx, nm2, &nm2, sj.get(), dj.get()); - a0 = pow(1.0 - kd / (x * x), 0.5 * m) / suc; - *r1f = 0.0; - sw = 0.0; - lg = 0; + a0 = pow(1.0 - kd / (x * x), 0.5 * m) / suc; + *r1f = 0.0; + sw = 0.0; + lg = 0; - for (k = 1; k <= nm; ++k) { - l = 2 * k + m - n - 2 + ip; - lg = (l % 4 == 0 ? 1 : -1); + for (k = 1; k <= nm; ++k) { + l = 2 * k + m - n - 2 + ip; + lg = (l % 4 == 0 ? 1 : -1); - if (k == 1) { - r = r0; - } else { - r = r * (m + k - 1.0) * (m + k + ip - 1.5) / (k - 1.0) / (k + ip - 1.5); + if (k == 1) { + r = r0; + } else { + r = r * (m + k - 1.0) * (m + k + ip - 1.5) / (k - 1.0) / (k + ip - 1.5); + } + + np = m + 2 * k - 2 + ip; + *r1f += lg * r * df[k - 1] * sj[np]; + + if ((k > nm1) && (fabs(*r1f - sw) < fabs(*r1f) * eps)) { + break; + } + sw = *r1f; } - np = m + 2 * k - 2 + ip; - *r1f += lg * r * df[k - 1] * sj[np]; + *r1f *= a0; + b0 = kd * m / pow(x, 3.0) / (1.0 - kd / (x * x)) * (*r1f); - if ((k > nm1) && (fabs(*r1f - sw) < fabs(*r1f) * eps)) { break; } - sw = *r1f; - } + sud = 0.0; + sw = 0.0; - *r1f *= a0; - b0 = kd * m / pow(x, 3.0) / (1.0 - kd / (x * x)) * (*r1f); + for (k = 1; k <= nm; k++) { + l = 2 * k + m - n - 2 + ip; + lg = (l % 4 == 0 ? 1 : -1); - sud = 0.0; - sw = 0.0; + if (k == 1) { + r = r0; + } else { + r = r * (m + k - 1.0) * (m + k + ip - 1.5) / (k - 1.0) / (k + ip - 1.5); + } - for (k = 1; k <= nm; k++) { - l = 2 * k + m - n - 2 + ip; - lg = (l % 4 == 0 ? 1 : -1); + np = m + 2 * k - 2 + ip; + sud = sud + lg * r * df[k - 1] * dj[np]; - if (k == 1) { - r = r0; - } else { - r = r * (m + k - 1.0) * (m + k + ip - 1.5) / (k - 1.0) / (k + ip - 1.5); + if ((k > nm1) && (fabs(sud - sw) < fabs(sud) * eps)) { + break; + } + sw = sud; } + *r1d = b0 + a0 * c * sud; + return Status::OK; + } - np = m + 2 * k - 2 + ip; - sud = sud + lg * r * df[k - 1] * dj[np]; + template + inline Status rmn2l(int m, int n, T c, T x, int Kd, T *Df, T *R2f, T *R2d, int *Id) { - if ((k > nm1) && (fabs(sud - sw) < fabs(sud) * eps)) { break; } - sw = sud; - } - *r1d = b0 + a0 * c * sud; - return Status::OK; -} - - -template -inline Status rmn2l(int m, int n, T c, T x, int Kd, T *Df, T *R2f, T *R2d, int *Id) { - - // ======================================================== - // Purpose: Compute prolate and oblate spheroidal radial - // functions of the second kind for given m, n, - // c and a large cx - // - // Return value: - // Status::OK - // Normal return. - // Status::NoMemory - // An internal memory allocation failed. - // Status::Other - // An internal convergence check failed. When - // this happens, *Id is set to 10 on return. - // - // Routine called: - // SPHY for computing the spherical Bessel - // functions of the second kind - // ======================================================== - - - int ip, nm1, nm, nm2, np, j, k, l, lg, id1, id2; - T a0, b0, cx, reg, r0, r, suc, sud, sw, eps1, eps2; - const T eps = 1.0e-14; - - auto sy = std::unique_ptr{new (std::nothrow) T[252]()}; - auto dy = std::unique_ptr{new (std::nothrow) T[252]()}; - if (sy.get() == nullptr || dy.get() == nullptr) { - return Status::NoMemory; - } + // ======================================================== + // Purpose: Compute prolate and oblate spheroidal radial + // functions of the second kind for given m, n, + // c and a large cx + // + // Return value: + // Status::OK + // Normal return. + // Status::NoMemory + // An internal memory allocation failed. + // Status::Other + // An internal convergence check failed. When + // this happens, *Id is set to 10 on return. + // + // Routine called: + // SPHY for computing the spherical Bessel + // functions of the second kind + // ======================================================== + + int ip, nm1, nm, nm2, np, j, k, l, lg, id1, id2; + T a0, b0, cx, reg, r0, r, suc, sud, sw, eps1, eps2; + const T eps = 1.0e-14; + + auto sy = std::unique_ptr{new (std::nothrow) T[252]()}; + auto dy = std::unique_ptr{new (std::nothrow) T[252]()}; + if (sy.get() == nullptr || dy.get() == nullptr) { + return Status::NoMemory; + } - ip = 1; - nm1 = (int)((n - m) / 2); - if (n - m == 2 * nm1) { - ip = 0; - } - nm = 25 + nm1 + (int)c; - reg = 1.0; - if (m + nm > 80) { - reg = 1.0e-200; - } - nm2 = 2 * nm + m; - cx = c * x; - sphy(cx, nm2, &nm2, sy.get(), dy.get()); - r0 = reg; + ip = 1; + nm1 = (int)((n - m) / 2); + if (n - m == 2 * nm1) { + ip = 0; + } + nm = 25 + nm1 + (int)c; + reg = 1.0; + if (m + nm > 80) { + reg = 1.0e-200; + } + nm2 = 2 * nm + m; + cx = c * x; + sphy(cx, nm2, &nm2, sy.get(), dy.get()); + r0 = reg; + + for (j = 1; j <= 2 * m + ip; ++j) { + r0 *= j; + } + + r = r0; + suc = r * Df[0]; + sw = 0.0; + + for (k = 2; k <= nm; k++) { + r = r * (m + k - 1.0) * (m + k + ip - 1.5) / (k - 1.0) / (k + ip - 1.5); + suc += r * Df[k - 1]; + if ((k > nm1) && (fabs(suc - sw) < fabs(suc) * eps)) { + break; + } + sw = suc; + } - for (j = 1; j <= 2 * m + ip; ++j) { - r0 *= j; - } + a0 = pow(1.0 - Kd / (x * x), 0.5 * m) / suc; + *R2f = 0.0; + eps1 = 0.0; + np = 0; - r = r0; - suc = r * Df[0]; - sw = 0.0; + for (k = 1; k <= nm; k++) { + l = 2 * k + m - n - 2 + ip; + lg = (l % 4 == 0 ? 1 : -1); - for (k = 2; k <= nm; k++) { - r = r * (m + k - 1.0) * (m + k + ip - 1.5) / (k - 1.0) / (k + ip - 1.5); - suc += r * Df[k - 1]; - if ((k > nm1) && (fabs(suc - sw) < fabs(suc) * eps)) { break; } - sw = suc; - } + if (k == 1) { + r = r0; + } else { + r = r * (m + k - 1.0) * (m + k + ip - 1.5) / (k - 1.0) / (k + ip - 1.5); + } - a0 = pow(1.0 - Kd / (x * x), 0.5 * m) / suc; - *R2f = 0.0; - eps1 = 0.0; - np = 0; + np = m + 2 * k - 2 + ip; + *R2f += lg * r * (Df[k - 1] * sy[np]); + eps1 = fabs(*R2f - sw); + if (k > nm1 && eps1 < fabs(*R2f) * eps) { + break; + } + sw = *R2f; + } - for (k = 1; k <= nm; k++) { - l = 2 * k + m - n - 2 + ip; - lg = (l % 4 == 0 ? 1 : -1); + id1 = (int)(log10(eps1 / fabs(*R2f) + eps)); + *R2f *= a0; - if (k == 1) { - r = r0; - } else { - r = r * (m + k - 1.0) * (m + k + ip - 1.5) / (k - 1.0) / (k + ip - 1.5); + if (np >= nm2) { + // On page 584 of "Computation of Special functions" by Shanjie Zhang + // and Jian-Ming Jin, there is a comment next to this code that says + // this condition indicates that convergence is not achieved, so we + // return Status::Other in addition to setting *Id = 10. But the + // functions that call rmn2l (namely rswfp and rswfo) will actually + // look at the value of Id to check for convergence; the returned + // Status value is only checked for the occurrence of Status::NoMemory. + *Id = 10; + return Status::Other; } - np = m + 2 * k - 2 + ip; - *R2f += lg * r * (Df[k - 1] * sy[np]); - eps1 = fabs(*R2f - sw); - if (k > nm1 && eps1 < fabs(*R2f) * eps) { break; } - sw = *R2f; - } - - id1 = (int)(log10(eps1 / fabs(*R2f) + eps)); - *R2f *= a0; - - if (np >= nm2) { - // On page 584 of "Computation of Special functions" by Shanjie Zhang - // and Jian-Ming Jin, there is a comment next to this code that says - // this condition indicates that convergence is not achieved, so we - // return Status::Other in addition to setting *Id = 10. But the - // functions that call rmn2l (namely rswfp and rswfo) will actually - // look at the value of Id to check for convergence; the returned - // Status value is only checked for the occurrence of Status::NoMemory. - *Id = 10; - return Status::Other; - } + b0 = Kd * m / pow(x, 3) / (1.0 - Kd / (x * x)) * (*R2f); + sud = 0.0; + eps2 = 0.0; - b0 = Kd * m / pow(x, 3) / (1.0 - Kd / (x * x)) * (*R2f); - sud = 0.0; - eps2 = 0.0; + for (k = 1; k <= nm; k++) { + l = 2 * k + m - n - 2 + ip; + lg = (l % 4 == 0 ? 1 : -1); - for (k = 1; k <= nm; k++) { - l = 2 * k + m - n - 2 + ip; - lg = (l % 4 == 0 ? 1 : -1); + if (k == 1) { + r = r0; + } else { + r = r * (m + k - 1.0) * (m + k + ip - 1.5) / (k - 1.0) / (k + ip - 1.5); + } - if (k == 1) { - r = r0; - } else { - r = r * (m + k - 1.0) * (m + k + ip - 1.5) / (k - 1.0) / (k + ip - 1.5); + np = m + 2 * k - 2 + ip; + sud += lg * r * (Df[k - 1] * dy[np]); + eps2 = fabs(sud - sw); + if ((k > nm1) && (eps2 < fabs(sud) * eps)) { + break; + } + sw = sud; } - np = m + 2 * k - 2 + ip; - sud += lg * r * (Df[k - 1] * dy[np]); - eps2 = fabs(sud - sw); - if ((k > nm1) && (eps2 < fabs(sud) * eps)) { break; } - sw = sud; - } - - *R2d = b0 + a0 * c * sud; - id2 = (int)log10(eps2 / fabs(sud) + eps); - *Id = (id1 > id2) ? id1 : id2; - return Status::OK; -} - - -template -inline Status rmn2so(int m, int n, T c, T x, T cv, int kd, T *df, T *r2f, T *r2d) { - - // ============================================================= - // Purpose: Compute oblate radial functions of the second kind - // with a small argument, Rmn(-ic,ix) & Rmn'(-ic,ix) - // - // Return value: - // Status::OK - // Normal return. - // Status::NoMemory - // An internal memory allocation failed. - // - // Routines called: - // (1) SCKB for computing the expansion coefficients c2k - // (2) KMN for computing the joining factors - // (3) QSTAR for computing the factor defined in (15.7.3) - // (4) CBK for computing the expansion coefficient - // defined in (15.7.6) - // (5) GMN for computing the function defined in (15.7.4) - // (6) RMN1 for computing the radial function of the first - // kind - // ============================================================= - - int nm, ip, j; - T ck1, ck2, r1f, r1d, qs, qt, sum, sw, gf, gd, h0; - const T eps = 1.0e-14; - const T pi = 3.141592653589793; - - if (fabs(df[0]) <= 1.0e-280) { - *r2f = 1.0e+300; - *r2d = 1.0e+300; + *R2d = b0 + a0 * c * sud; + id2 = (int)log10(eps2 / fabs(sud) + eps); + *Id = (id1 > id2) ? id1 : id2; return Status::OK; } - auto bk = std::unique_ptr{new (std::nothrow) T[200]()}; - auto ck = std::unique_ptr{new (std::nothrow) T[200]()}; - auto dn = std::unique_ptr{new (std::nothrow) T[200]()}; - if (bk.get() == nullptr || ck.get() == nullptr || dn.get() == nullptr) { - return Status::NoMemory; - } - - nm = 25 + (int)((n - m) / 2 + c); - ip = (n - m) % 2; - sckb(m, n, c, df, ck.get()); - if (kmn(m, n, c, cv, kd, df, dn.get(), &ck1, &ck2) == Status::NoMemory) { - return Status::NoMemory; - } - if (qstar(m, n, c, ck1, ck.get(), &qs, &qt) == Status::NoMemory) { - return Status::NoMemory; - } - if (cbk(m, n, c, cv, qt, ck.get(), bk.get()) == Status::NoMemory) { - return Status::NoMemory; - } + template + inline Status rmn2so(int m, int n, T c, T x, T cv, int kd, T *df, T *r2f, T *r2d) { - if (x == 0.0) { - sum = 0.0; - sw = 0.0; + // ============================================================= + // Purpose: Compute oblate radial functions of the second kind + // with a small argument, Rmn(-ic,ix) & Rmn'(-ic,ix) + // + // Return value: + // Status::OK + // Normal return. + // Status::NoMemory + // An internal memory allocation failed. + // + // Routines called: + // (1) SCKB for computing the expansion coefficients c2k + // (2) KMN for computing the joining factors + // (3) QSTAR for computing the factor defined in (15.7.3) + // (4) CBK for computing the expansion coefficient + // defined in (15.7.6) + // (5) GMN for computing the function defined in (15.7.4) + // (6) RMN1 for computing the radial function of the first + // kind + // ============================================================= + + int nm, ip, j; + T ck1, ck2, r1f, r1d, qs, qt, sum, sw, gf, gd, h0; + const T eps = 1.0e-14; + const T pi = 3.141592653589793; + + if (fabs(df[0]) <= 1.0e-280) { + *r2f = 1.0e+300; + *r2d = 1.0e+300; + return Status::OK; + } - for (j = 0; j < nm; ++j) { - sum += ck[j]; - if (fabs(sum - sw) < fabs(sum) * eps) { break; } - sw = sum; + auto bk = std::unique_ptr{new (std::nothrow) T[200]()}; + auto ck = std::unique_ptr{new (std::nothrow) T[200]()}; + auto dn = std::unique_ptr{new (std::nothrow) T[200]()}; + if (bk.get() == nullptr || ck.get() == nullptr || dn.get() == nullptr) { + return Status::NoMemory; } - if (ip == 0) { - r1f = sum / ck1; - *r2f = -0.5 * pi * qs * r1f; - *r2d = qs * r1f + bk[0]; - } else { - r1d = sum / ck1; - *r2f = bk[0]; - *r2d = -0.5 * pi * qs * r1d; + nm = 25 + (int)((n - m) / 2 + c); + ip = (n - m) % 2; + sckb(m, n, c, df, ck.get()); + if (kmn(m, n, c, cv, kd, df, dn.get(), &ck1, &ck2) == Status::NoMemory) { + return Status::NoMemory; } - } else { - gmn(m, n, c, x, bk.get(), &gf, &gd); - if (rmn1(m, n, c, x, kd, df, &r1f, &r1d) == Status::NoMemory) { + if (qstar(m, n, c, ck1, ck.get(), &qs, &qt) == Status::NoMemory) { + return Status::NoMemory; + } + if (cbk(m, n, c, cv, qt, ck.get(), bk.get()) == Status::NoMemory) { return Status::NoMemory; } - h0 = atan(x) - 0.5 * pi; - *r2f = qs * r1f * h0 + gf; - *r2d = qs * (r1d * h0 + r1f / (1.0 + x * x)) + gd; - } - return Status::OK; -} - - -template -Status rmn2sp(int m, int n, T c, T x, T cv, int kd, T *df, T *r2f, T *r2d) { - - // ====================================================== - // Purpose: Compute prolate spheroidal radial function - // of the second kind with a small argument - // - // Return value: - // Status::OK - // Normal return. - // Status::NoMemory - // An internal memory allocation failed. - // - // Routines called: - // (1) LPMNS for computing the associated Legendre - // functions of the first kind - // (2) LQMNS for computing the associated Legendre - // functions of the second kind - // (3) KMN for computing expansion coefficients - // and joining factors - // ====================================================== - - int k, j, j1, j2, l1, ki, nm3; - T ip, nm1, nm, nm2, su0, sw, sd0, su1, sd1, sd2, ga, r1, r2, r3, - sf, gb, spl, gc, sd, r4, spd1, spd2, su2, ck1, ck2, sum, sdm; - - // fortran index start from 0 - auto pm = std::unique_ptr{new (std::nothrow) T[252]}; - auto pd = std::unique_ptr{new (std::nothrow) T[252]}; - auto qm = std::unique_ptr{new (std::nothrow) T[252]}; - auto qd = std::unique_ptr{new (std::nothrow) T[252]}; - // fortran index start from 1 - auto dn = std::unique_ptr{new (std::nothrow) T[201]}; - - if (pm.get() == nullptr || pd.get() == nullptr || qm.get() == nullptr - || qd.get() == nullptr || dn.get() == nullptr) { - return Status::NoMemory; - } - const T eps = 1.0e-14; + if (x == 0.0) { + sum = 0.0; + sw = 0.0; - nm1 = (n - m) / 2; - nm = 25.0 + nm1 + c; - nm2 = 2 * nm + m; - ip = (n - m) % 2; + for (j = 0; j < nm; ++j) { + sum += ck[j]; + if (fabs(sum - sw) < fabs(sum) * eps) { + break; + } + sw = sum; + } - if (kmn(m, n, c, cv, kd, df, dn.get(), &ck1, &ck2) == Status::NoMemory) { - return Status::NoMemory; - } - lpmns(m, nm2, x, pm.get(), pd.get()); - lqmns(m, nm2, x, qm.get(), qd.get()); - - su0 = 0.0; - sw = 0.0; - for (k = 1; k <= nm; k++) { - j = 2 * k - 2 + m + ip; - su0 += df[k - 1] * qm[j]; - if ((k > nm1) && (fabs(su0 - sw) < fabs(su0) * eps)) { break; } - sw = su0; + if (ip == 0) { + r1f = sum / ck1; + *r2f = -0.5 * pi * qs * r1f; + *r2d = qs * r1f + bk[0]; + } else { + r1d = sum / ck1; + *r2f = bk[0]; + *r2d = -0.5 * pi * qs * r1d; + } + } else { + gmn(m, n, c, x, bk.get(), &gf, &gd); + if (rmn1(m, n, c, x, kd, df, &r1f, &r1d) == Status::NoMemory) { + return Status::NoMemory; + } + h0 = atan(x) - 0.5 * pi; + *r2f = qs * r1f * h0 + gf; + *r2d = qs * (r1d * h0 + r1f / (1.0 + x * x)) + gd; + } + return Status::OK; } - sd0 = 0.0; - for (k = 1; k <= nm; k++) { - j = 2 * k - 2 + m + ip; - sd0 += df[k - 1] * qd[j]; - if (k > nm1 && fabs(sd0 - sw) < fabs(sd0) * eps) { break; } - sw = sd0; - } + template + Status rmn2sp(int m, int n, T c, T x, T cv, int kd, T *df, T *r2f, T *r2d) { - su1 = 0.0; - sd1 = 0.0; - for (k = 1; k <= m; k++) { - j = m - 2 * k + ip; - if (j < 0) { - j = -j - 1; + // ====================================================== + // Purpose: Compute prolate spheroidal radial function + // of the second kind with a small argument + // + // Return value: + // Status::OK + // Normal return. + // Status::NoMemory + // An internal memory allocation failed. + // + // Routines called: + // (1) LPMNS for computing the associated Legendre + // functions of the first kind + // (2) LQMNS for computing the associated Legendre + // functions of the second kind + // (3) KMN for computing expansion coefficients + // and joining factors + // ====================================================== + + int k, j, j1, j2, l1, ki, nm3; + T ip, nm1, nm, nm2, su0, sw, sd0, su1, sd1, sd2, ga, r1, r2, r3, sf, gb, spl, gc, sd, r4, spd1, spd2, su2, ck1, + ck2, sum, sdm; + + // fortran index start from 0 + auto pm = std::unique_ptr{new (std::nothrow) T[252]}; + auto pd = std::unique_ptr{new (std::nothrow) T[252]}; + auto qm = std::unique_ptr{new (std::nothrow) T[252]}; + auto qd = std::unique_ptr{new (std::nothrow) T[252]}; + // fortran index start from 1 + auto dn = std::unique_ptr{new (std::nothrow) T[201]}; + + if (pm.get() == nullptr || pd.get() == nullptr || qm.get() == nullptr || qd.get() == nullptr || + dn.get() == nullptr) { + return Status::NoMemory; } - su1 += dn[k - 1] * qm[j]; - sd1 += dn[k - 1] * qd[j]; - } - ga = pow((x - 1.0) / (x + 1.0), 0.5 * m); - for (k = 1; k <= m; k++) { - j = m - 2 * k + ip; - if (j >= 0) { continue; } - if (j < 0) { j = -j - 1; } - r1 = 1.0; - for (j1 = 0; j1 < j; j1++) { - r1 *= (m + j1); + const T eps = 1.0e-14; + + nm1 = (n - m) / 2; + nm = 25.0 + nm1 + c; + nm2 = 2 * nm + m; + ip = (n - m) % 2; + + if (kmn(m, n, c, cv, kd, df, dn.get(), &ck1, &ck2) == Status::NoMemory) { + return Status::NoMemory; } - r2 = 1.0; - for (j2 = 1; j2 <= (m - j - 2); j2++) { - r2 *= j2; + lpmns(m, nm2, x, pm.get(), pd.get()); + lqmns(m, nm2, x, qm.get(), qd.get()); + + su0 = 0.0; + sw = 0.0; + for (k = 1; k <= nm; k++) { + j = 2 * k - 2 + m + ip; + su0 += df[k - 1] * qm[j]; + if ((k > nm1) && (fabs(su0 - sw) < fabs(su0) * eps)) { + break; + } + sw = su0; } - r3 = 1.0; - sf = 1.0; - for (l1 = 1; l1 <= j; l1++) { - r3 = 0.5 * r3 * (-j + l1 - 1.0) * (j + l1) / ((m + l1) * l1) * (1.0 - x); - sf += r3; - } - if (m - j >= 2) { - gb = (m - j - 1.0) * r2; - } - if (m - j <= 1) { - gb = 1.0; - } - spl = r1 * ga * gb * sf; - su1 += pow(-1, (j + m)) * dn[k-1] * spl; - spd1 = m / (x * x - 1.0) * spl; - gc = 0.5 * j * (j + 1.0) / (m + 1.0); - sd = 1.0; - r4 = 1.0; - for (l1 = 1; l1 <= j - 1; l1++) { - r4 = 0.5 * r4 * (-j + l1) * (j + l1 + 1.0) / ((m + l1 + 1.0) * l1) * (1.0 - x); - sd += r4; + + sd0 = 0.0; + for (k = 1; k <= nm; k++) { + j = 2 * k - 2 + m + ip; + sd0 += df[k - 1] * qd[j]; + if (k > nm1 && fabs(sd0 - sw) < fabs(sd0) * eps) { + break; + } + sw = sd0; + } + + su1 = 0.0; + sd1 = 0.0; + for (k = 1; k <= m; k++) { + j = m - 2 * k + ip; + if (j < 0) { + j = -j - 1; + } + su1 += dn[k - 1] * qm[j]; + sd1 += dn[k - 1] * qd[j]; } - spd2 = r1 * ga * gb * gc * sd; - sd1 += pow(-1, (j + m)) * dn[k - 1] * (spd1 + spd2); - } - su2 = 0.0; - ki = (2 * m + 1 + ip) / 2; - ki = std::max(1, ki); - assert((ki-1) >= 0); - nm3 = nm + ki; - for (k = ki; k <= nm3; k++) { - j = 2 * k - 1 - m - ip; - su2 += dn[k - 1] * pm[j]; - if ((j > m) && (fabs(su2 - sw) < fabs(su2) * eps)) { break; } - sw = su2; - } - sd2 = 0.0; - for (k = ki; k < nm3; k++) { - j = 2 * k - 1 - m - ip; - sd2 += dn[k - 1] * pd[j]; - if (j > m && fabs(sd2 - sw) < fabs(sd2) * eps) { break; } - sw = sd2; - } - sum = su0 + su1 + su2; - sdm = sd0 + sd1 + sd2; - *r2f = sum / ck2; - *r2d = sdm / ck2; - return Status::OK; -} - - -template -inline Status rswfp(int m, int n, T c, T x, T cv, int kf, T *r1f, T *r1d, T *r2f, T *r2d) { - - // ============================================================== - // Purpose: Compute prolate spheriodal radial functions of the - // first and second kinds, and their derivatives - // Input : m --- Mode parameter, m = 0,1,2,... - // n --- Mode parameter, n = m,m+1,m+2,... - // c --- Spheroidal parameter - // x --- Argument of radial function ( x > 1.0 ) - // cv --- Characteristic value - // KF --- Function code - // KF=1 for the first kind - // KF=2 for the second kind - // KF=3 for both the first and second kinds - // Output: R1F --- Radial function of the first kind - // R1D --- Derivative of the radial function of - // the first kind - // R2F --- Radial function of the second kind - // R2D --- Derivative of the radial function of - // the second kind - // Return value: - // Status::OK - // Normal return. - // Status::NoMemory - // An internal memory allocation failed. - // - // Routines called: - // (1) SDMN for computing expansion coefficients dk - // (2) RMN1 for computing prolate and oblate radial - // functions of the first kind - // (3) RMN2L for computing prolate and oblate radial - // functions of the second kind for a large argument - // (4) RMN2SP for computing the prolate radial function - // of the second kind for a small argument - // ============================================================== - - auto df = std::unique_ptr{new (std::nothrow) T[200]}; - if (df.get() == nullptr) { - return Status::NoMemory; - } - int id, kd = 1; - if (sdmn(m, n, c, cv, kd, df.get()) == Status::NoMemory) { - return Status::NoMemory; + ga = pow((x - 1.0) / (x + 1.0), 0.5 * m); + for (k = 1; k <= m; k++) { + j = m - 2 * k + ip; + if (j >= 0) { + continue; + } + if (j < 0) { + j = -j - 1; + } + r1 = 1.0; + for (j1 = 0; j1 < j; j1++) { + r1 *= (m + j1); + } + r2 = 1.0; + for (j2 = 1; j2 <= (m - j - 2); j2++) { + r2 *= j2; + } + r3 = 1.0; + sf = 1.0; + for (l1 = 1; l1 <= j; l1++) { + r3 = 0.5 * r3 * (-j + l1 - 1.0) * (j + l1) / ((m + l1) * l1) * (1.0 - x); + sf += r3; + } + if (m - j >= 2) { + gb = (m - j - 1.0) * r2; + } + if (m - j <= 1) { + gb = 1.0; + } + spl = r1 * ga * gb * sf; + su1 += pow(-1, (j + m)) * dn[k - 1] * spl; + spd1 = m / (x * x - 1.0) * spl; + gc = 0.5 * j * (j + 1.0) / (m + 1.0); + sd = 1.0; + r4 = 1.0; + for (l1 = 1; l1 <= j - 1; l1++) { + r4 = 0.5 * r4 * (-j + l1) * (j + l1 + 1.0) / ((m + l1 + 1.0) * l1) * (1.0 - x); + sd += r4; + } + spd2 = r1 * ga * gb * gc * sd; + sd1 += pow(-1, (j + m)) * dn[k - 1] * (spd1 + spd2); + } + su2 = 0.0; + ki = (2 * m + 1 + ip) / 2; + ki = std::max(1, ki); + assert((ki - 1) >= 0); + nm3 = nm + ki; + for (k = ki; k <= nm3; k++) { + j = 2 * k - 1 - m - ip; + su2 += dn[k - 1] * pm[j]; + if ((j > m) && (fabs(su2 - sw) < fabs(su2) * eps)) { + break; + } + sw = su2; + } + sd2 = 0.0; + for (k = ki; k < nm3; k++) { + j = 2 * k - 1 - m - ip; + sd2 += dn[k - 1] * pd[j]; + if (j > m && fabs(sd2 - sw) < fabs(sd2) * eps) { + break; + } + sw = sd2; + } + sum = su0 + su1 + su2; + sdm = sd0 + sd1 + sd2; + *r2f = sum / ck2; + *r2d = sdm / ck2; + return Status::OK; } - if (kf != 2) { - if (rmn1(m, n, c, x, kd, df.get(), r1f, r1d) == Status::NoMemory) { + template + inline Status rswfp(int m, int n, T c, T x, T cv, int kf, T *r1f, T *r1d, T *r2f, T *r2d) { + + // ============================================================== + // Purpose: Compute prolate spheriodal radial functions of the + // first and second kinds, and their derivatives + // Input : m --- Mode parameter, m = 0,1,2,... + // n --- Mode parameter, n = m,m+1,m+2,... + // c --- Spheroidal parameter + // x --- Argument of radial function ( x > 1.0 ) + // cv --- Characteristic value + // KF --- Function code + // KF=1 for the first kind + // KF=2 for the second kind + // KF=3 for both the first and second kinds + // Output: R1F --- Radial function of the first kind + // R1D --- Derivative of the radial function of + // the first kind + // R2F --- Radial function of the second kind + // R2D --- Derivative of the radial function of + // the second kind + // Return value: + // Status::OK + // Normal return. + // Status::NoMemory + // An internal memory allocation failed. + // + // Routines called: + // (1) SDMN for computing expansion coefficients dk + // (2) RMN1 for computing prolate and oblate radial + // functions of the first kind + // (3) RMN2L for computing prolate and oblate radial + // functions of the second kind for a large argument + // (4) RMN2SP for computing the prolate radial function + // of the second kind for a small argument + // ============================================================== + + auto df = std::unique_ptr{new (std::nothrow) T[200]}; + if (df.get() == nullptr) { return Status::NoMemory; } - } - if (kf > 1) { - if (rmn2l(m, n, c, x, kd, df.get(), r2f, r2d, &id) == Status::NoMemory) { + int id, kd = 1; + + if (sdmn(m, n, c, cv, kd, df.get()) == Status::NoMemory) { return Status::NoMemory; } - if (id > -8) { - if (rmn2sp(m, n, c, x, cv, kd, df.get(), r2f, r2d) == Status::NoMemory) { + + if (kf != 2) { + if (rmn1(m, n, c, x, kd, df.get(), r1f, r1d) == Status::NoMemory) { return Status::NoMemory; } } + if (kf > 1) { + if (rmn2l(m, n, c, x, kd, df.get(), r2f, r2d, &id) == Status::NoMemory) { + return Status::NoMemory; + } + if (id > -8) { + if (rmn2sp(m, n, c, x, cv, kd, df.get(), r2f, r2d) == Status::NoMemory) { + return Status::NoMemory; + } + } + } + return Status::OK; } - return Status::OK; -} - - -template -Status rswfo(int m, int n, T c, T x, T cv, int kf, T *r1f, T *r1d, T *r2f, T *r2d) { - - // ========================================================== - // Purpose: Compute oblate radial functions of the first - // and second kinds, and their derivatives - // Input : m --- Mode parameter, m = 0,1,2,... - // n --- Mode parameter, n = m,m+1,m+2,... - // c --- Spheroidal parameter - // x --- Argument (x ≥ 0) - // cv --- Characteristic value - // KF --- Function code - // KF=1 for the first kind - // KF=2 for the second kind - // KF=3 for both the first and second kinds - // Output: R1F --- Radial function of the first kind - // R1D --- Derivative of the radial function of - // the first kind - // R2F --- Radial function of the second kind - // R2D --- Derivative of the radial function of - // the second kind - // Return value: - // Status::OK - // Normal return. - // Status::NoMemory - // An internal memory allocation failed. - // - // Routines called: - // (1) SDMN for computing expansion coefficients dk - // (2) RMN1 for computing prolate or oblate radial - // function of the first kind - // (3) RMN2L for computing prolate or oblate radial - // function of the second kind for a large argument - // (4) RMN2SO for computing oblate radial functions of - // the second kind for a small argument - // ========================================================== - - auto df = std::unique_ptr{new (std::nothrow) T[200]}; - if (df.get() == nullptr) { - return Status::NoMemory; - } - int id, kd = -1; - if (sdmn(m, n, c, cv, kd, df.get()) == Status::NoMemory) { - return Status::NoMemory; - } + template + Status rswfo(int m, int n, T c, T x, T cv, int kf, T *r1f, T *r1d, T *r2f, T *r2d) { + + // ========================================================== + // Purpose: Compute oblate radial functions of the first + // and second kinds, and their derivatives + // Input : m --- Mode parameter, m = 0,1,2,... + // n --- Mode parameter, n = m,m+1,m+2,... + // c --- Spheroidal parameter + // x --- Argument (x ≥ 0) + // cv --- Characteristic value + // KF --- Function code + // KF=1 for the first kind + // KF=2 for the second kind + // KF=3 for both the first and second kinds + // Output: R1F --- Radial function of the first kind + // R1D --- Derivative of the radial function of + // the first kind + // R2F --- Radial function of the second kind + // R2D --- Derivative of the radial function of + // the second kind + // Return value: + // Status::OK + // Normal return. + // Status::NoMemory + // An internal memory allocation failed. + // + // Routines called: + // (1) SDMN for computing expansion coefficients dk + // (2) RMN1 for computing prolate or oblate radial + // function of the first kind + // (3) RMN2L for computing prolate or oblate radial + // function of the second kind for a large argument + // (4) RMN2SO for computing oblate radial functions of + // the second kind for a small argument + // ========================================================== + + auto df = std::unique_ptr{new (std::nothrow) T[200]}; + if (df.get() == nullptr) { + return Status::NoMemory; + } + int id, kd = -1; - if (kf != 2) { - if (rmn1(m, n, c, x, kd, df.get(), r1f, r1d) == Status::NoMemory) { + if (sdmn(m, n, c, cv, kd, df.get()) == Status::NoMemory) { return Status::NoMemory; } - } - if (kf > 1) { - id = 10; - if (x > 1e-8) { - if (rmn2l(m, n, c, x, kd, df.get(), r2f, r2d, &id) == Status::NoMemory) { + + if (kf != 2) { + if (rmn1(m, n, c, x, kd, df.get(), r1f, r1d) == Status::NoMemory) { return Status::NoMemory; } } - if (id > -1) { - if (rmn2so(m, n, c, x, cv, kd, df.get(), r2f, r2d) == Status::NoMemory) { - return Status::NoMemory; + if (kf > 1) { + id = 10; + if (x > 1e-8) { + if (rmn2l(m, n, c, x, kd, df.get(), r2f, r2d, &id) == Status::NoMemory) { + return Status::NoMemory; + } + } + if (id > -1) { + if (rmn2so(m, n, c, x, cv, kd, df.get(), r2f, r2d) == Status::NoMemory) { + return Status::NoMemory; + } } } - } - return Status::OK; -} - - -template -void sckb(int m, int n, T c, T *df, T *ck) { - - // ====================================================== - // Purpose: Compute the expansion coefficients of the - // prolate and oblate spheroidal functions - // Input : m --- Mode parameter - // n --- Mode parameter - // c --- Spheroidal parameter - // DF(k) --- Expansion coefficients dk - // Output: CK(k) --- Expansion coefficients ck; - // CK(1), CK(2), ... correspond to - // c0, c2, ... - // ====================================================== - - int i, ip, i1, i2, k, nm; - T reg, fac, sw, r, d1, d2, d3, sum, r1; - - if (c <= 1.0e-10) { - c = 1.0e-10; - } - nm = 25 + (int)(0.5 * (n - m) + c); - ip = (n - m) % 2; - reg = ((m + nm) > 80 ? 1.0e-200 : 1.0); - fac = -pow(0.5, m); - sw = 0.0; - - for (k = 0; k < nm; k++) { - fac = -fac; - i1 = 2 * k + ip + 1; - r = reg; - - for (i = i1; i <= i1 + 2 * m - 1; i++) { - r *= i; - } - i2 = k + m + ip; - for (i = i2; i <= i2 + k - 1; i++) { - r *= (i + 0.5); - } - sum = r * df[k]; - for (i = k + 1; i <= nm; i++) { - d1 = 2.0 * i + ip; - d2 = 2.0 * m + d1; - d3 = i + m + ip - 0.5; - r = r * d2 * (d2 - 1.0) * i * (d3 + k) / (d1 * (d1 - 1.0) * (i - k) * d3); - sum += r * df[i]; - if (fabs(sw - sum) < fabs(sum) * 1.0e-14) { break; } - sw = sum; - } - r1 = reg; - for (i = 2; i <= m + k; i++) { r1 *= i; } - ck[k] = fac * sum / r1; - } -} - - -template -Status sdmn(int m, int n, T c, T cv, int kd, T *df) { - - // ===================================================== - // Purpose: Compute the expansion coefficients of the - // prolate and oblate spheroidal functions, dk - // Input : m --- Mode parameter - // n --- Mode parameter - // c --- Spheroidal parameter - // cv --- Characteristic value - // KD --- Function code - // KD=1 for prolate; KD=-1 for oblate - // Output: DF(k) --- Expansion coefficients dk; - // DF(1), DF(2), ... correspond to - // d0, d2, ... for even n-m and d1, - // d3, ... for odd n-m - // Return value: - // Status::OK - // Normal return. - // Status::NoMemory - // An internal memory allocation failed. - // ===================================================== - - int nm, ip, k, kb; - T cs, dk0, dk1, dk2, d2k, f, fs, f1, f0, fl, f2, su1,\ - su2, sw, r1, r3, r4, s0; - - nm = 25 + (int)(0.5 * (n - m) + c); - - if (c < 1e-10) { - for (int i = 1; i <= nm; ++i) { - df[i-1] = 0.0; - } - df[(n - m) / 2] = 1.0; return Status::OK; } - auto a = std::unique_ptr{new (std::nothrow) T[nm + 2]()}; - auto d = std::unique_ptr{new (std::nothrow) T[nm + 2]()}; - auto g = std::unique_ptr{new (std::nothrow) T[nm + 2]()}; - if (a.get() == nullptr || d.get() == nullptr || g.get() == nullptr) { - return Status::NoMemory; - } - cs = c*c*kd; - ip = (n - m) % 2; + template + void sckb(int m, int n, T c, T *df, T *ck) { - for (int i = 1; i <= nm + 2; ++i) { - k = (ip == 0 ? 2 * (i - 1) : 2 * i - 1); + // ====================================================== + // Purpose: Compute the expansion coefficients of the + // prolate and oblate spheroidal functions + // Input : m --- Mode parameter + // n --- Mode parameter + // c --- Spheroidal parameter + // DF(k) --- Expansion coefficients dk + // Output: CK(k) --- Expansion coefficients ck; + // CK(1), CK(2), ... correspond to + // c0, c2, ... + // ====================================================== - dk0 = m + k; - dk1 = m + k + 1; - dk2 = 2 * (m + k); - d2k = 2 * m + k; + int i, ip, i1, i2, k, nm; + T reg, fac, sw, r, d1, d2, d3, sum, r1; - a[i - 1] = (d2k + 2.0) * (d2k + 1.0) / ((dk2 + 3.0) * (dk2 + 5.0)) * cs; - d[i - 1] = dk0 * dk1 + (2.0 * dk0 * dk1 - 2.0 * m * m - 1.0) / ((dk2 - 1.0) * (dk2 + 3.0)) * cs; - g[i - 1] = k * (k - 1.0) / ((dk2 - 3.0) * (dk2 - 1.0)) * cs; - } + if (c <= 1.0e-10) { + c = 1.0e-10; + } + nm = 25 + (int)(0.5 * (n - m) + c); + ip = (n - m) % 2; + reg = ((m + nm) > 80 ? 1.0e-200 : 1.0); + fac = -pow(0.5, m); + sw = 0.0; + + for (k = 0; k < nm; k++) { + fac = -fac; + i1 = 2 * k + ip + 1; + r = reg; - fs = 1.0; - f1 = 0.0; - f0 = 1.0e-100; - kb = 0; - df[nm] = 0.0; - fl = 0.0; + for (i = i1; i <= i1 + 2 * m - 1; i++) { + r *= i; + } + i2 = k + m + ip; + for (i = i2; i <= i2 + k - 1; i++) { + r *= (i + 0.5); + } + sum = r * df[k]; + for (i = k + 1; i <= nm; i++) { + d1 = 2.0 * i + ip; + d2 = 2.0 * m + d1; + d3 = i + m + ip - 0.5; + r = r * d2 * (d2 - 1.0) * i * (d3 + k) / (d1 * (d1 - 1.0) * (i - k) * d3); + sum += r * df[i]; + if (fabs(sw - sum) < fabs(sum) * 1.0e-14) { + break; + } + sw = sum; + } + r1 = reg; + for (i = 2; i <= m + k; i++) { + r1 *= i; + } + ck[k] = fac * sum / r1; + } + } + + template + Status sdmn(int m, int n, T c, T cv, int kd, T *df) { + + // ===================================================== + // Purpose: Compute the expansion coefficients of the + // prolate and oblate spheroidal functions, dk + // Input : m --- Mode parameter + // n --- Mode parameter + // c --- Spheroidal parameter + // cv --- Characteristic value + // KD --- Function code + // KD=1 for prolate; KD=-1 for oblate + // Output: DF(k) --- Expansion coefficients dk; + // DF(1), DF(2), ... correspond to + // d0, d2, ... for even n-m and d1, + // d3, ... for odd n-m + // Return value: + // Status::OK + // Normal return. + // Status::NoMemory + // An internal memory allocation failed. + // ===================================================== + + int nm, ip, k, kb; + T cs, dk0, dk1, dk2, d2k, f, fs, f1, f0, fl, f2, su1, su2, sw, r1, r3, r4, s0; + + nm = 25 + (int)(0.5 * (n - m) + c); + + if (c < 1e-10) { + for (int i = 1; i <= nm; ++i) { + df[i - 1] = 0.0; + } + df[(n - m) / 2] = 1.0; + return Status::OK; + } - for (int k = nm; k >= 1; k--) { - f = -((d[k] - cv) * f0 + a[k] * f1) / g[k]; + auto a = std::unique_ptr{new (std::nothrow) T[nm + 2]()}; + auto d = std::unique_ptr{new (std::nothrow) T[nm + 2]()}; + auto g = std::unique_ptr{new (std::nothrow) T[nm + 2]()}; + if (a.get() == nullptr || d.get() == nullptr || g.get() == nullptr) { + return Status::NoMemory; + } + cs = c * c * kd; + ip = (n - m) % 2; - if (fabs(f) > fabs(df[k])) { - df[k-1] = f; - f1 = f0; - f0 = f; + for (int i = 1; i <= nm + 2; ++i) { + k = (ip == 0 ? 2 * (i - 1) : 2 * i - 1); - if (fabs(f) > 1.0e+100) { - for (int k1 = k; k1 <= nm; k1++) - df[k1 - 1] *= 1.0e-100; - f1 *= 1.0e-100; - f0 *= 1.0e-100; - } - } else { - kb = k; - fl = df[k]; - f1 = 1.0e-100; - f2 = -((d[0] - cv) / a[0]) * f1; - df[0] = f1; - - if (kb == 1) { - fs = f2; - } else if (kb == 2) { - df[1] = f2; - fs = -((d[1] - cv) * f2 + g[1] * f1) / a[1]; + dk0 = m + k; + dk1 = m + k + 1; + dk2 = 2 * (m + k); + d2k = 2 * m + k; + + a[i - 1] = (d2k + 2.0) * (d2k + 1.0) / ((dk2 + 3.0) * (dk2 + 5.0)) * cs; + d[i - 1] = dk0 * dk1 + (2.0 * dk0 * dk1 - 2.0 * m * m - 1.0) / ((dk2 - 1.0) * (dk2 + 3.0)) * cs; + g[i - 1] = k * (k - 1.0) / ((dk2 - 3.0) * (dk2 - 1.0)) * cs; + } + + fs = 1.0; + f1 = 0.0; + f0 = 1.0e-100; + kb = 0; + df[nm] = 0.0; + fl = 0.0; + + for (int k = nm; k >= 1; k--) { + f = -((d[k] - cv) * f0 + a[k] * f1) / g[k]; + + if (fabs(f) > fabs(df[k])) { + df[k - 1] = f; + f1 = f0; + f0 = f; + + if (fabs(f) > 1.0e+100) { + for (int k1 = k; k1 <= nm; k1++) + df[k1 - 1] *= 1.0e-100; + f1 *= 1.0e-100; + f0 *= 1.0e-100; + } } else { - df[1] = f2; + kb = k; + fl = df[k]; + f1 = 1.0e-100; + f2 = -((d[0] - cv) / a[0]) * f1; + df[0] = f1; + + if (kb == 1) { + fs = f2; + } else if (kb == 2) { + df[1] = f2; + fs = -((d[1] - cv) * f2 + g[1] * f1) / a[1]; + } else { + df[1] = f2; - for (int j = 3; j <= kb + 1; j++) { - f = -((d[j - 2] - cv) * f2 + g[j - 2] * f1) / a[j - 2]; - if (j <= kb) { - df[j-1] = f; - } - if (fabs(f) > 1.0e+100) { - for (int k1 = 1; k1 <= j; k1++) { - df[k1 - 1] *= 1.0e-100; + for (int j = 3; j <= kb + 1; j++) { + f = -((d[j - 2] - cv) * f2 + g[j - 2] * f1) / a[j - 2]; + if (j <= kb) { + df[j - 1] = f; } - f *= 1.0e-100; - f2 *= 1.0e-100; + if (fabs(f) > 1.0e+100) { + for (int k1 = 1; k1 <= j; k1++) { + df[k1 - 1] *= 1.0e-100; + } + f *= 1.0e-100; + f2 *= 1.0e-100; + } + f1 = f2; + f2 = f; } - f1 = f2; - f2 = f; + fs = f; } - fs = f; + break; } - break; } - } - - su1 = 0.0; - r1 = 1.0; - - for (int j = m + ip + 1; j <= 2 * (m + ip); j++) { - r1 *= j; - } - su1 = df[0] * r1; - for (int k = 2; k <= kb; k++) { - r1 = -r1 * (k + m + ip - 1.5) / (k - 1.0); - su1 += r1 * df[k - 1]; - } + su1 = 0.0; + r1 = 1.0; - su2 = 0.0; - sw = 0.0; + for (int j = m + ip + 1; j <= 2 * (m + ip); j++) { + r1 *= j; + } + su1 = df[0] * r1; - for (int k = kb + 1; k <= nm; k++) { - if (k != 1) { + for (int k = 2; k <= kb; k++) { r1 = -r1 * (k + m + ip - 1.5) / (k - 1.0); + su1 += r1 * df[k - 1]; } - su2 += r1 * df[k - 1]; - if (fabs(sw - su2) < fabs(su2) * 1.0e-14) { break; } - sw = su2; - } - r3 = 1.0; + su2 = 0.0; + sw = 0.0; - for (int j = 1; j <= (m + n + ip) / 2; j++) { - r3 *= (j + 0.5 * (n + m + ip)); - } - r4 = 1.0; + for (int k = kb + 1; k <= nm; k++) { + if (k != 1) { + r1 = -r1 * (k + m + ip - 1.5) / (k - 1.0); + } + su2 += r1 * df[k - 1]; - for (int j = 1; j <= (n - m - ip) / 2; j++) { - r4 *= -4.0 * j; - } - s0 = r3 / (fl * (su1 / fs) + su2) / r4; + if (fabs(sw - su2) < fabs(su2) * 1.0e-14) { + break; + } + sw = su2; + } + r3 = 1.0; - for (int k = 1; k <= kb; ++k) { - df[k - 1] *= fl / fs * s0; - } - for (int k = kb + 1; k <= nm; ++k) { - df[k - 1] *= s0; - } - return Status::OK; -} - - -template -Status segv(int m, int n, T c, int kd, T *cv, T *eg) { - - // ========================================================= - // Purpose: Compute the characteristic values of spheroidal - // wave functions - // Input : m --- Mode parameter - // n --- Mode parameter - // c --- Spheroidal parameter - // KD --- Function code - // KD=1 for Prolate; KD=-1 for Oblate - // Output: CV --- Characteristic value for given m, n and c - // EG(L) --- Characteristic value for mode m and n' - // ( L = n' - m + 1 ) - // Return value: - // Status::OK - // Normal return. - // Status::NoMemory - // An internal memory allocation failed. - // ========================================================= - - - int i, icm, j, k, k1, l, nm, nm1; - T cs, dk0, dk1, dk2, d2k, s, t, t1, x1, xa, xb; - // eg[<=200] is supplied by the caller - - if (c < 1e-10) { - for (i = 1; i <= (n-m+1); i++) { - eg[i-1] = (i+m) * (i + m -1); - } - *cv = eg[n-m]; + for (int j = 1; j <= (m + n + ip) / 2; j++) { + r3 *= (j + 0.5 * (n + m + ip)); + } + r4 = 1.0; + + for (int j = 1; j <= (n - m - ip) / 2; j++) { + r4 *= -4.0 * j; + } + s0 = r3 / (fl * (su1 / fs) + su2) / r4; + + for (int k = 1; k <= kb; ++k) { + df[k - 1] *= fl / fs * s0; + } + for (int k = kb + 1; k <= nm; ++k) { + df[k - 1] *= s0; + } return Status::OK; } - // TODO: Following array sizes should be decided dynamically - auto a = std::unique_ptr{new (std::nothrow) T[300]()}; - auto b = std::unique_ptr{new (std::nothrow) T[100]()}; - auto cv0 = std::unique_ptr{new (std::nothrow) T[100]()}; - auto d = std::unique_ptr{new (std::nothrow) T[300]()}; - auto e = std::unique_ptr{new (std::nothrow) T[300]()}; - auto f = std::unique_ptr{new (std::nothrow) T[300]()}; - auto g = std::unique_ptr{new (std::nothrow) T[300]()}; - auto h = std::unique_ptr{new (std::nothrow) T[100]()}; - - if (a.get() == nullptr || b.get() == nullptr || cv0.get() == nullptr - || d.get() == nullptr || e.get() == nullptr || f.get() == nullptr - || g.get() == nullptr || h.get() == nullptr) { - return Status::NoMemory; - } - icm = (n-m+2)/2; - nm = 10 + (int)(0.5*(n-m)+c); - cs = c*c*kd; - k = 0; - for (l = 0; l <= 1; l++) { - for (i = 1; i <= nm; i++) { - k = (l == 0 ? 2*(i - 1) : 2*i - 1); - dk0 = m + k; - dk1 = m + k + 1; - dk2 = 2*(m + k); - d2k = 2*m + k; - a[i-1] = (d2k+2.0)*(d2k+1.0)/((dk2+3.0)*(dk2+5.0))*cs; - d[i-1] = dk0*dk1+(2.0*dk0*dk1-2.0*m*m-1.0)/((dk2-1.0)*(dk2+3.0))*cs; - g[i-1] = k*(k-1.0)/((dk2-3.0)*(dk2-1.0))*cs; + template + Status segv(int m, int n, T c, int kd, T *cv, T *eg) { + + // ========================================================= + // Purpose: Compute the characteristic values of spheroidal + // wave functions + // Input : m --- Mode parameter + // n --- Mode parameter + // c --- Spheroidal parameter + // KD --- Function code + // KD=1 for Prolate; KD=-1 for Oblate + // Output: CV --- Characteristic value for given m, n and c + // EG(L) --- Characteristic value for mode m and n' + // ( L = n' - m + 1 ) + // Return value: + // Status::OK + // Normal return. + // Status::NoMemory + // An internal memory allocation failed. + // ========================================================= + + int i, icm, j, k, k1, l, nm, nm1; + T cs, dk0, dk1, dk2, d2k, s, t, t1, x1, xa, xb; + // eg[<=200] is supplied by the caller + + if (c < 1e-10) { + for (i = 1; i <= (n - m + 1); i++) { + eg[i - 1] = (i + m) * (i + m - 1); + } + *cv = eg[n - m]; + return Status::OK; } - for (k = 2; k <= nm; k++) { - e[k-1] = sqrt(a[k-2]*g[k-1]); - f[k-1] = e[k-1]*e[k-1]; - } - f[0] = 0.0; - e[0] = 0.0; - xa = d[nm-1] + fabs(e[nm-1]); - xb = d[nm-1] - fabs(e[nm-1]); - nm1 = nm-1; - for (i = 1; i <= nm1; i++) { - t = fabs(e[i-1])+fabs(e[i]); - t1 = d[i-1] + t; - if (xa < t1) { xa = t1; } - t1 = d[i-1] - t; - if (t1 < xb) { xb = t1; } - } - for (i = 1; i <= icm; i++) { - b[i-1] = xa; - h[i-1] = xb; - } - for (k = 1; k <= icm; k++) { - for (k1 = k; k1 <= icm; k1++) { - if (b[k1-1] < b[k-1]) { - b[k-1] = b[k1-1]; - break; + + // TODO: Following array sizes should be decided dynamically + auto a = std::unique_ptr{new (std::nothrow) T[300]()}; + auto b = std::unique_ptr{new (std::nothrow) T[100]()}; + auto cv0 = std::unique_ptr{new (std::nothrow) T[100]()}; + auto d = std::unique_ptr{new (std::nothrow) T[300]()}; + auto e = std::unique_ptr{new (std::nothrow) T[300]()}; + auto f = std::unique_ptr{new (std::nothrow) T[300]()}; + auto g = std::unique_ptr{new (std::nothrow) T[300]()}; + auto h = std::unique_ptr{new (std::nothrow) T[100]()}; + + if (a.get() == nullptr || b.get() == nullptr || cv0.get() == nullptr || d.get() == nullptr || + e.get() == nullptr || f.get() == nullptr || g.get() == nullptr || h.get() == nullptr) { + return Status::NoMemory; + } + icm = (n - m + 2) / 2; + nm = 10 + (int)(0.5 * (n - m) + c); + cs = c * c * kd; + k = 0; + for (l = 0; l <= 1; l++) { + for (i = 1; i <= nm; i++) { + k = (l == 0 ? 2 * (i - 1) : 2 * i - 1); + dk0 = m + k; + dk1 = m + k + 1; + dk2 = 2 * (m + k); + d2k = 2 * m + k; + a[i - 1] = (d2k + 2.0) * (d2k + 1.0) / ((dk2 + 3.0) * (dk2 + 5.0)) * cs; + d[i - 1] = dk0 * dk1 + (2.0 * dk0 * dk1 - 2.0 * m * m - 1.0) / ((dk2 - 1.0) * (dk2 + 3.0)) * cs; + g[i - 1] = k * (k - 1.0) / ((dk2 - 3.0) * (dk2 - 1.0)) * cs; + } + for (k = 2; k <= nm; k++) { + e[k - 1] = sqrt(a[k - 2] * g[k - 1]); + f[k - 1] = e[k - 1] * e[k - 1]; + } + f[0] = 0.0; + e[0] = 0.0; + xa = d[nm - 1] + fabs(e[nm - 1]); + xb = d[nm - 1] - fabs(e[nm - 1]); + nm1 = nm - 1; + for (i = 1; i <= nm1; i++) { + t = fabs(e[i - 1]) + fabs(e[i]); + t1 = d[i - 1] + t; + if (xa < t1) { + xa = t1; + } + t1 = d[i - 1] - t; + if (t1 < xb) { + xb = t1; } } - if (k != 1) { - if(h[k-1] < h[k-2]) { h[k-1] = h[k-2]; } - } - while (1) { - x1 = (b[k-1]+h[k-1])/2.0; - cv0[k-1] = x1; - if (fabs((b[k-1] - h[k-1])/x1) < 1e-14) { break; } - j = 0; - s = 1.0; - for (i = 1; i <= nm; i++) { - if (s == 0.0) { s += 1e-30; } - t = f[i-1]/s; - s = d[i-1] - t - x1; - if (s < 0.0) { j += 1; } + for (i = 1; i <= icm; i++) { + b[i - 1] = xa; + h[i - 1] = xb; + } + for (k = 1; k <= icm; k++) { + for (k1 = k; k1 <= icm; k1++) { + if (b[k1 - 1] < b[k - 1]) { + b[k - 1] = b[k1 - 1]; + break; + } } - if (j < k) { - h[k-1] = x1; - } else { - b[k-1] = x1; - if (j >= icm) { - b[icm - 1] = x1; + if (k != 1) { + if (h[k - 1] < h[k - 2]) { + h[k - 1] = h[k - 2]; + } + } + while (1) { + x1 = (b[k - 1] + h[k - 1]) / 2.0; + cv0[k - 1] = x1; + if (fabs((b[k - 1] - h[k - 1]) / x1) < 1e-14) { + break; + } + j = 0; + s = 1.0; + for (i = 1; i <= nm; i++) { + if (s == 0.0) { + s += 1e-30; + } + t = f[i - 1] / s; + s = d[i - 1] - t - x1; + if (s < 0.0) { + j += 1; + } + } + if (j < k) { + h[k - 1] = x1; } else { - if (h[j] < x1) { h[j] = x1; } - if (x1 < b[j-1]) { b[j-1] = x1; } + b[k - 1] = x1; + if (j >= icm) { + b[icm - 1] = x1; + } else { + if (h[j] < x1) { + h[j] = x1; + } + if (x1 < b[j - 1]) { + b[j - 1] = x1; + } + } } } + cv0[k - 1] = x1; + if (l == 0) + eg[2 * k - 2] = cv0[k - 1]; + if (l == 1) + eg[2 * k - 1] = cv0[k - 1]; } - cv0[k-1] = x1; - if (l == 0) eg[2*k-2] = cv0[k-1]; - if (l == 1) eg[2*k-1] = cv0[k-1]; } + *cv = eg[n - m]; + return Status::OK; } - *cv = eg[n-m]; - return Status::OK; -} - - -template -void sphj(T x, int n, int *nm, T *sj, T *dj) { - - // MODIFIED to ALLOW N=0 CASE (ALSO IN SPHY) - // - // ======================================================= - // Purpose: Compute spherical Bessel functions jn(x) and - // their derivatives - // Input : x --- Argument of jn(x) - // n --- Order of jn(x) ( n = 0,1,… ) - // Output: SJ(n) --- jn(x) - // DJ(n) --- jn'(x) - // NM --- Highest order computed - // Routines called: - // MSTA1 and MSTA2 for computing the starting - // point for backward recurrence - // ======================================================= - - int k, m; - T cs, f, f0, f1, sa, sb; - - *nm = n; - if (fabs(x) < 1e-100) { - for (k = 0; k <= n; k++) { - sj[k] = 0.0; - dj[k] = 0.0; - } - sj[0] = 1.0; - if (n > 0) { - dj[1] = 1.0 / 3.0; + + template + void sphj(T x, int n, int *nm, T *sj, T *dj) { + + // MODIFIED to ALLOW N=0 CASE (ALSO IN SPHY) + // + // ======================================================= + // Purpose: Compute spherical Bessel functions jn(x) and + // their derivatives + // Input : x --- Argument of jn(x) + // n --- Order of jn(x) ( n = 0,1,… ) + // Output: SJ(n) --- jn(x) + // DJ(n) --- jn'(x) + // NM --- Highest order computed + // Routines called: + // MSTA1 and MSTA2 for computing the starting + // point for backward recurrence + // ======================================================= + + int k, m; + T cs, f, f0, f1, sa, sb; + + *nm = n; + if (fabs(x) < 1e-100) { + for (k = 0; k <= n; k++) { + sj[k] = 0.0; + dj[k] = 0.0; + } + sj[0] = 1.0; + if (n > 0) { + dj[1] = 1.0 / 3.0; + } + return; } - return; - } - sj[0] = sin(x)/x; - dj[0] = (cos(x) - sin(x)/x)/x; - if (n < 1) { - return; - } - sj[1] = (sj[0] - cos(x))/x; - if (n >= 2) { - sa = sj[0]; - sb = sj[1]; - m = msta1(x, 200); - if (m < n) { - *nm = m; - } else { - m = msta2(x, n, 15); + sj[0] = sin(x) / x; + dj[0] = (cos(x) - sin(x) / x) / x; + if (n < 1) { + return; } - f = 0.0; - f0 = 0.0; - f1 = 1e-100; - for (k = m; k >= 0; k--) { - f = (2.0*k + 3.0)*f1/x - f0; - if (k <= *nm) { sj[k] = f; } - f0 = f1; - f1 = f; + sj[1] = (sj[0] - cos(x)) / x; + if (n >= 2) { + sa = sj[0]; + sb = sj[1]; + m = msta1(x, 200); + if (m < n) { + *nm = m; + } else { + m = msta2(x, n, 15); + } + f = 0.0; + f0 = 0.0; + f1 = 1e-100; + for (k = m; k >= 0; k--) { + f = (2.0 * k + 3.0) * f1 / x - f0; + if (k <= *nm) { + sj[k] = f; + } + f0 = f1; + f1 = f; + } + cs = (fabs(sa) > fabs(sb) ? sa / f : sb / f0); + for (k = 0; k <= *nm; k++) { + sj[k] *= cs; + } } - cs = (fabs(sa) > fabs(sb) ? sa/f : sb/f0); - for (k = 0; k <= *nm; k++) { - sj[k] *= cs; + for (k = 1; k <= *nm; k++) { + dj[k] = sj[k - 1] - (k + 1.0) * sj[k] / x; } + return; } - for (k = 1; k <= *nm; k++) { - dj[k] = sj[k - 1] - (k + 1.0)*sj[k]/x; - } - return; -} - -template -inline void sphy(T x, int n, int *nm, T *sy, T *dy) { + template + inline void sphy(T x, int n, int *nm, T *sy, T *dy) { - // ====================================================== - // Purpose: Compute spherical Bessel functions yn(x) and - // their derivatives - // Input : x --- Argument of yn(x) ( x ≥ 0 ) - // n --- Order of yn(x) ( n = 0,1,… ) - // Output: SY(n) --- yn(x) - // DY(n) --- yn'(x) - // NM --- Highest order computed - // ====================================================== + // ====================================================== + // Purpose: Compute spherical Bessel functions yn(x) and + // their derivatives + // Input : x --- Argument of yn(x) ( x ≥ 0 ) + // n --- Order of yn(x) ( n = 0,1,… ) + // Output: SY(n) --- yn(x) + // DY(n) --- yn'(x) + // NM --- Highest order computed + // ====================================================== - T f, f0, f1; + T f, f0, f1; - if (x < 1.0e-60) { - for (int k = 0; k <= n; ++k) { - sy[k] = -1.0e300; - dy[k] = 1.0e300; + if (x < 1.0e-60) { + for (int k = 0; k <= n; ++k) { + sy[k] = -1.0e300; + dy[k] = 1.0e300; + } + *nm = n; + return; } - *nm = n; - return; - } - sy[0] = -cos(x) / x; - f0 = sy[0]; - dy[0] = (sin(x) + cos(x) / x) / x; + sy[0] = -cos(x) / x; + f0 = sy[0]; + dy[0] = (sin(x) + cos(x) / x) / x; - if (n < 1) { - *nm = n; - return; - } + if (n < 1) { + *nm = n; + return; + } - sy[1] = (sy[0] - sin(x)) / x; - f1 = sy[1]; + sy[1] = (sy[0] - sin(x)) / x; + f1 = sy[1]; - for (int k = 2; k <= n; k++) { - f = ((2.0 * k - 1.0) * f1 / x) - f0; - sy[k] = f; - if (fabs(f) >= 1.0e300) { - *nm = k - 1; - return; + for (int k = 2; k <= n; k++) { + f = ((2.0 * k - 1.0) * f1 / x) - f0; + sy[k] = f; + if (fabs(f) >= 1.0e300) { + *nm = k - 1; + return; + } + f0 = f1; + f1 = f; } - f0 = f1; - f1 = f; - } - *nm = n - 1; - for (int k = 1; k <= *nm; k++) { - dy[k] = sy[k - 1] - (k + 1.0) * sy[k] / x; + *nm = n - 1; + for (int k = 1; k <= *nm; k++) { + dy[k] = sy[k - 1] - (k + 1.0) * sy[k] / x; + } + return; } - return; -} -} -} +} // namespace specfun +} // namespace xsf diff --git a/include/xsf/sph_bessel.h b/include/xsf/sph_bessel.h index 3791de8..ea1105c 100644 --- a/include/xsf/sph_bessel.h +++ b/include/xsf/sph_bessel.h @@ -302,9 +302,8 @@ T sph_bessel_i_jac(long n, T z) { if (z == static_cast(0)) { if (n == 1) { - return 1./3.; - } - else { + return 1. / 3.; + } else { return 0; } } diff --git a/include/xsf/sphd_wave.h b/include/xsf/sphd_wave.h index 2f2c225..bbfb215 100644 --- a/include/xsf/sphd_wave.h +++ b/include/xsf/sphd_wave.h @@ -13,9 +13,9 @@ T prolate_segv(T m, T n, T c) { if ((m < 0) || (n < m) || (m != floor(m)) || (n != floor(n)) || ((n - m) > 198)) { return std::numeric_limits::quiet_NaN(); } - int_m = (int) m; - int_n = (int) n; - eg = (T *) malloc(sizeof(T) * (n - m + 2)); + int_m = (int)m; + int_n = (int)n; + eg = (T *)malloc(sizeof(T) * (n - m + 2)); if (eg == NULL) { set_error("pro_cv", SF_ERROR_MEMORY, "memory allocation error"); return std::numeric_limits::quiet_NaN(); @@ -38,9 +38,9 @@ T oblate_segv(T m, T n, T c) { if ((m < 0) || (n < m) || (m != floor(m)) || (n != floor(n)) || ((n - m) > 198)) { return std::numeric_limits::quiet_NaN(); } - int_m = (int) m; - int_n = (int) n; - eg = (T *) malloc(sizeof(T) * (n - m + 2)); + int_m = (int)m; + int_n = (int)n; + eg = (T *)malloc(sizeof(T) * (n - m + 2)); if (eg == NULL) { set_error("obl_cv", SF_ERROR_MEMORY, "memory allocation error"); return std::numeric_limits::quiet_NaN(); @@ -66,9 +66,9 @@ void prolate_aswfa_nocv(T m, T n, T c, T x, T &s1f, T &s1d) { s1f = std::numeric_limits::quiet_NaN(); return; } - int_m = (int) m; - int_n = (int) n; - eg = (T *) malloc(sizeof(T) * (n - m + 2)); + int_m = (int)m; + int_n = (int)n; + eg = (T *)malloc(sizeof(T) * (n - m + 2)); if (eg == NULL) { set_error("pro_ang1", SF_ERROR_MEMORY, "memory allocation error"); s1d = std::numeric_limits::quiet_NaN(); @@ -81,10 +81,9 @@ void prolate_aswfa_nocv(T m, T n, T c, T x, T &s1f, T &s1d) { set_error("pro_ang1", SF_ERROR_MEMORY, "memory allocation error"); s1d = std::numeric_limits::quiet_NaN(); s1f = std::numeric_limits::quiet_NaN(); - return; + return; } - if (specfun::aswfa(x, int_m, int_n, c, kd, cv, &s1f, &s1d) - == specfun::Status::NoMemory) { + if (specfun::aswfa(x, int_m, int_n, c, kd, cv, &s1f, &s1d) == specfun::Status::NoMemory) { set_error("prol_ang1", SF_ERROR_MEMORY, "memory allocation error"); s1d = std::numeric_limits::quiet_NaN(); s1f = std::numeric_limits::quiet_NaN(); @@ -104,9 +103,9 @@ void oblate_aswfa_nocv(T m, T n, T c, T x, T &s1f, T &s1d) { s1f = std::numeric_limits::quiet_NaN(); return; } - int_m = (int) m; - int_n = (int) n; - eg = (T *) malloc(sizeof(T) * (n - m + 2)); + int_m = (int)m; + int_n = (int)n; + eg = (T *)malloc(sizeof(T) * (n - m + 2)); if (eg == NULL) { set_error("obl_ang1", SF_ERROR_MEMORY, "memory allocation error"); s1d = std::numeric_limits::quiet_NaN(); @@ -119,10 +118,9 @@ void oblate_aswfa_nocv(T m, T n, T c, T x, T &s1f, T &s1d) { set_error("obl_ang1", SF_ERROR_MEMORY, "memory allocation error"); s1d = std::numeric_limits::quiet_NaN(); s1f = std::numeric_limits::quiet_NaN(); - return; + return; } - if (specfun::aswfa(x, int_m, int_n, c, kd, cv, &s1f, &s1d) - == specfun::Status::NoMemory) { + if (specfun::aswfa(x, int_m, int_n, c, kd, cv, &s1f, &s1d) == specfun::Status::NoMemory) { set_error("obl_ang1", SF_ERROR_MEMORY, "memory allocation error"); s1d = std::numeric_limits::quiet_NaN(); s1f = std::numeric_limits::quiet_NaN(); @@ -137,9 +135,7 @@ void prolate_aswfa(T m, T n, T c, T cv, T x, T &s1f, T &s1d) { s1f = std::numeric_limits::quiet_NaN(); s1d = std::numeric_limits::quiet_NaN(); } else { - specfun::Status status = specfun::aswfa(x, static_cast(m), - static_cast(n), c, 1, cv, - &s1f, &s1d); + specfun::Status status = specfun::aswfa(x, static_cast(m), static_cast(n), c, 1, cv, &s1f, &s1d); if (status == specfun::Status::NoMemory) { set_error("pro_ang1_cv", SF_ERROR_MEMORY, "memory allocation error"); s1d = std::numeric_limits::quiet_NaN(); @@ -156,9 +152,7 @@ void oblate_aswfa(T m, T n, T c, T cv, T x, T &s1f, T &s1d) { s1f = std::numeric_limits::quiet_NaN(); s1d = std::numeric_limits::quiet_NaN(); } else { - specfun::Status status = specfun::aswfa(x, static_cast(m), - static_cast(n), c, -1, cv, - &s1f, &s1d); + specfun::Status status = specfun::aswfa(x, static_cast(m), static_cast(n), c, -1, cv, &s1f, &s1d); if (status == specfun::Status::NoMemory) { set_error("obl_ang1_cv", SF_ERROR_MEMORY, "memory allocation error"); s1d = std::numeric_limits::quiet_NaN(); @@ -180,9 +174,9 @@ void prolate_radial1_nocv(T m, T n, T c, T x, T &r1f, T &r1d) { r1f = std::numeric_limits::quiet_NaN(); return; } - int_m = (int) m; - int_n = (int) n; - eg = (T *) malloc(sizeof(T) * (n - m + 2)); + int_m = (int)m; + int_n = (int)n; + eg = (T *)malloc(sizeof(T) * (n - m + 2)); if (eg == NULL) { set_error("pro_rad1", SF_ERROR_MEMORY, "memory allocation error"); r1d = std::numeric_limits::quiet_NaN(); @@ -195,10 +189,9 @@ void prolate_radial1_nocv(T m, T n, T c, T x, T &r1f, T &r1d) { set_error("pro_rad1", SF_ERROR_MEMORY, "memory allocation error"); r1d = std::numeric_limits::quiet_NaN(); r1f = std::numeric_limits::quiet_NaN(); - return; + return; } - if (specfun::rswfp(int_m, int_n, c, x, cv, kf, &r1f, &r1d, &r2f, &r2d) - == specfun::Status::NoMemory) { + if (specfun::rswfp(int_m, int_n, c, x, cv, kf, &r1f, &r1d, &r2f, &r2d) == specfun::Status::NoMemory) { set_error("pro_rad1", SF_ERROR_MEMORY, "memory allocation error"); r1d = std::numeric_limits::quiet_NaN(); r1f = std::numeric_limits::quiet_NaN(); @@ -217,9 +210,9 @@ void prolate_radial2_nocv(T m, T n, T c, T x, T &r2f, T &r2d) { r2f = std::numeric_limits::quiet_NaN(); return; } - int_m = (int) m; - int_n = (int) n; - eg = (T *) malloc(sizeof(T) * (n - m + 2)); + int_m = (int)m; + int_n = (int)n; + eg = (T *)malloc(sizeof(T) * (n - m + 2)); if (eg == NULL) { set_error("pro_rad2", SF_ERROR_MEMORY, "memory allocation error"); r2d = std::numeric_limits::quiet_NaN(); @@ -232,10 +225,9 @@ void prolate_radial2_nocv(T m, T n, T c, T x, T &r2f, T &r2d) { set_error("pro_rad2", SF_ERROR_MEMORY, "memory allocation error"); r2d = std::numeric_limits::quiet_NaN(); r2f = std::numeric_limits::quiet_NaN(); - return; + return; } - if (specfun::rswfp(int_m, int_n, c, x, cv, kf, &r1f, &r1d, &r2f, &r2d) - == specfun::Status::NoMemory) { + if (specfun::rswfp(int_m, int_n, c, x, cv, kf, &r1f, &r1d, &r2f, &r2d) == specfun::Status::NoMemory) { set_error("pro_rad2", SF_ERROR_MEMORY, "memory allocation error"); r2d = std::numeric_limits::quiet_NaN(); r2f = std::numeric_limits::quiet_NaN(); @@ -253,10 +245,9 @@ void prolate_radial1(T m, T n, T c, T cv, T x, T &r1f, T &r1d) { r1f = std::numeric_limits::quiet_NaN(); r1d = std::numeric_limits::quiet_NaN(); } else { - int_m = (int) m; - int_n = (int) n; - if (specfun::rswfp(int_m, int_n, c, x, cv, kf, &r1f, &r1d, &r2f, &r2d) - == specfun::Status::NoMemory) { + int_m = (int)m; + int_n = (int)n; + if (specfun::rswfp(int_m, int_n, c, x, cv, kf, &r1f, &r1d, &r2f, &r2d) == specfun::Status::NoMemory) { set_error("pro_rad1_cv", SF_ERROR_MEMORY, NULL); r1f = std::numeric_limits::quiet_NaN(); r1d = std::numeric_limits::quiet_NaN(); @@ -275,10 +266,9 @@ void prolate_radial2(T m, T n, T c, T cv, T x, T &r2f, T &r2d) { r2f = std::numeric_limits::quiet_NaN(); r2d = std::numeric_limits::quiet_NaN(); } else { - int_m = (int) m; - int_n = (int) n; - if (specfun::rswfp(int_m, int_n, c, x, cv, kf, &r1f, &r1d, &r2f, &r2d) - == specfun::Status::NoMemory) { + int_m = (int)m; + int_n = (int)n; + if (specfun::rswfp(int_m, int_n, c, x, cv, kf, &r1f, &r1d, &r2f, &r2d) == specfun::Status::NoMemory) { set_error("pro_rad2_cv", SF_ERROR_MEMORY, NULL); r2f = std::numeric_limits::quiet_NaN(); r2d = std::numeric_limits::quiet_NaN(); @@ -298,9 +288,9 @@ void oblate_radial1_nocv(T m, T n, T c, T x, T &r1f, T &r1d) { r1f = std::numeric_limits::quiet_NaN(); return; } - int_m = (int) m; - int_n = (int) n; - eg = (T *) malloc(sizeof(T) * (n - m + 2)); + int_m = (int)m; + int_n = (int)n; + eg = (T *)malloc(sizeof(T) * (n - m + 2)); if (eg == NULL) { set_error("obl_rad1", SF_ERROR_MEMORY, "memory allocation error"); r1d = std::numeric_limits::quiet_NaN(); @@ -313,10 +303,9 @@ void oblate_radial1_nocv(T m, T n, T c, T x, T &r1f, T &r1d) { set_error("obl_rad1", SF_ERROR_MEMORY, "memory allocation error"); r1d = std::numeric_limits::quiet_NaN(); r1f = std::numeric_limits::quiet_NaN(); - return; + return; } - if (specfun::rswfo(int_m, int_n, c, x, cv, kf, &r1f, &r1d, &r2f, &r2d) - == specfun::Status::NoMemory) { + if (specfun::rswfo(int_m, int_n, c, x, cv, kf, &r1f, &r1d, &r2f, &r2d) == specfun::Status::NoMemory) { set_error("obl_rad1", SF_ERROR_MEMORY, "memory allocation error"); r1d = std::numeric_limits::quiet_NaN(); r1f = std::numeric_limits::quiet_NaN(); @@ -336,9 +325,9 @@ void oblate_radial2_nocv(T m, T n, T c, T x, T &r2f, T &r2d) { r2f = std::numeric_limits::quiet_NaN(); return; } - int_m = (int) m; - int_n = (int) n; - eg = (T *) malloc(sizeof(T) * (n - m + 2)); + int_m = (int)m; + int_n = (int)n; + eg = (T *)malloc(sizeof(T) * (n - m + 2)); if (eg == NULL) { set_error("obl_rad2", SF_ERROR_MEMORY, "memory allocation error"); r2d = std::numeric_limits::quiet_NaN(); @@ -351,10 +340,9 @@ void oblate_radial2_nocv(T m, T n, T c, T x, T &r2f, T &r2d) { set_error("obl_rad2", SF_ERROR_MEMORY, "memory allocation error"); r2d = std::numeric_limits::quiet_NaN(); r2f = std::numeric_limits::quiet_NaN(); - return; + return; } - if (specfun::rswfo(int_m, int_n, c, x, cv, kf, &r1f, &r1d, &r2f, &r2d) - == specfun::Status::NoMemory){ + if (specfun::rswfo(int_m, int_n, c, x, cv, kf, &r1f, &r1d, &r2f, &r2d) == specfun::Status::NoMemory) { set_error("obl_rad2", SF_ERROR_MEMORY, "memory allocation error"); r2d = std::numeric_limits::quiet_NaN(); r2f = std::numeric_limits::quiet_NaN(); @@ -372,13 +360,12 @@ void oblate_radial1(T m, T n, T c, T cv, T x, T &r1f, T &r1d) { r1f = std::numeric_limits::quiet_NaN(); r1d = std::numeric_limits::quiet_NaN(); } else { - if (specfun::rswfo(static_cast(m), static_cast(n), - c, x, cv, kf, &r1f, &r1d, &r2f, &r2d) - == specfun::Status::NoMemory) { + if (specfun::rswfo(static_cast(m), static_cast(n), c, x, cv, kf, &r1f, &r1d, &r2f, &r2d) == + specfun::Status::NoMemory) { set_error("obl_rad1_cv", SF_ERROR_MEMORY, "memory allocation error"); r1d = std::numeric_limits::quiet_NaN(); r1f = std::numeric_limits::quiet_NaN(); - return; + return; } } } @@ -393,13 +380,12 @@ void oblate_radial2(T m, T n, T c, T cv, T x, T &r2f, T &r2d) { r2f = std::numeric_limits::quiet_NaN(); r2d = std::numeric_limits::quiet_NaN(); } else { - if (specfun::rswfo(static_cast(m), static_cast(n), - c, x, cv, kf, &r1f, &r1d, &r2f, &r2d) - == specfun::Status::NoMemory) { + if (specfun::rswfo(static_cast(m), static_cast(n), c, x, cv, kf, &r1f, &r1d, &r2f, &r2d) == + specfun::Status::NoMemory) { set_error("obl_rad2_cv", SF_ERROR_MEMORY, "memory allocation error"); r2d = std::numeric_limits::quiet_NaN(); r2f = std::numeric_limits::quiet_NaN(); - return; + return; } } } diff --git a/include/xsf/tools.h b/include/xsf/tools.h index e349f6a..ad758c8 100644 --- a/include/xsf/tools.h +++ b/include/xsf/tools.h @@ -286,8 +286,8 @@ namespace detail { */ template XSF_HOST_DEVICE inline std::tuple bracket_root_for_cdf_inversion( - Function func, double x0, double xmin, double xmax, double step0_left, - double step0_right, double factor_left, double factor_right, bool increasing, std::uint64_t maxiter + Function func, double x0, double xmin, double xmax, double step0_left, double step0_right, double factor_left, + double factor_right, bool increasing, std::uint64_t maxiter ) { double y0 = func(x0); @@ -335,7 +335,7 @@ namespace detail { std::swap(interior, frontier); std::swap(y_interior, y_frontier); } - return {interior, frontier, y_interior, y_frontier, 0}; + return {interior, frontier, y_interior, y_frontier, 0}; } if (reached_boundary) { /* We've reached a boundary point without finding a root . */ @@ -360,7 +360,7 @@ namespace detail { /* Failed to converge within maxiter iterations. If maxiter is sufficiently high and * factor_left and factor_right are set appropriately, this should only happen due to * a bug in this function. Limiting the number of iterations is a defensive programming measure. */ - return { + return { std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN(), 3 }; @@ -369,8 +369,7 @@ namespace detail { /* Find root of a scalar function using Chandrupatla's algorithm */ template XSF_HOST_DEVICE inline std::pair find_root_chandrupatla( - Function func, double x1, double x2, double f1, double f2, double rtol, - double atol, std::uint64_t maxiter + Function func, double x1, double x2, double f1, double f2, double rtol, double atol, std::uint64_t maxiter ) { if (f1 == 0) { return {x1, 0}; diff --git a/include/xsf/wright_bessel.h b/include/xsf/wright_bessel.h index 77cf165..cceb7d2 100644 --- a/include/xsf/wright_bessel.h +++ b/include/xsf/wright_bessel.h @@ -68,7 +68,7 @@ namespace detail { return res; } - template + template XSF_HOST_DEVICE inline double wb_large_a(double a, double b, double x, int n) { /* 2. Taylor series expansion in x=0, for large a. * @@ -102,7 +102,7 @@ namespace detail { return res; } - template + template XSF_HOST_DEVICE inline double wb_small_a(double a, double b, double x, int order) { /* 3. Taylor series in a=0 up to order 5, for tiny a and not too large x * @@ -126,20 +126,22 @@ namespace detail { */ double A[6]; // coefficients of a^k (1, -x * Psi(b), ...) double B[6]; // powers of b^k/k! or terms in polygamma functions - constexpr double C[5] = { // coefficients of a^k1 * b^k2 - 1.0000000000000000, // C[0] - 1.1544313298030657, // C[1] - -3.9352684291215233, // C[2] - -1.0080632408182857, // C[3] - 19.984633365874979, // C[4] + constexpr double C[5] = { + // coefficients of a^k1 * b^k2 + 1.0000000000000000, // C[0] + 1.1544313298030657, // C[1] + -3.9352684291215233, // C[2] + -1.0080632408182857, // C[3] + 19.984633365874979, // C[4] }; - double X[6] = { // polynomials in x; - 1, // X[0] - x, // X[1] - x * (x + 1), // X[2] - x * (x * (x + 3) + 1), // X[3] - x * (x * (x * (x + 6) + 7) + 1), // X[4] - x * (x * (x * (x * (x + 10) + 25) + 15) + 1), // X[5] + double X[6] = { + // polynomials in x; + 1, // X[0] + x, // X[1] + x * (x + 1), // X[2] + x * (x * (x + 3) + 1), // X[3] + x * (x * (x * (x + 6) + 7) + 1), // X[4] + x * (x * (x * (x * (x + 10) + 25) + 15) + 1), // X[5] }; double res; @@ -160,10 +162,10 @@ namespace detail { } // Note that polevl assumes inverse ordering => A[5] = 0th term A[5] = cephes::rgamma(b); - A[4] = X[1] * (C[0] + C[1] * b + C[2] * B[2] + C[3] * B[3] + C[4] * B[4]); - A[3] = X[2] / 2. * (C[1] + C[2] * b + C[3] * B[2] + C[4] * B[3]); - A[2] = X[3] / 6. * (C[2] + C[3] * b + C[4] * B[2]); - A[1] = X[4] / 24. * (C[3] + C[4] * b); + A[4] = X[1] * (C[0] + C[1] * b + C[2] * B[2] + C[3] * B[3] + C[4] * B[4]); + A[3] = X[2] / 2. * (C[1] + C[2] * b + C[3] * B[2] + C[4] * B[3]); + A[2] = X[3] / 6. * (C[2] + C[3] * b + C[4] * B[2]); + A[1] = X[4] / 24. * (C[3] + C[4] * b); A[0] = X[5] / 120. * C[4]; // res = exp(x) * (A[5] + A[4] * a + A[3] * a^2 + A[2] * a^3 + ...) if (!log_wb) { @@ -223,7 +225,7 @@ namespace detail { return res; } - template + template XSF_HOST_DEVICE inline double wb_asymptotic(double a, double b, double x) { /* 4. Asymptotic expansion for large x up to order 8 * @@ -457,10 +459,10 @@ namespace detail { /* Compute integrand Kmod(eps, a, b, x, r) for Gauss-Laguerre quadrature. * * K(a, b, x, r+eps) = exp(-r-eps) * Kmod(eps, a, b, x, r) - * + * * Kmod(eps, a, b, x, r) = exp(x * (r+eps)^(-a) * cos(pi*a)) * (r+eps)^(-b) * * sin(x * (r+eps)^(-a) * sin(pi*a) + pi * b) - * + * * Note that we additionally factor out exp(exp_term) which helps with large * terms in the exponent of exp(...) */ @@ -475,7 +477,7 @@ namespace detail { * P(eps, a, b, x, phi) = exp(eps * cos(phi) + x * eps^(-a) * cos(a*phi)) * * cos(eps * sin(phi) - x * eps^(-a) * sin(a*phi) * + (1-b)*phi) - * + * * Note that we additionally factor out exp(exp_term) which helps with large * terms in the exponent of exp(...) */ @@ -548,7 +550,7 @@ namespace detail { * Call: python _precompute/wright_bessel.py 4 */ constexpr double wb_A[] = {0.41037, 0.30833, 6.9952, 18.382, -2.8566, 2.1122}; - template + template XSF_HOST_DEVICE inline double wright_bessel_integral(double a, double b, double x) { /* 5. Integral representation * @@ -622,7 +624,7 @@ namespace detail { // exp(..). double exp_term = 0; // From the exponent of K: - double r = wb_x_laguerre[50-1]; // largest value of x used in wb_Kmod + double r = wb_x_laguerre[50 - 1]; // largest value of x used in wb_Kmod double x_r_a = x * std::pow(r + eps, -a); exp_term = std::fmax(exp_term, x_r_a * cephes::cospi(a)); // From the exponent of P: @@ -657,7 +659,7 @@ namespace detail { } } // namespace detail -template +template XSF_HOST_DEVICE inline double wright_bessel_t(double a, double b, double x) { /* Compute Wright's generalized Bessel function for scalar arguments. * @@ -775,13 +777,15 @@ XSF_HOST_DEVICE inline double wright_bessel_t(double a, double b, double x) { if (x <= 1) { // 18 term Taylor Series => error mostly smaller 5e-14 double res = detail::wb_series(a, b, x, 0, 18); - if (log_wb) res = std::log(res); + if (log_wb) + res = std::log(res); return res; } if (x <= 2) { // 20 term Taylor Series => error mostly smaller 1e-12 to 1e-13 double res = detail::wb_series(a, b, x, 0, 20); - if (log_wb) res = std::log(res); + if (log_wb) + res = std::log(res); return res; } if (a >= 5) { @@ -823,18 +827,13 @@ XSF_HOST_DEVICE inline double wright_bessel_t(double a, double b, double x) { return detail::wright_bessel_integral(a, b, x); } - -XSF_HOST_DEVICE inline double wright_bessel(double a, double b, double x) { - return wright_bessel_t(a, b, x); -} +XSF_HOST_DEVICE inline double wright_bessel(double a, double b, double x) { return wright_bessel_t(a, b, x); } XSF_HOST_DEVICE inline float wright_bessel(float a, float b, float x) { return wright_bessel(static_cast(a), static_cast(b), static_cast(x)); } -XSF_HOST_DEVICE inline double log_wright_bessel(double a, double b, double x) { - return wright_bessel_t(a, b, x); -} +XSF_HOST_DEVICE inline double log_wright_bessel(double a, double b, double x) { return wright_bessel_t(a, b, x); } XSF_HOST_DEVICE inline float log_wright_bessel(float a, float b, float x) { return log_wright_bessel(static_cast(a), static_cast(b), static_cast(x)); diff --git a/include/xsf/zeta.h b/include/xsf/zeta.h index ff52f6e..fb0e774 100644 --- a/include/xsf/zeta.h +++ b/include/xsf/zeta.h @@ -39,142 +39,142 @@ namespace detail { * ) */ constexpr double zeta_em_log_abs_coeff_lookup[] = { - 0.0, - -2.4849066497880004, - -6.579251212010101, - -10.31692083029347, - -14.005800284407405, - -17.68462940266784, - -21.361131560073222, - -25.037070502911423, - -28.712870599846948, - -32.388636197522295, - -36.06439319366539, - -39.740148041995184, - -43.41590235365616, - -47.091656531181485, - -50.76741067517639, - -54.44316481078909, - -58.11891894430628, - -61.79467307729959, - -65.47042721016194, - -69.14618134299154, - -72.82193547581296, - -76.49768960863234, - -80.1734437414512, - -83.84919787426993, - -87.52495200708863, - -91.20070613990733, - -94.87646027272602, - -98.55221440554472, - -102.2279685383634, - -105.9037226711821, - -109.57947680400078, - -113.25523093681947, - -116.93098506963817, - -120.60673920245685, - -124.28249333527555, - -127.95824746809424, - -131.63400160091294, - -135.30975573373163, - -138.9855098665503, - -142.661263999369, - -146.3370181321877, - -150.0127722650064, - -153.6885263978251, - -157.36428053064375, - -161.04003466346245, - -164.71578879628115, - -168.39154292909984, - -172.06729706191854, - -175.74305119473723, - -179.4188053275559, - -183.0945594603746 + 0.0, + -2.4849066497880004, + -6.579251212010101, + -10.31692083029347, + -14.005800284407405, + -17.68462940266784, + -21.361131560073222, + -25.037070502911423, + -28.712870599846948, + -32.388636197522295, + -36.06439319366539, + -39.740148041995184, + -43.41590235365616, + -47.091656531181485, + -50.76741067517639, + -54.44316481078909, + -58.11891894430628, + -61.79467307729959, + -65.47042721016194, + -69.14618134299154, + -72.82193547581296, + -76.49768960863234, + -80.1734437414512, + -83.84919787426993, + -87.52495200708863, + -91.20070613990733, + -94.87646027272602, + -98.55221440554472, + -102.2279685383634, + -105.9037226711821, + -109.57947680400078, + -113.25523093681947, + -116.93098506963817, + -120.60673920245685, + -124.28249333527555, + -127.95824746809424, + -131.63400160091294, + -135.30975573373163, + -138.9855098665503, + -142.661263999369, + -146.3370181321877, + -150.0127722650064, + -153.6885263978251, + -157.36428053064375, + -161.04003466346245, + -164.71578879628115, + -168.39154292909984, + -172.06729706191854, + -175.74305119473723, + -179.4188053275559, + -183.0945594603746 }; // Complex log of expansion coefficients for Euler-Maclaurin summation formula. XSF_HOST_DEVICE inline std::complex zeta_em_log_coeff(std::size_t n) { - std::complex J(0.0, 1.0); - std::complex result; - if (n < 50) { - result = zeta_em_log_abs_coeff_lookup[n]; - } else { - /* Asymptotic formula - * Uses https://dlmf.nist.gov/24.11#E1 to approximate B_{2n} and - * Stirling's approximation for (2n)!. - */ - result = std::log(2.0) - 2.0*n*std::log(2*M_PI); - } - if (n % 2 == 0) { - /* B_{2n}/(2n)! is negative for even n. This contributes a term - * pi*i when taking the log. */ - result += M_PI * J; - } - return result; + std::complex J(0.0, 1.0); + std::complex result; + if (n < 50) { + result = zeta_em_log_abs_coeff_lookup[n]; + } else { + /* Asymptotic formula + * Uses https://dlmf.nist.gov/24.11#E1 to approximate B_{2n} and + * Stirling's approximation for (2n)!. + */ + result = std::log(2.0) - 2.0 * n * std::log(2 * M_PI); + } + if (n % 2 == 0) { + /* B_{2n}/(2n)! is negative for even n. This contributes a term + * pi*i when taking the log. */ + result += M_PI * J; + } + return result; } /* Compute riemann_zeta for complex input z using the Euler-Maclaurin formula. * Computation of individual terms in expansion are logarithmized to avoid * overflow. TODO: only logarithmize when necessary. */ XSF_HOST_DEVICE inline std::complex zeta_euler_maclaurin(std::complex z) { - if (z == 1.0) { - /* Return NaN at pole since value depends on how z approaches 1.0. */ - return {std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN()}; - } - std::size_t n = static_cast(std::max(std::abs(z.imag()) / 4.0, 50.0)); - std::size_t m = n; - std::complex result = 0.0; - for (std::size_t i = 1; i < n; i++) { - std::complex term = std::pow(static_cast(i), -z); - result += term; - // When z.real() > 1, series converges and we can consider early termination - if (z.real() > 1 && std::abs(term) / std::abs(result) <= std::numeric_limits::epsilon()) { - return result; - } - } - double N = static_cast(n); - std::complex b = std::pow(n, -z); - result += b * (0.5 + N / (z - 1.0)); - /* The terms of the Euler-Maclaurin - * expansion below are T(k, n) = B2k/(2k)! * n^(1 - z - 2k) * z(z+1)...(z+2k-2). - * We work with logarithms to avoid overflow in all cases at the expense of - * some accuracy. At the start of iteration k: - * log_poch will equal log(z(z+1)...(z+2k-2)) - * log_factor will equal log(n^(1 - z - 2k)) - * These are updated one extra time after the loop completes for use in the - * Euler-Maclaurin error estimate. - */ - std::complex log_poch = std::log(z); - std::complex log_factor = -(z + 1.0) * std::log(N); - for (std::size_t k = 1; k <= m; k++) { - std::complex term = std::exp(zeta_em_log_coeff(k) + log_factor + log_poch); - result += term; - if (std::abs(term)/std::abs(result) <= std::numeric_limits::epsilon()) { - return result; - } - log_poch += std::log(z + static_cast(2*k - 1)) + std::log(z + static_cast(2*k)); - log_factor -= 2*std::log(N); - } - /* Euler-maclaurin absolute error estimate. - * The error is bounded above by |(z + 2m + 1)/(z.real + 2m + 1) * T(m+1, n)| - * See https://en.wikipedia.org/wiki/Riemann_zeta_function#Numerical_algorithms - */ - double error; - error = std::abs(std::exp(zeta_em_log_coeff(m + 1) + log_factor + log_poch)); - error *= std::abs((z + 2.0*m + 1.0)/(z.real() + 2.0*m + 1.0)); - // convert to relative error estimate - error /= std::abs(result); - if (error > 1e-8) { - if (error > 1e-1) { - /* If error estimate predicts we don't even get 1 digit of precision, return NaN - * and signal no result */ - set_error("zeta", SF_ERROR_NO_RESULT, NULL); - return {std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN()}; - } - // Signal reduced precision. - set_error("zeta", SF_ERROR_LOSS, NULL); - } - return result; + if (z == 1.0) { + /* Return NaN at pole since value depends on how z approaches 1.0. */ + return {std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN()}; + } + std::size_t n = static_cast(std::max(std::abs(z.imag()) / 4.0, 50.0)); + std::size_t m = n; + std::complex result = 0.0; + for (std::size_t i = 1; i < n; i++) { + std::complex term = std::pow(static_cast(i), -z); + result += term; + // When z.real() > 1, series converges and we can consider early termination + if (z.real() > 1 && std::abs(term) / std::abs(result) <= std::numeric_limits::epsilon()) { + return result; + } + } + double N = static_cast(n); + std::complex b = std::pow(n, -z); + result += b * (0.5 + N / (z - 1.0)); + /* The terms of the Euler-Maclaurin + * expansion below are T(k, n) = B2k/(2k)! * n^(1 - z - 2k) * z(z+1)...(z+2k-2). + * We work with logarithms to avoid overflow in all cases at the expense of + * some accuracy. At the start of iteration k: + * log_poch will equal log(z(z+1)...(z+2k-2)) + * log_factor will equal log(n^(1 - z - 2k)) + * These are updated one extra time after the loop completes for use in the + * Euler-Maclaurin error estimate. + */ + std::complex log_poch = std::log(z); + std::complex log_factor = -(z + 1.0) * std::log(N); + for (std::size_t k = 1; k <= m; k++) { + std::complex term = std::exp(zeta_em_log_coeff(k) + log_factor + log_poch); + result += term; + if (std::abs(term) / std::abs(result) <= std::numeric_limits::epsilon()) { + return result; + } + log_poch += std::log(z + static_cast(2 * k - 1)) + std::log(z + static_cast(2 * k)); + log_factor -= 2 * std::log(N); + } + /* Euler-maclaurin absolute error estimate. + * The error is bounded above by |(z + 2m + 1)/(z.real + 2m + 1) * T(m+1, n)| + * See https://en.wikipedia.org/wiki/Riemann_zeta_function#Numerical_algorithms + */ + double error; + error = std::abs(std::exp(zeta_em_log_coeff(m + 1) + log_factor + log_poch)); + error *= std::abs((z + 2.0 * m + 1.0) / (z.real() + 2.0 * m + 1.0)); + // convert to relative error estimate + error /= std::abs(result); + if (error > 1e-8) { + if (error > 1e-1) { + /* If error estimate predicts we don't even get 1 digit of precision, return NaN + * and signal no result */ + set_error("zeta", SF_ERROR_NO_RESULT, NULL); + return {std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN()}; + } + // Signal reduced precision. + set_error("zeta", SF_ERROR_LOSS, NULL); + } + return result; } /* Lookup table of coefficients for Algorithm 2 from Borwein 1995 @@ -204,129 +204,92 @@ namespace detail { * coeffs = np.asarray(coeffs) */ constexpr double zeta_borwein_coeff[] = { - 1.0555078361382878e-38, - 5.278594688527578e-35, - 4.4014687322044963e-32, - 1.467453546497519e-29, - 2.617862196688831e-27, - 2.900097799958025e-25, - 2.184440361492933e-23, - 1.1890977312913296e-21, - 4.8871396166872276e-20, - 1.5672253698802734e-18, - 4.022931234264572e-17, - 8.435973533351745e-16, - 1.469296379914116e-14, - 2.1548747054571902e-13, - 2.6919530537535124e-12, - 2.8925409162768484e-11, - 2.6957505693699856e-10, - 2.194772239130839e-09, - 1.57078229370057e-08, - 9.936187220749133e-08, - 5.581721578217702e-07, - 2.796271112037765e-06, - 1.253886254275813e-05, - 5.049261002939051e-05, - 0.00018312884459703666, - 0.0005997690328552426, - 0.0017780501082460968, - 0.004781802283665968, - 0.011690432287131671, - 0.026034302929535964, - 0.052922982472754856, - 0.09842471411648858, - 0.16789610796540344, - 0.26350429194768626, - 0.3819442810600665, - 0.5137731385068898, - 0.645292538541866, - 0.7625449322050362, - 0.8556063057019102, - 0.921056062886525, - 0.9616100580028147, - 0.9835905431606953, - 0.9939187229336753, - 0.9980782525166648, - 0.9994930141459889, - 0.999891478844585, - 0.9999819091990203, - 0.9999977981288319, - 0.9999998260580315, - 0.9999999933099243 + 1.0555078361382878e-38, 5.278594688527578e-35, 4.4014687322044963e-32, 1.467453546497519e-29, + 2.617862196688831e-27, 2.900097799958025e-25, 2.184440361492933e-23, 1.1890977312913296e-21, + 4.8871396166872276e-20, 1.5672253698802734e-18, 4.022931234264572e-17, 8.435973533351745e-16, + 1.469296379914116e-14, 2.1548747054571902e-13, 2.6919530537535124e-12, 2.8925409162768484e-11, + 2.6957505693699856e-10, 2.194772239130839e-09, 1.57078229370057e-08, 9.936187220749133e-08, + 5.581721578217702e-07, 2.796271112037765e-06, 1.253886254275813e-05, 5.049261002939051e-05, + 0.00018312884459703666, 0.0005997690328552426, 0.0017780501082460968, 0.004781802283665968, + 0.011690432287131671, 0.026034302929535964, 0.052922982472754856, 0.09842471411648858, + 0.16789610796540344, 0.26350429194768626, 0.3819442810600665, 0.5137731385068898, + 0.645292538541866, 0.7625449322050362, 0.8556063057019102, 0.921056062886525, + 0.9616100580028147, 0.9835905431606953, 0.9939187229336753, 0.9980782525166648, + 0.9994930141459889, 0.999891478844585, 0.9999819091990203, 0.9999977981288319, + 0.9999998260580315, 0.9999999933099243 }; /* Compute riemann_zeta for complex input z using Algorithm 2 from Borwein 1995. */ XSF_HOST_DEVICE inline std::complex zeta_borwein(std::complex z) { - std::complex result = 0.0; - // Sum in reverse order because smaller terms come later. - for (int k = 49; k >= 0; k--) { - double sign = std::pow(-1.0, k); - std::complex den = std::pow(k + 1, z); - std::complex term = sign * (zeta_borwein_coeff[k] - 1.0) / den; - result += term; - } - return result * -1.0/(1.0 - std::pow(2.0, 1.0 - z)); + std::complex result = 0.0; + // Sum in reverse order because smaller terms come later. + for (int k = 49; k >= 0; k--) { + double sign = std::pow(-1.0, k); + std::complex den = std::pow(k + 1, z); + std::complex term = sign * (zeta_borwein_coeff[k] - 1.0) / den; + result += term; + } + return result * -1.0 / (1.0 - std::pow(2.0, 1.0 - z)); } /* Compute riemann zeta for complex z and real part >= 0 */ XSF_HOST_DEVICE inline std::complex zeta_right_halfplane(std::complex z) { - if (z == 1.0) { - return {std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN()}; - } - /* Cutoff for using Euler-MacLaurin chosen based on cursory empirical search. - * TODO: Choose cutoffs in a more principled way. */ - if (z.real() < 50.0 && std::abs(z.imag()) > 50.0) { - if (z.real() >= 0.0 && z.real() < 2.5 && std::abs(z.imag()) > 1e9) { - /* Euler-MacLaurin summation starts to take an unreasonable amount of time in this - * region, so just give up and return NaN instead. */ - set_error("zeta", SF_ERROR_NO_RESULT, NULL); - return {std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN()}; - } - return zeta_euler_maclaurin(z); - } - return zeta_borwein(z); + if (z == 1.0) { + return {std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN()}; + } + /* Cutoff for using Euler-MacLaurin chosen based on cursory empirical search. + * TODO: Choose cutoffs in a more principled way. */ + if (z.real() < 50.0 && std::abs(z.imag()) > 50.0) { + if (z.real() >= 0.0 && z.real() < 2.5 && std::abs(z.imag()) > 1e9) { + /* Euler-MacLaurin summation starts to take an unreasonable amount of time in this + * region, so just give up and return NaN instead. */ + set_error("zeta", SF_ERROR_NO_RESULT, NULL); + return {std::numeric_limits::quiet_NaN(), std::numeric_limits::quiet_NaN()}; + } + return zeta_euler_maclaurin(z); + } + return zeta_borwein(z); } XSF_HOST_DEVICE inline std::complex exppi(std::complex z) { - // exp(pi*z) for complex z. - double x = z.real(); - double y = z.imag(); - std::complex factor1(xsf::cospi(y), xsf::sinpi(y)); - double factor2 = std::exp(M_PI*x); - return factor1 * factor2; - } + // exp(pi*z) for complex z. + double x = z.real(); + double y = z.imag(); + std::complex factor1(xsf::cospi(y), xsf::sinpi(y)); + double factor2 = std::exp(M_PI * x); + return factor1 * factor2; + } XSF_HOST_DEVICE inline std::complex logsinpi(std::complex z) { - /* log(sinpi(z)) using sin(z) = (exp(i*pi*z) - exp(-i*pi*z)) / 2i - * - * No attempt is made to choose any particular branch of the logarithm. - * This is an internal function and the intent is that this that the - * result of log(sinpi(z)) will be added to other terms, and the sum - * will then be exponentiated, making the choice of a specific branch - * unnecessary. - */ - std::complex result = std::log(xsf::sinpi(z)); - // If it doesn't overflow, just do the regular calculation. - if (std::isfinite(result.real()) && !std::isfinite(result.imag())) { - return result; - } - /* Otherwise factor before taking log. This is where we may end up - * taking a branch other than the principal branch. */ - std::complex J(0.0, 1.0); - /* Calculating log((exp(i*pi*z) - exp(-i*pi*z)) / 2i). Factor out term - * with larger magnitude before taking log. */ - if (z.imag() > 0 ) { - /* if z.imag() > 0 then, exp(-i*pi*z) has greatest magnitude. Factor it - * out to get: - * log(exp(-i*pi*z)*((exp(2*i*pi*z) - 1.0)/(2i)) = - * log(exp(-i*pi*z)) + log((exp(2*i*pi*z) - 1.0)/(2i)) = - * -i*pi*z + log((exp(2*i*pi*z) - 1.0)/(2i)) */ - return -J * M_PI * z + std::log((exppi(2.0 * z * J) - 1.0) / (2.0*J)); - } - /* if z.imag() < 0 then, exp(i*pi*z) has greatest magnitude. Factor similarly - * to above */ - return J * M_PI * z + std::log((1.0 - exppi(-2.0 * z * J)) / (2.0*J)); + /* log(sinpi(z)) using sin(z) = (exp(i*pi*z) - exp(-i*pi*z)) / 2i + * + * No attempt is made to choose any particular branch of the logarithm. + * This is an internal function and the intent is that this that the + * result of log(sinpi(z)) will be added to other terms, and the sum + * will then be exponentiated, making the choice of a specific branch + * unnecessary. + */ + std::complex result = std::log(xsf::sinpi(z)); + // If it doesn't overflow, just do the regular calculation. + if (std::isfinite(result.real()) && !std::isfinite(result.imag())) { + return result; + } + /* Otherwise factor before taking log. This is where we may end up + * taking a branch other than the principal branch. */ + std::complex J(0.0, 1.0); + /* Calculating log((exp(i*pi*z) - exp(-i*pi*z)) / 2i). Factor out term + * with larger magnitude before taking log. */ + if (z.imag() > 0) { + /* if z.imag() > 0 then, exp(-i*pi*z) has greatest magnitude. Factor it + * out to get: + * log(exp(-i*pi*z)*((exp(2*i*pi*z) - 1.0)/(2i)) = + * log(exp(-i*pi*z)) + log((exp(2*i*pi*z) - 1.0)/(2i)) = + * -i*pi*z + log((exp(2*i*pi*z) - 1.0)/(2i)) */ + return -J * M_PI * z + std::log((exppi(2.0 * z * J) - 1.0) / (2.0 * J)); + } + /* if z.imag() < 0 then, exp(i*pi*z) has greatest magnitude. Factor similarly + * to above */ + return J * M_PI * z + std::log((1.0 - exppi(-2.0 * z * J)) / (2.0 * J)); } /* Leading factor in reflection formula for zeta function. @@ -337,39 +300,39 @@ namespace detail { * TODO: Complexify the cephes zeta_reflection implementation, which uses * the lanczos approximation for the gamma function. */ XSF_HOST_DEVICE inline std::complex zeta_reflection_factor_with_logs(std::complex z) { - std::complex t1 = z * M_LN2; - std::complex t2 = (z - 1.0) * xsf::cephes::detail::LOGPI; - std::complex t3 = logsinpi(z / 2.0); - std::complex t4 = xsf::loggamma(1.0 - z); - std::complex factor = std::exp(t1 + t2 + t3 + t4); - return factor; + std::complex t1 = z * M_LN2; + std::complex t2 = (z - 1.0) * xsf::cephes::detail::LOGPI; + std::complex t3 = logsinpi(z / 2.0); + std::complex t4 = xsf::loggamma(1.0 - z); + std::complex factor = std::exp(t1 + t2 + t3 + t4); + return factor; } XSF_HOST_DEVICE inline std::complex zeta_reflection(std::complex z) { - std::complex factor = 2.0 * std::pow(2*M_PI, z - 1.0) * xsf::sinpi(z/2.0) * xsf::gamma(1.0 - z); - if (!std::isfinite(factor.real()) || !std::isfinite(factor.imag())) { - // Try again with logs if standard calculation had overflow. - factor = zeta_reflection_factor_with_logs(z); - } - std::complex result = zeta_right_halfplane(1.0 - z); - /* zeta tends to 1.0 as real part tends to +inf. In cases where - * the real part of zeta tends to -inf, then zeta(1 - z) in the - * reflection formula will tend to 1.0. Factor overflows then, - * factor * result below will become NaN. In this case, we just - * return factor to preserve complex infinity. Only zeta(1 - z) == 1.0 - * is handled because this is the only practical case where we should - * expect zeta(1 - z) == x for a real number x when z is not on the - * real line. */ - return (result == 1.0) ? factor : factor * result; + std::complex factor = 2.0 * std::pow(2 * M_PI, z - 1.0) * xsf::sinpi(z / 2.0) * xsf::gamma(1.0 - z); + if (!std::isfinite(factor.real()) || !std::isfinite(factor.imag())) { + // Try again with logs if standard calculation had overflow. + factor = zeta_reflection_factor_with_logs(z); + } + std::complex result = zeta_right_halfplane(1.0 - z); + /* zeta tends to 1.0 as real part tends to +inf. In cases where + * the real part of zeta tends to -inf, then zeta(1 - z) in the + * reflection formula will tend to 1.0. Factor overflows then, + * factor * result below will become NaN. In this case, we just + * return factor to preserve complex infinity. Only zeta(1 - z) == 1.0 + * is handled because this is the only practical case where we should + * expect zeta(1 - z) == x for a real number x when z is not on the + * real line. */ + return (result == 1.0) ? factor : factor * result; } -} +} // namespace detail XSF_HOST_DEVICE inline std::complex riemann_zeta(std::complex z) { if (z.imag() == 0.0) { - return cephes::riemann_zeta(z.real()); + return cephes::riemann_zeta(z.real()); } if (z.real() >= 0.5) { - return detail::zeta_right_halfplane(z); + return detail::zeta_right_halfplane(z); } return detail::zeta_reflection(z); } @@ -388,7 +351,7 @@ XSF_HOST_DEVICE inline float zeta(float x, float q) { return zeta(static_cast zeta(std::complex z, double q) { if (z.imag() == 0.0) { - return zeta(z.real(), q); + return zeta(z.real(), q); } // Complex input for Hurwitz Zeta is not currently supported. set_error("zeta", SF_ERROR_DOMAIN, NULL); diff --git a/tests/scipy_special_tests/test_airy.cpp b/tests/scipy_special_tests/test_airy.cpp index 8ce3064..bcc34be 100644 --- a/tests/scipy_special_tests/test_airy.cpp +++ b/tests/scipy_special_tests/test_airy.cpp @@ -52,12 +52,13 @@ TEST_CASE("airy D->DDDD scipy_special_tests", "[airy][D->DDDD][scipy_special_tes TEST_CASE("airy d->dddd scipy_special_tests", "[airy][d->dddd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases< - double, std::tuple, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases< + double, std::tuple, std::tuple>( tables_path / "In_d-d_d_d_d.parquet", tables_path / "Out_d-d_d_d_d.parquet", tables_path / ("Err_d-d_d_d_d_" + get_platform_str() + ".parquet") - )); + ) + ); auto z = input; auto [desired0, desired1, desired2, desired3, fallback] = output; diff --git a/tests/scipy_special_tests/test_airye.cpp b/tests/scipy_special_tests/test_airye.cpp index 449e59f..8177f11 100644 --- a/tests/scipy_special_tests/test_airye.cpp +++ b/tests/scipy_special_tests/test_airye.cpp @@ -52,12 +52,13 @@ TEST_CASE("airye D->DDDD scipy_special_tests", "[airye][D->DDDD][scipy_special_t TEST_CASE("airye d->dddd scipy_special_tests", "[airye][d->dddd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases< - double, std::tuple, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases< + double, std::tuple, std::tuple>( tables_path / "In_d-d_d_d_d.parquet", tables_path / "Out_d-d_d_d_d.parquet", tables_path / ("Err_d-d_d_d_d_" + get_platform_str() + ".parquet") - )); + ) + ); auto z = input; auto [desired0, desired1, desired2, desired3, fallback] = output; diff --git a/tests/scipy_special_tests/test_bdtr.cpp b/tests/scipy_special_tests/test_bdtr.cpp index 24ecfd0..42a25f6 100644 --- a/tests/scipy_special_tests/test_bdtr.cpp +++ b/tests/scipy_special_tests/test_bdtr.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "bdtr TEST_CASE("bdtr dpd->d scipy_special_tests", "[bdtr][dpd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_p_d-d.parquet", tables_path / "Out_d_p_d-d.parquet", tables_path / ("Err_d_p_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [k, n, p] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_bdtrc.cpp b/tests/scipy_special_tests/test_bdtrc.cpp index 81a23d7..9063b99 100644 --- a/tests/scipy_special_tests/test_bdtrc.cpp +++ b/tests/scipy_special_tests/test_bdtrc.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "bdtr TEST_CASE("bdtrc dpd->d scipy_special_tests", "[bdtrc][dpd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_p_d-d.parquet", tables_path / "Out_d_p_d-d.parquet", tables_path / ("Err_d_p_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [k, n, p] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_bdtri.cpp b/tests/scipy_special_tests/test_bdtri.cpp index a2078ae..560a83b 100644 --- a/tests/scipy_special_tests/test_bdtri.cpp +++ b/tests/scipy_special_tests/test_bdtri.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "bdtr TEST_CASE("bdtri dpd->d scipy_special_tests", "[bdtri][dpd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_p_d-d.parquet", tables_path / "Out_d_p_d-d.parquet", tables_path / ("Err_d_p_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [k, n, y] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_bei.cpp b/tests/scipy_special_tests/test_bei.cpp index 09de66e..c6e2d6a 100644 --- a/tests/scipy_special_tests/test_bei.cpp +++ b/tests/scipy_special_tests/test_bei.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "bei" TEST_CASE("bei d->d scipy_special_tests", "[bei][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_beip.cpp b/tests/scipy_special_tests/test_beip.cpp index 36b6884..3e3ff1c 100644 --- a/tests/scipy_special_tests/test_beip.cpp +++ b/tests/scipy_special_tests/test_beip.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "beip TEST_CASE("beip d->d scipy_special_tests", "[beip][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_ber.cpp b/tests/scipy_special_tests/test_ber.cpp index 154c16f..d8d7df9 100644 --- a/tests/scipy_special_tests/test_ber.cpp +++ b/tests/scipy_special_tests/test_ber.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "ber" TEST_CASE("ber d->d scipy_special_tests", "[ber][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_berp.cpp b/tests/scipy_special_tests/test_berp.cpp index 72c4289..ba7b08d 100644 --- a/tests/scipy_special_tests/test_berp.cpp +++ b/tests/scipy_special_tests/test_berp.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "berp TEST_CASE("berp d->d scipy_special_tests", "[berp][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_besselpoly.cpp b/tests/scipy_special_tests/test_besselpoly.cpp index dd6ae93..97ea810 100644 --- a/tests/scipy_special_tests/test_besselpoly.cpp +++ b/tests/scipy_special_tests/test_besselpoly.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "bess TEST_CASE("besselpoly ddd->d scipy_special_tests", "[besselpoly][ddd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_d_d-d.parquet", tables_path / "Out_d_d_d-d.parquet", tables_path / ("Err_d_d_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [a, lmb, nu] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_beta.cpp b/tests/scipy_special_tests/test_beta.cpp index a40dbb7..d3e2d90 100644 --- a/tests/scipy_special_tests/test_beta.cpp +++ b/tests/scipy_special_tests/test_beta.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "beta TEST_CASE("beta dd->d scipy_special_tests", "[beta][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [a, b] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_betaln.cpp b/tests/scipy_special_tests/test_betaln.cpp index 173f2fc..096604b 100644 --- a/tests/scipy_special_tests/test_betaln.cpp +++ b/tests/scipy_special_tests/test_betaln.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "beta TEST_CASE("betaln dd->d scipy_special_tests", "[betaln][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [a, b] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_binom.cpp b/tests/scipy_special_tests/test_binom.cpp index 6941e83..970123b 100644 --- a/tests/scipy_special_tests/test_binom.cpp +++ b/tests/scipy_special_tests/test_binom.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "bino TEST_CASE("binom dd->d scipy_special_tests", "[binom][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [n, k] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cbrt.cpp b/tests/scipy_special_tests/test_cbrt.cpp index 5e66247..12b8061 100644 --- a/tests/scipy_special_tests/test_cbrt.cpp +++ b/tests/scipy_special_tests/test_cbrt.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cbrt TEST_CASE("cephes::cbrt d->d scipy_special_tests", "[cephes::cbrt][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cem.cpp b/tests/scipy_special_tests/test_cem.cpp index 80fd4e0..2d7ebea 100644 --- a/tests/scipy_special_tests/test_cem.cpp +++ b/tests/scipy_special_tests/test_cem.cpp @@ -8,12 +8,13 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cem" TEST_CASE("cem ddd->dd scipy_special_tests", "[cem][ddd->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases< - std::tuple, std::tuple, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::tuple, std::tuple, std::tuple>( tables_path / "In_d_d_d-d_d.parquet", tables_path / "Out_d_d_d-d_d.parquet", tables_path / ("Err_d_d_d-d_d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [m, q, x] = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_cem_cva.cpp b/tests/scipy_special_tests/test_cem_cva.cpp index 9efe785..612d689 100644 --- a/tests/scipy_special_tests/test_cem_cva.cpp +++ b/tests/scipy_special_tests/test_cem_cva.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cem_ TEST_CASE("cem_cva dd->d scipy_special_tests", "[cem_cva][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [m, q] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_chdtr.cpp b/tests/scipy_special_tests/test_chdtr.cpp index 1705931..05d988b 100644 --- a/tests/scipy_special_tests/test_chdtr.cpp +++ b/tests/scipy_special_tests/test_chdtr.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "chdt TEST_CASE("chdtr dd->d scipy_special_tests", "[chdtr][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [v, x] = input; auto [desired, fallback] = output; @@ -24,10 +26,12 @@ TEST_CASE("chdtr dd->d scipy_special_tests", "[chdtr][dd->d][scipy_special_tests TEST_CASE("chdtr ff->f scipy_special_tests", "[chdtr][ff->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, float>( - tables_path / "In_f_f-f.parquet", tables_path / "Out_f_f-f.parquet", - tables_path / ("Err_f_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, float>( + tables_path / "In_f_f-f.parquet", tables_path / "Out_f_f-f.parquet", + tables_path / ("Err_f_f-f_" + get_platform_str() + ".parquet") + ) + ); auto [v, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_chdtrc.cpp b/tests/scipy_special_tests/test_chdtrc.cpp index 0d6ba64..70e32fe 100644 --- a/tests/scipy_special_tests/test_chdtrc.cpp +++ b/tests/scipy_special_tests/test_chdtrc.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "chdt TEST_CASE("chdtrc dd->d scipy_special_tests", "[chdtrc][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [v, x] = input; auto [desired, fallback] = output; @@ -24,10 +26,12 @@ TEST_CASE("chdtrc dd->d scipy_special_tests", "[chdtrc][dd->d][scipy_special_tes TEST_CASE("chdtrc ff->f scipy_special_tests", "[chdtrc][ff->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, float>( - tables_path / "In_f_f-f.parquet", tables_path / "Out_f_f-f.parquet", - tables_path / ("Err_f_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, float>( + tables_path / "In_f_f-f.parquet", tables_path / "Out_f_f-f.parquet", + tables_path / ("Err_f_f-f_" + get_platform_str() + ".parquet") + ) + ); auto [v, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_chdtri.cpp b/tests/scipy_special_tests/test_chdtri.cpp index 7b8d2f1..ad48af1 100644 --- a/tests/scipy_special_tests/test_chdtri.cpp +++ b/tests/scipy_special_tests/test_chdtri.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "chdt TEST_CASE("chdtri dd->d scipy_special_tests", "[chdtri][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [v, p] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cosdg.cpp b/tests/scipy_special_tests/test_cosdg.cpp index 1e806b2..115dea7 100644 --- a/tests/scipy_special_tests/test_cosdg.cpp +++ b/tests/scipy_special_tests/test_cosdg.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cosd TEST_CASE("cosdg d->d scipy_special_tests", "[cosdg][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cosm1.cpp b/tests/scipy_special_tests/test_cosm1.cpp index 26f64a7..1d58379 100644 --- a/tests/scipy_special_tests/test_cosm1.cpp +++ b/tests/scipy_special_tests/test_cosm1.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cosm TEST_CASE("cosm1 d->d scipy_special_tests", "[cosm1][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cospi.cpp b/tests/scipy_special_tests/test_cospi.cpp index 06d4e34..d9ea9a9 100644 --- a/tests/scipy_special_tests/test_cospi.cpp +++ b/tests/scipy_special_tests/test_cospi.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cosp TEST_CASE("cospi D->D scipy_special_tests", "[cospi][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired, fallback] = output; @@ -25,10 +26,12 @@ TEST_CASE("cospi D->D scipy_special_tests", "[cospi][D->D][scipy_special_tests]" TEST_CASE("cospi d->d scipy_special_tests", "[cospi][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cotdg.cpp b/tests/scipy_special_tests/test_cotdg.cpp index 2e364d4..8b4e427 100644 --- a/tests/scipy_special_tests/test_cotdg.cpp +++ b/tests/scipy_special_tests/test_cotdg.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cotd TEST_CASE("cotdg d->d scipy_special_tests", "[cotdg][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_i.cpp b/tests/scipy_special_tests/test_cyl_bessel_i.cpp index f43839e..bc8aff2 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_i.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_i.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_i dd->d scipy_special_tests", "[cyl_bessel_i][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [v, z] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_i0.cpp b/tests/scipy_special_tests/test_cyl_bessel_i0.cpp index 746bd9b..3bf304d 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_i0.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_i0.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_i0 f->f scipy_special_tests", "[cyl_bessel_i0][f->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, float>( - tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", - tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, float>( + tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", + tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; @@ -24,10 +26,12 @@ TEST_CASE("cyl_bessel_i0 f->f scipy_special_tests", "[cyl_bessel_i0][f->f][scipy TEST_CASE("cyl_bessel_i0 d->d scipy_special_tests", "[cyl_bessel_i0][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_i0e.cpp b/tests/scipy_special_tests/test_cyl_bessel_i0e.cpp index 0ad5ec9..487d9dc 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_i0e.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_i0e.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_i0e f->f scipy_special_tests", "[cyl_bessel_i0e][f->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, float>( - tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", - tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, float>( + tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", + tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; @@ -24,10 +26,12 @@ TEST_CASE("cyl_bessel_i0e f->f scipy_special_tests", "[cyl_bessel_i0e][f->f][sci TEST_CASE("cyl_bessel_i0e d->d scipy_special_tests", "[cyl_bessel_i0e][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_i1.cpp b/tests/scipy_special_tests/test_cyl_bessel_i1.cpp index c5a1722..60813be 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_i1.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_i1.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_i1 f->f scipy_special_tests", "[cyl_bessel_i1][f->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, float>( - tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", - tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, float>( + tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", + tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; @@ -24,10 +26,12 @@ TEST_CASE("cyl_bessel_i1 f->f scipy_special_tests", "[cyl_bessel_i1][f->f][scipy TEST_CASE("cyl_bessel_i1 d->d scipy_special_tests", "[cyl_bessel_i1][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_i1e.cpp b/tests/scipy_special_tests/test_cyl_bessel_i1e.cpp index 6bc06a9..6e203f7 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_i1e.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_i1e.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_i1e f->f scipy_special_tests", "[cyl_bessel_i1e][f->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, float>( - tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", - tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, float>( + tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", + tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; @@ -24,10 +26,12 @@ TEST_CASE("cyl_bessel_i1e f->f scipy_special_tests", "[cyl_bessel_i1e][f->f][sci TEST_CASE("cyl_bessel_i1e d->d scipy_special_tests", "[cyl_bessel_i1e][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_ie.cpp b/tests/scipy_special_tests/test_cyl_bessel_ie.cpp index 771c4f1..be7f9b2 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_ie.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_ie.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_ie dd->d scipy_special_tests", "[cyl_bessel_ie][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [v, z] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_j.cpp b/tests/scipy_special_tests/test_cyl_bessel_j.cpp index ae1101f..bbad178 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_j.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_j.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_j dd->d scipy_special_tests", "[cyl_bessel_j][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [v, z] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_j0.cpp b/tests/scipy_special_tests/test_cyl_bessel_j0.cpp index 1c704c7..d84e126 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_j0.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_j0.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_j0 d->d scipy_special_tests", "[cyl_bessel_j0][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_j1.cpp b/tests/scipy_special_tests/test_cyl_bessel_j1.cpp index 43a11b2..28b2c48 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_j1.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_j1.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_j1 d->d scipy_special_tests", "[cyl_bessel_j1][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_je.cpp b/tests/scipy_special_tests/test_cyl_bessel_je.cpp index 533ac50..af7ce11 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_je.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_je.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_je dd->d scipy_special_tests", "[cyl_bessel_je][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [v, z] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_k.cpp b/tests/scipy_special_tests/test_cyl_bessel_k.cpp index c0f15d8..00178cf 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_k.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_k.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_k dd->d scipy_special_tests", "[cyl_bessel_k][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [v, z] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_k0.cpp b/tests/scipy_special_tests/test_cyl_bessel_k0.cpp index 5d6a9ca..419b961 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_k0.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_k0.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_k0 d->d scipy_special_tests", "[cyl_bessel_k0][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_k0e.cpp b/tests/scipy_special_tests/test_cyl_bessel_k0e.cpp index 878cfac..6e9c3b9 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_k0e.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_k0e.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_k0e d->d scipy_special_tests", "[cyl_bessel_k0e][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_k1.cpp b/tests/scipy_special_tests/test_cyl_bessel_k1.cpp index c1db751..784545c 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_k1.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_k1.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_k1 d->d scipy_special_tests", "[cyl_bessel_k1][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_k1e.cpp b/tests/scipy_special_tests/test_cyl_bessel_k1e.cpp index 61f8ad5..496bac8 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_k1e.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_k1e.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_k1e d->d scipy_special_tests", "[cyl_bessel_k1e][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_ke.cpp b/tests/scipy_special_tests/test_cyl_bessel_ke.cpp index 3e70e68..2e5c88e 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_ke.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_ke.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_ke dd->d scipy_special_tests", "[cyl_bessel_ke][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [v, z] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_y.cpp b/tests/scipy_special_tests/test_cyl_bessel_y.cpp index c9ee0b8..de6fe8c 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_y.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_y.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_y dd->d scipy_special_tests", "[cyl_bessel_y][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [v, z] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_y0.cpp b/tests/scipy_special_tests/test_cyl_bessel_y0.cpp index 0161c5c..4f2c7c4 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_y0.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_y0.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_y0 d->d scipy_special_tests", "[cyl_bessel_y0][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_y1.cpp b/tests/scipy_special_tests/test_cyl_bessel_y1.cpp index 64399bc..9d6969a 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_y1.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_y1.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_y1 d->d scipy_special_tests", "[cyl_bessel_y1][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_cyl_bessel_ye.cpp b/tests/scipy_special_tests/test_cyl_bessel_ye.cpp index 19ab470..aff1976 100644 --- a/tests/scipy_special_tests/test_cyl_bessel_ye.cpp +++ b/tests/scipy_special_tests/test_cyl_bessel_ye.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "cyl_ TEST_CASE("cyl_bessel_ye dd->d scipy_special_tests", "[cyl_bessel_ye][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [v, z] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_dawsn.cpp b/tests/scipy_special_tests/test_dawsn.cpp index d7cc1e3..1dc859e 100644 --- a/tests/scipy_special_tests/test_dawsn.cpp +++ b/tests/scipy_special_tests/test_dawsn.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "daws TEST_CASE("dawsn D->D scipy_special_tests", "[dawsn][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired, fallback] = output; @@ -25,10 +26,12 @@ TEST_CASE("dawsn D->D scipy_special_tests", "[dawsn][D->D][scipy_special_tests]" TEST_CASE("dawsn d->d scipy_special_tests", "[dawsn][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_digamma.cpp b/tests/scipy_special_tests/test_digamma.cpp index d6bd460..785c66e 100644 --- a/tests/scipy_special_tests/test_digamma.cpp +++ b/tests/scipy_special_tests/test_digamma.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "diga TEST_CASE("digamma D->D scipy_special_tests", "[digamma][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired, fallback] = output; @@ -25,10 +26,12 @@ TEST_CASE("digamma D->D scipy_special_tests", "[digamma][D->D][scipy_special_tes TEST_CASE("digamma d->d scipy_special_tests", "[digamma][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_ellipe.cpp b/tests/scipy_special_tests/test_ellipe.cpp index 39577aa..f8ac1d6 100644 --- a/tests/scipy_special_tests/test_ellipe.cpp +++ b/tests/scipy_special_tests/test_ellipe.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "elli TEST_CASE("ellipe d->d scipy_special_tests", "[ellipe][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto m = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_ellipeinc.cpp b/tests/scipy_special_tests/test_ellipeinc.cpp index 301104c..69a887e 100644 --- a/tests/scipy_special_tests/test_ellipeinc.cpp +++ b/tests/scipy_special_tests/test_ellipeinc.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "elli TEST_CASE("ellipeinc dd->d scipy_special_tests", "[ellipeinc][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [phi, m] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_ellipj.cpp b/tests/scipy_special_tests/test_ellipj.cpp index cb52452..a8ba366 100644 --- a/tests/scipy_special_tests/test_ellipj.cpp +++ b/tests/scipy_special_tests/test_ellipj.cpp @@ -8,12 +8,14 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "elli TEST_CASE("ellipj dd->dddd scipy_special_tests", "[ellipj][dd->dddd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases< - std::tuple, std::tuple, - std::tuple>( - tables_path / "In_d_d-d_d_d_d.parquet", tables_path / "Out_d_d-d_d_d_d.parquet", - tables_path / ("Err_d_d-d_d_d_d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::tuple, std::tuple, + std::tuple>( + tables_path / "In_d_d-d_d_d_d.parquet", tables_path / "Out_d_d-d_d_d_d.parquet", + tables_path / ("Err_d_d-d_d_d_d_" + get_platform_str() + ".parquet") + ) + ); auto [u, m] = input; auto [desired0, desired1, desired2, desired3, fallback] = output; diff --git a/tests/scipy_special_tests/test_ellipk.cpp b/tests/scipy_special_tests/test_ellipk.cpp index fe6c4e9..aee1165 100644 --- a/tests/scipy_special_tests/test_ellipk.cpp +++ b/tests/scipy_special_tests/test_ellipk.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "elli TEST_CASE("ellipk d->d scipy_special_tests", "[ellipk][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto m = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_ellipkinc.cpp b/tests/scipy_special_tests/test_ellipkinc.cpp index a2c436d..f591378 100644 --- a/tests/scipy_special_tests/test_ellipkinc.cpp +++ b/tests/scipy_special_tests/test_ellipkinc.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "elli TEST_CASE("ellipkinc dd->d scipy_special_tests", "[ellipkinc][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [phi, m] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_ellipkm1.cpp b/tests/scipy_special_tests/test_ellipkm1.cpp index 1f52934..25677d2 100644 --- a/tests/scipy_special_tests/test_ellipkm1.cpp +++ b/tests/scipy_special_tests/test_ellipkm1.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "elli TEST_CASE("ellipkm1 d->d scipy_special_tests", "[ellipkm1][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto p = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_erf.cpp b/tests/scipy_special_tests/test_erf.cpp index cb24618..30b6f49 100644 --- a/tests/scipy_special_tests/test_erf.cpp +++ b/tests/scipy_special_tests/test_erf.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "erf" TEST_CASE("erf f->f scipy_special_tests", "[erf][f->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, float>( - tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", - tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, float>( + tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", + tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; @@ -24,11 +26,12 @@ TEST_CASE("erf f->f scipy_special_tests", "[erf][f->f][scipy_special_tests]") { TEST_CASE("erf D->D scipy_special_tests", "[erf][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired, fallback] = output; @@ -41,10 +44,12 @@ TEST_CASE("erf D->D scipy_special_tests", "[erf][D->D][scipy_special_tests]") { TEST_CASE("erf d->d scipy_special_tests", "[erf][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_erfc.cpp b/tests/scipy_special_tests/test_erfc.cpp index cc11a2b..99bb70b 100644 --- a/tests/scipy_special_tests/test_erfc.cpp +++ b/tests/scipy_special_tests/test_erfc.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "erfc TEST_CASE("erfc f->f scipy_special_tests", "[erfc][f->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, float>( - tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", - tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, float>( + tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", + tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; @@ -24,11 +26,12 @@ TEST_CASE("erfc f->f scipy_special_tests", "[erfc][f->f][scipy_special_tests]") TEST_CASE("erfc D->D scipy_special_tests", "[erfc][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired, fallback] = output; @@ -41,10 +44,12 @@ TEST_CASE("erfc D->D scipy_special_tests", "[erfc][D->D][scipy_special_tests]") TEST_CASE("erfc d->d scipy_special_tests", "[erfc][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_erfcinv.cpp b/tests/scipy_special_tests/test_erfcinv.cpp index c74e60a..171b691 100644 --- a/tests/scipy_special_tests/test_erfcinv.cpp +++ b/tests/scipy_special_tests/test_erfcinv.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "erfc TEST_CASE("cephes::erfcinv d->d scipy_special_tests", "[cephes::erfcinv][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_erfcx.cpp b/tests/scipy_special_tests/test_erfcx.cpp index 455c0cc..5d8ce61 100644 --- a/tests/scipy_special_tests/test_erfcx.cpp +++ b/tests/scipy_special_tests/test_erfcx.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "erfc TEST_CASE("erfcx D->D scipy_special_tests", "[erfcx][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired, fallback] = output; @@ -25,10 +26,12 @@ TEST_CASE("erfcx D->D scipy_special_tests", "[erfcx][D->D][scipy_special_tests]" TEST_CASE("erfcx d->d scipy_special_tests", "[erfcx][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_erfi.cpp b/tests/scipy_special_tests/test_erfi.cpp index 6f88c22..46c31c8 100644 --- a/tests/scipy_special_tests/test_erfi.cpp +++ b/tests/scipy_special_tests/test_erfi.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "erfi TEST_CASE("erfi D->D scipy_special_tests", "[erfi][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired, fallback] = output; @@ -25,10 +26,12 @@ TEST_CASE("erfi D->D scipy_special_tests", "[erfi][D->D][scipy_special_tests]") TEST_CASE("erfi d->d scipy_special_tests", "[erfi][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_exp1.cpp b/tests/scipy_special_tests/test_exp1.cpp index 787a57b..9603265 100644 --- a/tests/scipy_special_tests/test_exp1.cpp +++ b/tests/scipy_special_tests/test_exp1.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "exp1 TEST_CASE("exp1 D->D scipy_special_tests", "[exp1][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired, fallback] = output; @@ -25,10 +26,12 @@ TEST_CASE("exp1 D->D scipy_special_tests", "[exp1][D->D][scipy_special_tests]") TEST_CASE("exp1 d->d scipy_special_tests", "[exp1][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_exp10.cpp b/tests/scipy_special_tests/test_exp10.cpp index 04b1f84..3a0a2b7 100644 --- a/tests/scipy_special_tests/test_exp10.cpp +++ b/tests/scipy_special_tests/test_exp10.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "exp1 TEST_CASE("exp10 d->d scipy_special_tests", "[exp10][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_exp2.cpp b/tests/scipy_special_tests/test_exp2.cpp index 38847b5..85ee0eb 100644 --- a/tests/scipy_special_tests/test_exp2.cpp +++ b/tests/scipy_special_tests/test_exp2.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "exp2 TEST_CASE("exp2 d->d scipy_special_tests", "[exp2][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_expi.cpp b/tests/scipy_special_tests/test_expi.cpp index 0f62daa..173ed55 100644 --- a/tests/scipy_special_tests/test_expi.cpp +++ b/tests/scipy_special_tests/test_expi.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "expi TEST_CASE("expi D->D scipy_special_tests", "[expi][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired, fallback] = output; @@ -25,10 +26,12 @@ TEST_CASE("expi D->D scipy_special_tests", "[expi][D->D][scipy_special_tests]") TEST_CASE("expi d->d scipy_special_tests", "[expi][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_expit.cpp b/tests/scipy_special_tests/test_expit.cpp index a20a767..5c15fe0 100644 --- a/tests/scipy_special_tests/test_expit.cpp +++ b/tests/scipy_special_tests/test_expit.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "expi TEST_CASE("expit f->f scipy_special_tests", "[expit][f->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, float>( - tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", - tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, float>( + tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", + tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; @@ -24,10 +26,12 @@ TEST_CASE("expit f->f scipy_special_tests", "[expit][f->f][scipy_special_tests]" TEST_CASE("expit d->d scipy_special_tests", "[expit][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_expm1.cpp b/tests/scipy_special_tests/test_expm1.cpp index a3dc546..b8bf624 100644 --- a/tests/scipy_special_tests/test_expm1.cpp +++ b/tests/scipy_special_tests/test_expm1.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "expm TEST_CASE("expm1 D->D scipy_special_tests", "[expm1][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired, fallback] = output; @@ -25,10 +26,12 @@ TEST_CASE("expm1 D->D scipy_special_tests", "[expm1][D->D][scipy_special_tests]" TEST_CASE("expm1 d->d scipy_special_tests", "[expm1][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_expn.cpp b/tests/scipy_special_tests/test_expn.cpp index 85bd1e8..d19361e 100644 --- a/tests/scipy_special_tests/test_expn.cpp +++ b/tests/scipy_special_tests/test_expn.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "expn TEST_CASE("cephes::expn dd->d scipy_special_tests", "[cephes::expn][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [n, x] = input; auto [desired, fallback] = output; @@ -24,11 +26,12 @@ TEST_CASE("cephes::expn dd->d scipy_special_tests", "[cephes::expn][dd->d][scipy TEST_CASE("cephes::expn pd->d scipy_special_tests", "[cephes::expn][pd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_p_d-d.parquet", tables_path / "Out_p_d-d.parquet", tables_path / ("Err_p_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [n, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_exprel.cpp b/tests/scipy_special_tests/test_exprel.cpp index 733f339..1d41878 100644 --- a/tests/scipy_special_tests/test_exprel.cpp +++ b/tests/scipy_special_tests/test_exprel.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "expr TEST_CASE("exprel d->d scipy_special_tests", "[exprel][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_fdtr.cpp b/tests/scipy_special_tests/test_fdtr.cpp index c02afd3..7d59416 100644 --- a/tests/scipy_special_tests/test_fdtr.cpp +++ b/tests/scipy_special_tests/test_fdtr.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "fdtr TEST_CASE("fdtr ddd->d scipy_special_tests", "[fdtr][ddd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_d_d-d.parquet", tables_path / "Out_d_d_d-d.parquet", tables_path / ("Err_d_d_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [dfn, dfd, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_fdtrc.cpp b/tests/scipy_special_tests/test_fdtrc.cpp index 5d77d48..ee75df8 100644 --- a/tests/scipy_special_tests/test_fdtrc.cpp +++ b/tests/scipy_special_tests/test_fdtrc.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "fdtr TEST_CASE("fdtrc ddd->d scipy_special_tests", "[fdtrc][ddd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_d_d-d.parquet", tables_path / "Out_d_d_d-d.parquet", tables_path / ("Err_d_d_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [dfn, dfd, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_fdtri.cpp b/tests/scipy_special_tests/test_fdtri.cpp index 64a5883..e8e2b8a 100644 --- a/tests/scipy_special_tests/test_fdtri.cpp +++ b/tests/scipy_special_tests/test_fdtri.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "fdtr TEST_CASE("fdtri ddd->d scipy_special_tests", "[fdtri][ddd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_d_d-d.parquet", tables_path / "Out_d_d_d-d.parquet", tables_path / ("Err_d_d_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [dfn, dfd, p] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_fresnel.cpp b/tests/scipy_special_tests/test_fresnel.cpp index 7f206aa..c525c7c 100644 --- a/tests/scipy_special_tests/test_fresnel.cpp +++ b/tests/scipy_special_tests/test_fresnel.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "fres TEST_CASE("fresnel d->dd scipy_special_tests", "[fresnel][d->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple>( tables_path / "In_d-d_d.parquet", tables_path / "Out_d-d_d.parquet", tables_path / ("Err_d-d_d_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired0, desired1, fallback] = output; @@ -36,13 +37,14 @@ TEST_CASE("fresnel d->dd scipy_special_tests", "[fresnel][d->dd][scipy_special_t TEST_CASE("fresnel D->DD scipy_special_tests", "[fresnel][D->DD][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases< - std::complex, std::tuple, std::complex, bool>, - std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::complex, std::tuple, std::complex, bool>, + std::tuple>( tables_path / "In_cd-cd_cd.parquet", tables_path / "Out_cd-cd_cd.parquet", tables_path / ("Err_cd-cd_cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_gamma.cpp b/tests/scipy_special_tests/test_gamma.cpp index dd29809..7ae9524 100644 --- a/tests/scipy_special_tests/test_gamma.cpp +++ b/tests/scipy_special_tests/test_gamma.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "gamm TEST_CASE("gamma D->D scipy_special_tests", "[gamma][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired, fallback] = output; @@ -25,10 +26,12 @@ TEST_CASE("gamma D->D scipy_special_tests", "[gamma][D->D][scipy_special_tests]" TEST_CASE("gamma d->d scipy_special_tests", "[gamma][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_gammainc.cpp b/tests/scipy_special_tests/test_gammainc.cpp index 65d7ea5..f8a9ca1 100644 --- a/tests/scipy_special_tests/test_gammainc.cpp +++ b/tests/scipy_special_tests/test_gammainc.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "gamm TEST_CASE("gammainc dd->d scipy_special_tests", "[gammainc][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [a, x] = input; auto [desired, fallback] = output; @@ -24,10 +26,12 @@ TEST_CASE("gammainc dd->d scipy_special_tests", "[gammainc][dd->d][scipy_special TEST_CASE("gammainc ff->f scipy_special_tests", "[gammainc][ff->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, float>( - tables_path / "In_f_f-f.parquet", tables_path / "Out_f_f-f.parquet", - tables_path / ("Err_f_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, float>( + tables_path / "In_f_f-f.parquet", tables_path / "Out_f_f-f.parquet", + tables_path / ("Err_f_f-f_" + get_platform_str() + ".parquet") + ) + ); auto [a, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_gammaincc.cpp b/tests/scipy_special_tests/test_gammaincc.cpp index 2b8ab5b..300cc1b 100644 --- a/tests/scipy_special_tests/test_gammaincc.cpp +++ b/tests/scipy_special_tests/test_gammaincc.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "gamm TEST_CASE("gammaincc dd->d scipy_special_tests", "[gammaincc][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [a, x] = input; auto [desired, fallback] = output; @@ -24,10 +26,12 @@ TEST_CASE("gammaincc dd->d scipy_special_tests", "[gammaincc][dd->d][scipy_speci TEST_CASE("gammaincc ff->f scipy_special_tests", "[gammaincc][ff->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, float>( - tables_path / "In_f_f-f.parquet", tables_path / "Out_f_f-f.parquet", - tables_path / ("Err_f_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, float>( + tables_path / "In_f_f-f.parquet", tables_path / "Out_f_f-f.parquet", + tables_path / ("Err_f_f-f_" + get_platform_str() + ".parquet") + ) + ); auto [a, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_gammainccinv.cpp b/tests/scipy_special_tests/test_gammainccinv.cpp index 5eacf59..6432739 100644 --- a/tests/scipy_special_tests/test_gammainccinv.cpp +++ b/tests/scipy_special_tests/test_gammainccinv.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "gamm TEST_CASE("gammainccinv dd->d scipy_special_tests", "[gammainccinv][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [a, y] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_gammaincinv.cpp b/tests/scipy_special_tests/test_gammaincinv.cpp index ce06c9f..e0375d8 100644 --- a/tests/scipy_special_tests/test_gammaincinv.cpp +++ b/tests/scipy_special_tests/test_gammaincinv.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "gamm TEST_CASE("gammaincinv dd->d scipy_special_tests", "[gammaincinv][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [a, y] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_gammaln.cpp b/tests/scipy_special_tests/test_gammaln.cpp index b1c7507..75ed3f8 100644 --- a/tests/scipy_special_tests/test_gammaln.cpp +++ b/tests/scipy_special_tests/test_gammaln.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "gamm TEST_CASE("gammaln f->f scipy_special_tests", "[gammaln][f->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, float>( - tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", - tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, float>( + tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", + tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; @@ -24,10 +26,12 @@ TEST_CASE("gammaln f->f scipy_special_tests", "[gammaln][f->f][scipy_special_tes TEST_CASE("gammaln d->d scipy_special_tests", "[gammaln][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_gammasgn.cpp b/tests/scipy_special_tests/test_gammasgn.cpp index f333950..148a256 100644 --- a/tests/scipy_special_tests/test_gammasgn.cpp +++ b/tests/scipy_special_tests/test_gammasgn.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "gamm TEST_CASE("gammasgn d->d scipy_special_tests", "[gammasgn][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_gdtr.cpp b/tests/scipy_special_tests/test_gdtr.cpp index 72e9cc1..8af536e 100644 --- a/tests/scipy_special_tests/test_gdtr.cpp +++ b/tests/scipy_special_tests/test_gdtr.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "gdtr TEST_CASE("gdtr ddd->d scipy_special_tests", "[gdtr][ddd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_d_d-d.parquet", tables_path / "Out_d_d_d-d.parquet", tables_path / ("Err_d_d_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [a, b, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_gdtrc.cpp b/tests/scipy_special_tests/test_gdtrc.cpp index c7d0fae..4c383da 100644 --- a/tests/scipy_special_tests/test_gdtrc.cpp +++ b/tests/scipy_special_tests/test_gdtrc.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "gdtr TEST_CASE("gdtrc ddd->d scipy_special_tests", "[gdtrc][ddd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_d_d-d.parquet", tables_path / "Out_d_d_d-d.parquet", tables_path / ("Err_d_d_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [a, b, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_gdtrib.cpp b/tests/scipy_special_tests/test_gdtrib.cpp index 9d4b60d..1aee29b 100644 --- a/tests/scipy_special_tests/test_gdtrib.cpp +++ b/tests/scipy_special_tests/test_gdtrib.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "gdtr TEST_CASE("gdtrib ddd->d scipy_special_tests", "[gdtrib][ddd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_d_d-d.parquet", tables_path / "Out_d_d_d-d.parquet", tables_path / ("Err_d_d_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [a, p, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_hyp1f1.cpp b/tests/scipy_special_tests/test_hyp1f1.cpp index 57374e7..d445596 100644 --- a/tests/scipy_special_tests/test_hyp1f1.cpp +++ b/tests/scipy_special_tests/test_hyp1f1.cpp @@ -8,12 +8,13 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "hyp1 TEST_CASE("hyp1f1 ddD->D scipy_special_tests", "[hyp1f1][ddD->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases< - std::tuple>, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::tuple>, std::tuple, bool>, double>( tables_path / "In_d_d_cd-cd.parquet", tables_path / "Out_d_d_cd-cd.parquet", tables_path / ("Err_d_d_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto [a, b, z] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_hyp2f1.cpp b/tests/scipy_special_tests/test_hyp2f1.cpp index 192cf92..cfe31a9 100644 --- a/tests/scipy_special_tests/test_hyp2f1.cpp +++ b/tests/scipy_special_tests/test_hyp2f1.cpp @@ -27,11 +27,12 @@ TEST_CASE("hyp2f1 dddD->D scipy_special_tests", "[hyp2f1][dddD->D][scipy_special TEST_CASE("hyp2f1 dddd->d scipy_special_tests", "[hyp2f1][dddd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_d_d_d-d.parquet", tables_path / "Out_d_d_d_d-d.parquet", tables_path / ("Err_d_d_d_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [a, b, c, z] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_it1i0k0.cpp b/tests/scipy_special_tests/test_it1i0k0.cpp index b69f5bd..d175a0a 100644 --- a/tests/scipy_special_tests/test_it1i0k0.cpp +++ b/tests/scipy_special_tests/test_it1i0k0.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "it1i TEST_CASE("it1i0k0 d->dd scipy_special_tests", "[it1i0k0][d->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple>( tables_path / "In_d-d_d.parquet", tables_path / "Out_d-d_d.parquet", tables_path / ("Err_d-d_d_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_it1j0y0.cpp b/tests/scipy_special_tests/test_it1j0y0.cpp index 692690c..01bc53c 100644 --- a/tests/scipy_special_tests/test_it1j0y0.cpp +++ b/tests/scipy_special_tests/test_it1j0y0.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "it1j TEST_CASE("it1j0y0 d->dd scipy_special_tests", "[it1j0y0][d->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple>( tables_path / "In_d-d_d.parquet", tables_path / "Out_d-d_d.parquet", tables_path / ("Err_d-d_d_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_it2i0k0.cpp b/tests/scipy_special_tests/test_it2i0k0.cpp index 7374ebf..ec5f12b 100644 --- a/tests/scipy_special_tests/test_it2i0k0.cpp +++ b/tests/scipy_special_tests/test_it2i0k0.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "it2i TEST_CASE("it2i0k0 d->dd scipy_special_tests", "[it2i0k0][d->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple>( tables_path / "In_d-d_d.parquet", tables_path / "Out_d-d_d.parquet", tables_path / ("Err_d-d_d_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_it2j0y0.cpp b/tests/scipy_special_tests/test_it2j0y0.cpp index 9332e18..a79af11 100644 --- a/tests/scipy_special_tests/test_it2j0y0.cpp +++ b/tests/scipy_special_tests/test_it2j0y0.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "it2j TEST_CASE("it2j0y0 d->dd scipy_special_tests", "[it2j0y0][d->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple>( tables_path / "In_d-d_d.parquet", tables_path / "Out_d-d_d.parquet", tables_path / ("Err_d-d_d_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_it2struve0.cpp b/tests/scipy_special_tests/test_it2struve0.cpp index 0786d9e..e4018b4 100644 --- a/tests/scipy_special_tests/test_it2struve0.cpp +++ b/tests/scipy_special_tests/test_it2struve0.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "it2s TEST_CASE("it2struve0 d->d scipy_special_tests", "[it2struve0][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_itairy.cpp b/tests/scipy_special_tests/test_itairy.cpp index 2905659..330dfae 100644 --- a/tests/scipy_special_tests/test_itairy.cpp +++ b/tests/scipy_special_tests/test_itairy.cpp @@ -8,12 +8,13 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "itai TEST_CASE("itairy d->dddd scipy_special_tests", "[itairy][d->dddd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases< - double, std::tuple, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases< + double, std::tuple, std::tuple>( tables_path / "In_d-d_d_d_d.parquet", tables_path / "Out_d-d_d_d_d.parquet", tables_path / ("Err_d-d_d_d_d_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired0, desired1, desired2, desired3, fallback] = output; diff --git a/tests/scipy_special_tests/test_itmodstruve0.cpp b/tests/scipy_special_tests/test_itmodstruve0.cpp index e231b76..9dc0d38 100644 --- a/tests/scipy_special_tests/test_itmodstruve0.cpp +++ b/tests/scipy_special_tests/test_itmodstruve0.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "itmo TEST_CASE("itmodstruve0 d->d scipy_special_tests", "[itmodstruve0][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_itstruve0.cpp b/tests/scipy_special_tests/test_itstruve0.cpp index 88c6b8c..eec9ce3 100644 --- a/tests/scipy_special_tests/test_itstruve0.cpp +++ b/tests/scipy_special_tests/test_itstruve0.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "itst TEST_CASE("itstruve0 d->d scipy_special_tests", "[itstruve0][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_iv_ratio.cpp b/tests/scipy_special_tests/test_iv_ratio.cpp index 721bafd..60924a3 100644 --- a/tests/scipy_special_tests/test_iv_ratio.cpp +++ b/tests/scipy_special_tests/test_iv_ratio.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "iv_r TEST_CASE("iv_ratio dd->d scipy_special_tests", "[iv_ratio][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [v, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_iv_ratio_c.cpp b/tests/scipy_special_tests/test_iv_ratio_c.cpp index 103d066..92488b4 100644 --- a/tests/scipy_special_tests/test_iv_ratio_c.cpp +++ b/tests/scipy_special_tests/test_iv_ratio_c.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "iv_r TEST_CASE("iv_ratio_c dd->d scipy_special_tests", "[iv_ratio_c][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [v, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_kei.cpp b/tests/scipy_special_tests/test_kei.cpp index b883d4a..b4014b6 100644 --- a/tests/scipy_special_tests/test_kei.cpp +++ b/tests/scipy_special_tests/test_kei.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "kei" TEST_CASE("kei d->d scipy_special_tests", "[kei][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_keip.cpp b/tests/scipy_special_tests/test_keip.cpp index 6f12def..99146a6 100644 --- a/tests/scipy_special_tests/test_keip.cpp +++ b/tests/scipy_special_tests/test_keip.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "keip TEST_CASE("keip d->d scipy_special_tests", "[keip][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_ker.cpp b/tests/scipy_special_tests/test_ker.cpp index d59055c..b3a48a1 100644 --- a/tests/scipy_special_tests/test_ker.cpp +++ b/tests/scipy_special_tests/test_ker.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "ker" TEST_CASE("ker d->d scipy_special_tests", "[ker][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_kerp.cpp b/tests/scipy_special_tests/test_kerp.cpp index c36fcc0..aedbc26 100644 --- a/tests/scipy_special_tests/test_kerp.cpp +++ b/tests/scipy_special_tests/test_kerp.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "kerp TEST_CASE("kerp d->d scipy_special_tests", "[kerp][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_kolmogc.cpp b/tests/scipy_special_tests/test_kolmogc.cpp index aa311ff..774bdf6 100644 --- a/tests/scipy_special_tests/test_kolmogc.cpp +++ b/tests/scipy_special_tests/test_kolmogc.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "kolm TEST_CASE("kolmogc d->d scipy_special_tests", "[kolmogc][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_kolmogci.cpp b/tests/scipy_special_tests/test_kolmogci.cpp index 29718f8..02a2751 100644 --- a/tests/scipy_special_tests/test_kolmogci.cpp +++ b/tests/scipy_special_tests/test_kolmogci.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "kolm TEST_CASE("kolmogci d->d scipy_special_tests", "[kolmogci][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_kolmogi.cpp b/tests/scipy_special_tests/test_kolmogi.cpp index d171d39..4bf2239 100644 --- a/tests/scipy_special_tests/test_kolmogi.cpp +++ b/tests/scipy_special_tests/test_kolmogi.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "kolm TEST_CASE("kolmogi d->d scipy_special_tests", "[kolmogi][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_kolmogorov.cpp b/tests/scipy_special_tests/test_kolmogorov.cpp index 65310ca..0ff21b8 100644 --- a/tests/scipy_special_tests/test_kolmogorov.cpp +++ b/tests/scipy_special_tests/test_kolmogorov.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "kolm TEST_CASE("kolmogorov d->d scipy_special_tests", "[kolmogorov][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_kolmogp.cpp b/tests/scipy_special_tests/test_kolmogp.cpp index 1d07a69..826e2e6 100644 --- a/tests/scipy_special_tests/test_kolmogp.cpp +++ b/tests/scipy_special_tests/test_kolmogp.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "kolm TEST_CASE("kolmogp d->d scipy_special_tests", "[kolmogp][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_lanczos_sum_expg_scaled.cpp b/tests/scipy_special_tests/test_lanczos_sum_expg_scaled.cpp index 0ce2f37..7dd3831 100644 --- a/tests/scipy_special_tests/test_lanczos_sum_expg_scaled.cpp +++ b/tests/scipy_special_tests/test_lanczos_sum_expg_scaled.cpp @@ -11,10 +11,12 @@ TEST_CASE( "[cephes::lanczos_sum_expg_scaled][d->d][scipy_special_tests]" ) { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_lgam1p.cpp b/tests/scipy_special_tests/test_lgam1p.cpp index 1c6ef20..6d891f6 100644 --- a/tests/scipy_special_tests/test_lgam1p.cpp +++ b/tests/scipy_special_tests/test_lgam1p.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "lgam TEST_CASE("cephes::lgam1p d->d scipy_special_tests", "[cephes::lgam1p][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_log1p.cpp b/tests/scipy_special_tests/test_log1p.cpp index 3a89308..3dddc4b 100644 --- a/tests/scipy_special_tests/test_log1p.cpp +++ b/tests/scipy_special_tests/test_log1p.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "log1 TEST_CASE("log1p D->D scipy_special_tests", "[log1p][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto z = input; auto [desired, fallback] = output; @@ -25,10 +26,12 @@ TEST_CASE("log1p D->D scipy_special_tests", "[log1p][D->D][scipy_special_tests]" TEST_CASE("log1p d->d scipy_special_tests", "[log1p][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_log1pmx.cpp b/tests/scipy_special_tests/test_log1pmx.cpp index 6ab870b..d91883d 100644 --- a/tests/scipy_special_tests/test_log1pmx.cpp +++ b/tests/scipy_special_tests/test_log1pmx.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "log1 TEST_CASE("log1pmx d->d scipy_special_tests", "[log1pmx][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_log_expit.cpp b/tests/scipy_special_tests/test_log_expit.cpp index 6dc3f63..b53439f 100644 --- a/tests/scipy_special_tests/test_log_expit.cpp +++ b/tests/scipy_special_tests/test_log_expit.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "log_ TEST_CASE("log_expit f->f scipy_special_tests", "[log_expit][f->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, float>( - tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", - tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, float>( + tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", + tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; @@ -24,10 +26,12 @@ TEST_CASE("log_expit f->f scipy_special_tests", "[log_expit][f->f][scipy_special TEST_CASE("log_expit d->d scipy_special_tests", "[log_expit][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_log_wright_bessel.cpp b/tests/scipy_special_tests/test_log_wright_bessel.cpp index aaa9cda..adaed7f 100644 --- a/tests/scipy_special_tests/test_log_wright_bessel.cpp +++ b/tests/scipy_special_tests/test_log_wright_bessel.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "log_ TEST_CASE("log_wright_bessel ddd->d scipy_special_tests", "[log_wright_bessel][ddd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_d_d-d.parquet", tables_path / "Out_d_d_d-d.parquet", tables_path / ("Err_d_d_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [a, b, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_loggamma.cpp b/tests/scipy_special_tests/test_loggamma.cpp index 5210969..6b00fa6 100644 --- a/tests/scipy_special_tests/test_loggamma.cpp +++ b/tests/scipy_special_tests/test_loggamma.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "logg TEST_CASE("loggamma D->D scipy_special_tests", "[loggamma][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto z = input; auto [desired, fallback] = output; @@ -25,10 +26,12 @@ TEST_CASE("loggamma D->D scipy_special_tests", "[loggamma][D->D][scipy_special_t TEST_CASE("loggamma d->d scipy_special_tests", "[loggamma][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_logit.cpp b/tests/scipy_special_tests/test_logit.cpp index 9d4423d..1b38788 100644 --- a/tests/scipy_special_tests/test_logit.cpp +++ b/tests/scipy_special_tests/test_logit.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "logi TEST_CASE("logit f->f scipy_special_tests", "[logit][f->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, float>( - tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", - tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, float>( + tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", + tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") + ) + ); auto p = input; auto [desired, fallback] = output; @@ -24,10 +26,12 @@ TEST_CASE("logit f->f scipy_special_tests", "[logit][f->f][scipy_special_tests]" TEST_CASE("logit d->d scipy_special_tests", "[logit][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto p = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_mcm1.cpp b/tests/scipy_special_tests/test_mcm1.cpp index 213dc05..bdc5e76 100644 --- a/tests/scipy_special_tests/test_mcm1.cpp +++ b/tests/scipy_special_tests/test_mcm1.cpp @@ -8,12 +8,13 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "mcm1 TEST_CASE("mcm1 ddd->dd scipy_special_tests", "[mcm1][ddd->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases< - std::tuple, std::tuple, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::tuple, std::tuple, std::tuple>( tables_path / "In_d_d_d-d_d.parquet", tables_path / "Out_d_d_d-d_d.parquet", tables_path / ("Err_d_d_d-d_d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [m, q, x] = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_mcm2.cpp b/tests/scipy_special_tests/test_mcm2.cpp index 4ae20d5..dc9bf7d 100644 --- a/tests/scipy_special_tests/test_mcm2.cpp +++ b/tests/scipy_special_tests/test_mcm2.cpp @@ -8,12 +8,13 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "mcm2 TEST_CASE("mcm2 ddd->dd scipy_special_tests", "[mcm2][ddd->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases< - std::tuple, std::tuple, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::tuple, std::tuple, std::tuple>( tables_path / "In_d_d_d-d_d.parquet", tables_path / "Out_d_d_d-d_d.parquet", tables_path / ("Err_d_d_d-d_d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [m, q, x] = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_modified_fresnel_minus.cpp b/tests/scipy_special_tests/test_modified_fresnel_minus.cpp index dbf1a23..c45c802 100644 --- a/tests/scipy_special_tests/test_modified_fresnel_minus.cpp +++ b/tests/scipy_special_tests/test_modified_fresnel_minus.cpp @@ -8,12 +8,13 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "modi TEST_CASE("modified_fresnel_minus d->DD scipy_special_tests", "[modified_fresnel_minus][d->DD][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases< - double, std::tuple, std::complex, bool>, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases< + double, std::tuple, std::complex, bool>, std::tuple>( tables_path / "In_d-cd_cd.parquet", tables_path / "Out_d-cd_cd.parquet", tables_path / ("Err_d-cd_cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_modified_fresnel_plus.cpp b/tests/scipy_special_tests/test_modified_fresnel_plus.cpp index c122205..2fd6a03 100644 --- a/tests/scipy_special_tests/test_modified_fresnel_plus.cpp +++ b/tests/scipy_special_tests/test_modified_fresnel_plus.cpp @@ -8,12 +8,13 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "modi TEST_CASE("modified_fresnel_plus d->DD scipy_special_tests", "[modified_fresnel_plus][d->DD][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases< - double, std::tuple, std::complex, bool>, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases< + double, std::tuple, std::complex, bool>, std::tuple>( tables_path / "In_d-cd_cd.parquet", tables_path / "Out_d-cd_cd.parquet", tables_path / ("Err_d-cd_cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_msm1.cpp b/tests/scipy_special_tests/test_msm1.cpp index 2d47a2f..fd78e82 100644 --- a/tests/scipy_special_tests/test_msm1.cpp +++ b/tests/scipy_special_tests/test_msm1.cpp @@ -8,12 +8,13 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "msm1 TEST_CASE("msm1 ddd->dd scipy_special_tests", "[msm1][ddd->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases< - std::tuple, std::tuple, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::tuple, std::tuple, std::tuple>( tables_path / "In_d_d_d-d_d.parquet", tables_path / "Out_d_d_d-d_d.parquet", tables_path / ("Err_d_d_d-d_d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [m, q, x] = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_msm2.cpp b/tests/scipy_special_tests/test_msm2.cpp index 421be0e..296f30d 100644 --- a/tests/scipy_special_tests/test_msm2.cpp +++ b/tests/scipy_special_tests/test_msm2.cpp @@ -8,12 +8,13 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "msm2 TEST_CASE("msm2 ddd->dd scipy_special_tests", "[msm2][ddd->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases< - std::tuple, std::tuple, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::tuple, std::tuple, std::tuple>( tables_path / "In_d_d_d-d_d.parquet", tables_path / "Out_d_d_d-d_d.parquet", tables_path / ("Err_d_d_d-d_d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [m, q, x] = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_nbdtr.cpp b/tests/scipy_special_tests/test_nbdtr.cpp index c250564..5bac77e 100644 --- a/tests/scipy_special_tests/test_nbdtr.cpp +++ b/tests/scipy_special_tests/test_nbdtr.cpp @@ -6,14 +6,14 @@ namespace fs = std::filesystem; fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "nbdtr"}; - TEST_CASE("nbdtr ppd->d scipy_special_tests", "[nbdtr][ppd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_p_p_d-d.parquet", tables_path / "Out_p_p_d-d.parquet", tables_path / ("Err_p_p_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [k, n, p] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_nbdtrc.cpp b/tests/scipy_special_tests/test_nbdtrc.cpp index ff7756b..2fefcbc 100644 --- a/tests/scipy_special_tests/test_nbdtrc.cpp +++ b/tests/scipy_special_tests/test_nbdtrc.cpp @@ -6,14 +6,14 @@ namespace fs = std::filesystem; fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "nbdtrc"}; - TEST_CASE("nbdtrc ppd->d scipy_special_tests", "[nbdtrc][ppd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_p_p_d-d.parquet", tables_path / "Out_p_p_d-d.parquet", tables_path / ("Err_p_p_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [k, n, p] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_ndtr.cpp b/tests/scipy_special_tests/test_ndtr.cpp index c62b130..e7c69f5 100644 --- a/tests/scipy_special_tests/test_ndtr.cpp +++ b/tests/scipy_special_tests/test_ndtr.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "ndtr TEST_CASE("ndtr f->f scipy_special_tests", "[ndtr][f->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, float>( - tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", - tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, float>( + tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", + tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; @@ -24,11 +26,12 @@ TEST_CASE("ndtr f->f scipy_special_tests", "[ndtr][f->f][scipy_special_tests]") TEST_CASE("ndtr D->D scipy_special_tests", "[ndtr][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired, fallback] = output; @@ -41,10 +44,12 @@ TEST_CASE("ndtr D->D scipy_special_tests", "[ndtr][D->D][scipy_special_tests]") TEST_CASE("ndtr d->d scipy_special_tests", "[ndtr][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_ndtri.cpp b/tests/scipy_special_tests/test_ndtri.cpp index f132edc..2308168 100644 --- a/tests/scipy_special_tests/test_ndtri.cpp +++ b/tests/scipy_special_tests/test_ndtri.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "ndtr TEST_CASE("ndtri f->f scipy_special_tests", "[ndtri][f->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, float>( - tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", - tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, float>( + tables_path / "In_f-f.parquet", tables_path / "Out_f-f.parquet", + tables_path / ("Err_f-f_" + get_platform_str() + ".parquet") + ) + ); auto y = input; auto [desired, fallback] = output; @@ -24,10 +26,12 @@ TEST_CASE("ndtri f->f scipy_special_tests", "[ndtri][f->f][scipy_special_tests]" TEST_CASE("ndtri d->d scipy_special_tests", "[ndtri][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto y = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_oblate_aswfa.cpp b/tests/scipy_special_tests/test_oblate_aswfa.cpp index df8ebda..6b317fe 100644 --- a/tests/scipy_special_tests/test_oblate_aswfa.cpp +++ b/tests/scipy_special_tests/test_oblate_aswfa.cpp @@ -8,12 +8,14 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "obla TEST_CASE("oblate_aswfa ddddd->dd scipy_special_tests", "[oblate_aswfa][ddddd->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases< - std::tuple, - std::tuple, std::tuple>( - tables_path / "In_d_d_d_d_d-d_d.parquet", tables_path / "Out_d_d_d_d_d-d_d.parquet", - tables_path / ("Err_d_d_d_d_d-d_d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::tuple, std::tuple, + std::tuple>( + tables_path / "In_d_d_d_d_d-d_d.parquet", tables_path / "Out_d_d_d_d_d-d_d.parquet", + tables_path / ("Err_d_d_d_d_d-d_d_" + get_platform_str() + ".parquet") + ) + ); auto [m, n, c, cv, x] = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_oblate_radial1.cpp b/tests/scipy_special_tests/test_oblate_radial1.cpp index c376bb4..4cd4ee1 100644 --- a/tests/scipy_special_tests/test_oblate_radial1.cpp +++ b/tests/scipy_special_tests/test_oblate_radial1.cpp @@ -8,12 +8,14 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "obla TEST_CASE("oblate_radial1 ddddd->dd scipy_special_tests", "[oblate_radial1][ddddd->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases< - std::tuple, - std::tuple, std::tuple>( - tables_path / "In_d_d_d_d_d-d_d.parquet", tables_path / "Out_d_d_d_d_d-d_d.parquet", - tables_path / ("Err_d_d_d_d_d-d_d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::tuple, std::tuple, + std::tuple>( + tables_path / "In_d_d_d_d_d-d_d.parquet", tables_path / "Out_d_d_d_d_d-d_d.parquet", + tables_path / ("Err_d_d_d_d_d-d_d_" + get_platform_str() + ".parquet") + ) + ); auto [m, n, c, cv, x] = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_oblate_radial2.cpp b/tests/scipy_special_tests/test_oblate_radial2.cpp index cc54bf4..1eccf67 100644 --- a/tests/scipy_special_tests/test_oblate_radial2.cpp +++ b/tests/scipy_special_tests/test_oblate_radial2.cpp @@ -8,12 +8,14 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "obla TEST_CASE("oblate_radial2 ddddd->dd scipy_special_tests", "[oblate_radial2][ddddd->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases< - std::tuple, - std::tuple, std::tuple>( - tables_path / "In_d_d_d_d_d-d_d.parquet", tables_path / "Out_d_d_d_d_d-d_d.parquet", - tables_path / ("Err_d_d_d_d_d-d_d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::tuple, std::tuple, + std::tuple>( + tables_path / "In_d_d_d_d_d-d_d.parquet", tables_path / "Out_d_d_d_d_d-d_d.parquet", + tables_path / ("Err_d_d_d_d_d-d_d_" + get_platform_str() + ".parquet") + ) + ); auto [m, n, c, cv, x] = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_owens_t.cpp b/tests/scipy_special_tests/test_owens_t.cpp index 1261d2f..9a75ffd 100644 --- a/tests/scipy_special_tests/test_owens_t.cpp +++ b/tests/scipy_special_tests/test_owens_t.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "owen TEST_CASE("owens_t dd->d scipy_special_tests", "[owens_t][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [h, a] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_pdtr.cpp b/tests/scipy_special_tests/test_pdtr.cpp index 283d563..eddacbf 100644 --- a/tests/scipy_special_tests/test_pdtr.cpp +++ b/tests/scipy_special_tests/test_pdtr.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "pdtr TEST_CASE("pdtr dd->d scipy_special_tests", "[pdtr][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [k, m] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_pdtrc.cpp b/tests/scipy_special_tests/test_pdtrc.cpp index f90f770..cd26660 100644 --- a/tests/scipy_special_tests/test_pdtrc.cpp +++ b/tests/scipy_special_tests/test_pdtrc.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "pdtr TEST_CASE("pdtrc dd->d scipy_special_tests", "[pdtrc][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [k, m] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_pdtri.cpp b/tests/scipy_special_tests/test_pdtri.cpp index b1b7f14..b3907d2 100644 --- a/tests/scipy_special_tests/test_pdtri.cpp +++ b/tests/scipy_special_tests/test_pdtri.cpp @@ -6,14 +6,14 @@ namespace fs = std::filesystem; fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "pdtri"}; - TEST_CASE("pdtri pd->d scipy_special_tests", "[pdtri][pd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_p_d-d.parquet", tables_path / "Out_p_d-d.parquet", tables_path / ("Err_p_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [k, y] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_pmv.cpp b/tests/scipy_special_tests/test_pmv.cpp index 3ce4c54..fd42a88 100644 --- a/tests/scipy_special_tests/test_pmv.cpp +++ b/tests/scipy_special_tests/test_pmv.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "pmv" TEST_CASE("pmv ddd->d scipy_special_tests", "[pmv][ddd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_d_d-d.parquet", tables_path / "Out_d_d_d-d.parquet", tables_path / ("Err_d_d_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [m, v, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_poch.cpp b/tests/scipy_special_tests/test_poch.cpp index b1f50ce..7b7837b 100644 --- a/tests/scipy_special_tests/test_poch.cpp +++ b/tests/scipy_special_tests/test_poch.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "poch TEST_CASE("cephes::poch dd->d scipy_special_tests", "[cephes::poch][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [z, m] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_prolate_aswfa.cpp b/tests/scipy_special_tests/test_prolate_aswfa.cpp index 82d66db..525ae0c 100644 --- a/tests/scipy_special_tests/test_prolate_aswfa.cpp +++ b/tests/scipy_special_tests/test_prolate_aswfa.cpp @@ -8,12 +8,14 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "prol TEST_CASE("prolate_aswfa ddddd->dd scipy_special_tests", "[prolate_aswfa][ddddd->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases< - std::tuple, - std::tuple, std::tuple>( - tables_path / "In_d_d_d_d_d-d_d.parquet", tables_path / "Out_d_d_d_d_d-d_d.parquet", - tables_path / ("Err_d_d_d_d_d-d_d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::tuple, std::tuple, + std::tuple>( + tables_path / "In_d_d_d_d_d-d_d.parquet", tables_path / "Out_d_d_d_d_d-d_d.parquet", + tables_path / ("Err_d_d_d_d_d-d_d_" + get_platform_str() + ".parquet") + ) + ); auto [m, n, c, cv, x] = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_prolate_radial1.cpp b/tests/scipy_special_tests/test_prolate_radial1.cpp index 59ffa09..a5b80f8 100644 --- a/tests/scipy_special_tests/test_prolate_radial1.cpp +++ b/tests/scipy_special_tests/test_prolate_radial1.cpp @@ -8,12 +8,14 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "prol TEST_CASE("prolate_radial1 ddddd->dd scipy_special_tests", "[prolate_radial1][ddddd->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases< - std::tuple, - std::tuple, std::tuple>( - tables_path / "In_d_d_d_d_d-d_d.parquet", tables_path / "Out_d_d_d_d_d-d_d.parquet", - tables_path / ("Err_d_d_d_d_d-d_d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::tuple, std::tuple, + std::tuple>( + tables_path / "In_d_d_d_d_d-d_d.parquet", tables_path / "Out_d_d_d_d_d-d_d.parquet", + tables_path / ("Err_d_d_d_d_d-d_d_" + get_platform_str() + ".parquet") + ) + ); auto [m, n, c, cv, x] = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_prolate_radial2.cpp b/tests/scipy_special_tests/test_prolate_radial2.cpp index d546ee0..a03854a 100644 --- a/tests/scipy_special_tests/test_prolate_radial2.cpp +++ b/tests/scipy_special_tests/test_prolate_radial2.cpp @@ -8,12 +8,14 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "prol TEST_CASE("prolate_radial2 ddddd->dd scipy_special_tests", "[prolate_radial2][ddddd->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases< - std::tuple, - std::tuple, std::tuple>( - tables_path / "In_d_d_d_d_d-d_d.parquet", tables_path / "Out_d_d_d_d_d-d_d.parquet", - tables_path / ("Err_d_d_d_d_d-d_d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::tuple, std::tuple, + std::tuple>( + tables_path / "In_d_d_d_d_d-d_d.parquet", tables_path / "Out_d_d_d_d_d-d_d.parquet", + tables_path / ("Err_d_d_d_d_d-d_d_" + get_platform_str() + ".parquet") + ) + ); auto [m, n, c, cv, x] = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_prolate_segv.cpp b/tests/scipy_special_tests/test_prolate_segv.cpp index 96192a3..e6ad5cf 100644 --- a/tests/scipy_special_tests/test_prolate_segv.cpp +++ b/tests/scipy_special_tests/test_prolate_segv.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "prol TEST_CASE("prolate_segv ddd->d scipy_special_tests", "[prolate_segv][ddd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_d_d-d.parquet", tables_path / "Out_d_d_d-d.parquet", tables_path / ("Err_d_d_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [m, n, c] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_radian.cpp b/tests/scipy_special_tests/test_radian.cpp index 38b7522..3a54edd 100644 --- a/tests/scipy_special_tests/test_radian.cpp +++ b/tests/scipy_special_tests/test_radian.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "radi TEST_CASE("radian ddd->d scipy_special_tests", "[radian][ddd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_d_d-d.parquet", tables_path / "Out_d_d_d-d.parquet", tables_path / ("Err_d_d_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [d, m, s] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_rgamma.cpp b/tests/scipy_special_tests/test_rgamma.cpp index 9d40077..93bd327 100644 --- a/tests/scipy_special_tests/test_rgamma.cpp +++ b/tests/scipy_special_tests/test_rgamma.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "rgam TEST_CASE("rgamma D->D scipy_special_tests", "[rgamma][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto z = input; auto [desired, fallback] = output; @@ -25,10 +26,12 @@ TEST_CASE("rgamma D->D scipy_special_tests", "[rgamma][D->D][scipy_special_tests TEST_CASE("rgamma d->d scipy_special_tests", "[rgamma][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_riemann_zeta.cpp b/tests/scipy_special_tests/test_riemann_zeta.cpp index aec2503..a9c2417 100644 --- a/tests/scipy_special_tests/test_riemann_zeta.cpp +++ b/tests/scipy_special_tests/test_riemann_zeta.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "riem TEST_CASE("riemann_zeta D->D scipy_special_tests", "[riemann_zeta][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto z = input; auto [desired, fallback] = output; @@ -25,10 +26,12 @@ TEST_CASE("riemann_zeta D->D scipy_special_tests", "[riemann_zeta][D->D][scipy_s TEST_CASE("riemann_zeta d->d scipy_special_tests", "[riemann_zeta][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_round.cpp b/tests/scipy_special_tests/test_round.cpp index 338c3f0..7375b4d 100644 --- a/tests/scipy_special_tests/test_round.cpp +++ b/tests/scipy_special_tests/test_round.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "roun TEST_CASE("cephes::round d->d scipy_special_tests", "[cephes::round][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_scaled_exp1.cpp b/tests/scipy_special_tests/test_scaled_exp1.cpp index 4b4cdb6..fb64b42 100644 --- a/tests/scipy_special_tests/test_scaled_exp1.cpp +++ b/tests/scipy_special_tests/test_scaled_exp1.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "scal TEST_CASE("scaled_exp1 d->d scipy_special_tests", "[scaled_exp1][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_sem.cpp b/tests/scipy_special_tests/test_sem.cpp index b90fc85..11167a0 100644 --- a/tests/scipy_special_tests/test_sem.cpp +++ b/tests/scipy_special_tests/test_sem.cpp @@ -8,12 +8,13 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "sem" TEST_CASE("sem ddd->dd scipy_special_tests", "[sem][ddd->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases< - std::tuple, std::tuple, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::tuple, std::tuple, std::tuple>( tables_path / "In_d_d_d-d_d.parquet", tables_path / "Out_d_d_d-d_d.parquet", tables_path / ("Err_d_d_d-d_d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [m, q, x] = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_sem_cva.cpp b/tests/scipy_special_tests/test_sem_cva.cpp index 815fd5e..22d5a76 100644 --- a/tests/scipy_special_tests/test_sem_cva.cpp +++ b/tests/scipy_special_tests/test_sem_cva.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "sem_ TEST_CASE("sem_cva dd->d scipy_special_tests", "[sem_cva][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [m, q] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_shichi.cpp b/tests/scipy_special_tests/test_shichi.cpp index e712aa6..0fa6949 100644 --- a/tests/scipy_special_tests/test_shichi.cpp +++ b/tests/scipy_special_tests/test_shichi.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "shic TEST_CASE("shichi d->dd scipy_special_tests", "[shichi][d->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple>( tables_path / "In_d-d_d.parquet", tables_path / "Out_d-d_d.parquet", tables_path / ("Err_d-d_d_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired0, desired1, fallback] = output; @@ -36,13 +37,14 @@ TEST_CASE("shichi d->dd scipy_special_tests", "[shichi][d->dd][scipy_special_tes TEST_CASE("shichi D->DD scipy_special_tests", "[shichi][D->DD][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases< - std::complex, std::tuple, std::complex, bool>, - std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::complex, std::tuple, std::complex, bool>, + std::tuple>( tables_path / "In_cd-cd_cd.parquet", tables_path / "Out_cd-cd_cd.parquet", tables_path / ("Err_cd-cd_cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_sici.cpp b/tests/scipy_special_tests/test_sici.cpp index 6401258..acdf385 100644 --- a/tests/scipy_special_tests/test_sici.cpp +++ b/tests/scipy_special_tests/test_sici.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "sici TEST_CASE("sici d->dd scipy_special_tests", "[sici][d->dd][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple>( tables_path / "In_d-d_d.parquet", tables_path / "Out_d-d_d.parquet", tables_path / ("Err_d-d_d_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired0, desired1, fallback] = output; @@ -36,13 +37,14 @@ TEST_CASE("sici d->dd scipy_special_tests", "[sici][d->dd][scipy_special_tests]" TEST_CASE("sici D->DD scipy_special_tests", "[sici][D->DD][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases< - std::complex, std::tuple, std::complex, bool>, - std::tuple>( + auto [input, output, tol] = GENERATE( + xsf_test_cases< + std::complex, std::tuple, std::complex, bool>, + std::tuple>( tables_path / "In_cd-cd_cd.parquet", tables_path / "Out_cd-cd_cd.parquet", tables_path / ("Err_cd-cd_cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired0, desired1, fallback] = output; diff --git a/tests/scipy_special_tests/test_sindg.cpp b/tests/scipy_special_tests/test_sindg.cpp index 8b45b95..9661b6c 100644 --- a/tests/scipy_special_tests/test_sindg.cpp +++ b/tests/scipy_special_tests/test_sindg.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "sind TEST_CASE("sindg d->d scipy_special_tests", "[sindg][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_sinpi.cpp b/tests/scipy_special_tests/test_sinpi.cpp index 7e3b931..20e8af8 100644 --- a/tests/scipy_special_tests/test_sinpi.cpp +++ b/tests/scipy_special_tests/test_sinpi.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "sinp TEST_CASE("sinpi D->D scipy_special_tests", "[sinpi][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired, fallback] = output; @@ -25,10 +26,12 @@ TEST_CASE("sinpi D->D scipy_special_tests", "[sinpi][D->D][scipy_special_tests]" TEST_CASE("sinpi d->d scipy_special_tests", "[sinpi][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_smirnov.cpp b/tests/scipy_special_tests/test_smirnov.cpp index 83e7cac..6bb77dc 100644 --- a/tests/scipy_special_tests/test_smirnov.cpp +++ b/tests/scipy_special_tests/test_smirnov.cpp @@ -6,14 +6,14 @@ namespace fs = std::filesystem; fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "smirnov"}; - TEST_CASE("smirnov pd->d scipy_special_tests", "[smirnov][pd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_p_d-d.parquet", tables_path / "Out_p_d-d.parquet", tables_path / ("Err_p_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [n, d] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_smirnovc.cpp b/tests/scipy_special_tests/test_smirnovc.cpp index 50d922d..95a3593 100644 --- a/tests/scipy_special_tests/test_smirnovc.cpp +++ b/tests/scipy_special_tests/test_smirnovc.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "smir TEST_CASE("smirnovc pd->d scipy_special_tests", "[smirnovc][pd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_p_d-d.parquet", tables_path / "Out_p_d-d.parquet", tables_path / ("Err_p_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [n, d] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_smirnovci.cpp b/tests/scipy_special_tests/test_smirnovci.cpp index 890d890..47dc38d 100644 --- a/tests/scipy_special_tests/test_smirnovci.cpp +++ b/tests/scipy_special_tests/test_smirnovci.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "smir TEST_CASE("smirnovci pd->d scipy_special_tests", "[smirnovci][pd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_p_d-d.parquet", tables_path / "Out_p_d-d.parquet", tables_path / ("Err_p_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [n, p] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_smirnovi.cpp b/tests/scipy_special_tests/test_smirnovi.cpp index a707dbf..e9d9470 100644 --- a/tests/scipy_special_tests/test_smirnovi.cpp +++ b/tests/scipy_special_tests/test_smirnovi.cpp @@ -6,14 +6,14 @@ namespace fs = std::filesystem; fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "smirnovi"}; - TEST_CASE("smirnovi pd->d scipy_special_tests", "[smirnovi][pd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_p_d-d.parquet", tables_path / "Out_p_d-d.parquet", tables_path / ("Err_p_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [n, p] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_smirnovp.cpp b/tests/scipy_special_tests/test_smirnovp.cpp index fbec93e..9b25d67 100644 --- a/tests/scipy_special_tests/test_smirnovp.cpp +++ b/tests/scipy_special_tests/test_smirnovp.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "smir TEST_CASE("smirnovp pd->d scipy_special_tests", "[smirnovp][pd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_p_d-d.parquet", tables_path / "Out_p_d-d.parquet", tables_path / ("Err_p_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [n, d] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_spence.cpp b/tests/scipy_special_tests/test_spence.cpp index 13a982d..3694eca 100644 --- a/tests/scipy_special_tests/test_spence.cpp +++ b/tests/scipy_special_tests/test_spence.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "spen TEST_CASE("cephes::spence d->d scipy_special_tests", "[cephes::spence][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_struve_h.cpp b/tests/scipy_special_tests/test_struve_h.cpp index f56aa21..39aac9b 100644 --- a/tests/scipy_special_tests/test_struve_h.cpp +++ b/tests/scipy_special_tests/test_struve_h.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "stru TEST_CASE("struve_h dd->d scipy_special_tests", "[struve_h][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [v, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_struve_l.cpp b/tests/scipy_special_tests/test_struve_l.cpp index 62c523a..afd9d6c 100644 --- a/tests/scipy_special_tests/test_struve_l.cpp +++ b/tests/scipy_special_tests/test_struve_l.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "stru TEST_CASE("struve_l dd->d scipy_special_tests", "[struve_l][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [v, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_tandg.cpp b/tests/scipy_special_tests/test_tandg.cpp index 2992521..bee1ec4 100644 --- a/tests/scipy_special_tests/test_tandg.cpp +++ b/tests/scipy_special_tests/test_tandg.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "tand TEST_CASE("tandg d->d scipy_special_tests", "[tandg][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_voigt_profile.cpp b/tests/scipy_special_tests/test_voigt_profile.cpp index 4edf3bf..1d2070d 100644 --- a/tests/scipy_special_tests/test_voigt_profile.cpp +++ b/tests/scipy_special_tests/test_voigt_profile.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "voig TEST_CASE("voigt_profile ddd->d scipy_special_tests", "[voigt_profile][ddd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_d_d-d.parquet", tables_path / "Out_d_d_d-d.parquet", tables_path / ("Err_d_d_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [x, sigma, gamma] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_wofz.cpp b/tests/scipy_special_tests/test_wofz.cpp index 3d641d4..4045180 100644 --- a/tests/scipy_special_tests/test_wofz.cpp +++ b/tests/scipy_special_tests/test_wofz.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "wofz TEST_CASE("wofz D->D scipy_special_tests", "[wofz][D->D][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, bool>, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, bool>, double>( tables_path / "In_cd-cd.parquet", tables_path / "Out_cd-cd.parquet", tables_path / ("Err_cd-cd_" + get_platform_str() + ".parquet") - )); + ) + ); auto x = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_wright_bessel.cpp b/tests/scipy_special_tests/test_wright_bessel.cpp index cf68afd..f8a6c83 100644 --- a/tests/scipy_special_tests/test_wright_bessel.cpp +++ b/tests/scipy_special_tests/test_wright_bessel.cpp @@ -8,11 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "wrig TEST_CASE("wright_bessel ddd->d scipy_special_tests", "[wright_bessel][ddd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = - GENERATE(xsf_test_cases, std::tuple, double>( + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( tables_path / "In_d_d_d-d.parquet", tables_path / "Out_d_d_d-d.parquet", tables_path / ("Err_d_d_d-d_" + get_platform_str() + ".parquet") - )); + ) + ); auto [a, b, x] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_xlog1py.cpp b/tests/scipy_special_tests/test_xlog1py.cpp index 30f49e9..66d42ae 100644 --- a/tests/scipy_special_tests/test_xlog1py.cpp +++ b/tests/scipy_special_tests/test_xlog1py.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "xlog TEST_CASE("xlog1py dd->d scipy_special_tests", "[xlog1py][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [x, y] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_xlogy.cpp b/tests/scipy_special_tests/test_xlogy.cpp index e798c3f..3ee8b04 100644 --- a/tests/scipy_special_tests/test_xlogy.cpp +++ b/tests/scipy_special_tests/test_xlogy.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "xlog TEST_CASE("xlogy dd->d scipy_special_tests", "[xlogy][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [x, y] = input; auto [desired, fallback] = output; @@ -43,10 +45,12 @@ TEST_CASE("xlogy DD->D scipy_special_tests", "[xlogy][DD->D][scipy_special_tests TEST_CASE("xlogy ff->f scipy_special_tests", "[xlogy][ff->f][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, float>( - tables_path / "In_f_f-f.parquet", tables_path / "Out_f_f-f.parquet", - tables_path / ("Err_f_f-f_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, float>( + tables_path / "In_f_f-f.parquet", tables_path / "Out_f_f-f.parquet", + tables_path / ("Err_f_f-f_" + get_platform_str() + ".parquet") + ) + ); auto [x, y] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_zeta.cpp b/tests/scipy_special_tests/test_zeta.cpp index 2063f45..3868eec 100644 --- a/tests/scipy_special_tests/test_zeta.cpp +++ b/tests/scipy_special_tests/test_zeta.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "zeta TEST_CASE("zeta dd->d scipy_special_tests", "[zeta][dd->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, std::tuple, double>( - tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", - tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, std::tuple, double>( + tables_path / "In_d_d-d.parquet", tables_path / "Out_d_d-d.parquet", + tables_path / ("Err_d_d-d_" + get_platform_str() + ".parquet") + ) + ); auto [z, q] = input; auto [desired, fallback] = output; diff --git a/tests/scipy_special_tests/test_zetac.cpp b/tests/scipy_special_tests/test_zetac.cpp index 1379f57..3fb412a 100644 --- a/tests/scipy_special_tests/test_zetac.cpp +++ b/tests/scipy_special_tests/test_zetac.cpp @@ -8,10 +8,12 @@ fs::path tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "zeta TEST_CASE("zetac d->d scipy_special_tests", "[zetac][d->d][scipy_special_tests]") { SET_FP_FORMAT() - auto [input, output, tol] = GENERATE(xsf_test_cases, double>( - tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", - tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") - )); + auto [input, output, tol] = GENERATE( + xsf_test_cases, double>( + tables_path / "In_d-d.parquet", tables_path / "Out_d-d.parquet", + tables_path / ("Err_d-d_" + get_platform_str() + ".parquet") + ) + ); auto z = input; auto [desired, fallback] = output; diff --git a/tests/test_hyp2f1.cpp b/tests/test_hyp2f1.cpp index c3d7e21..5f3f090 100644 --- a/tests/test_hyp2f1.cpp +++ b/tests/test_hyp2f1.cpp @@ -16,7 +16,6 @@ namespace fs = std::filesystem; fs::path hyp2f1_tables_path{fs::path(XSREF_TABLES_PATH) / "scipy_special_tests" / "hyp2f1"}; - TEST_CASE("hyp2f1 complex scipy.special cases", "[hyp2f1][complex][scipy-special]") { auto [input, output, tol] = GENERATE( xsf_test_cases< @@ -30,22 +29,22 @@ TEST_CASE("hyp2f1 complex scipy.special cases", "[hyp2f1][complex][scipy-special auto out = xsf::hyp2f1(a, b, c, z); auto error = xsf::extended_relative_error(out, desired); tol = adjust_tolerance(tol); - INFO("a := " << std::setprecision(std::numeric_limits::max_digits10) << a << '\n' - << "b := " << b << '\n' - << "c := " << c << '\n' - << "z := " << z << '\n' - << "out := " << out << '\n' - << "desired := " << desired << '\n' - << "error := " << error << '\n' - << "tolerance := " << tol << '\n' - ); + INFO( + "a := " << std::setprecision(std::numeric_limits::max_digits10) << a << '\n' + << "b := " << b << '\n' + << "c := " << c << '\n' + << "z := " << z << '\n' + << "out := " << out << '\n' + << "desired := " << desired << '\n' + << "error := " << error << '\n' + << "tolerance := " << tol << '\n' + ); REQUIRE(error <= tol); } TEST_CASE("hyp2f1 real scipy.special cases", "[hyp2f1][real][scipy-special]") { auto [input, output, tol] = GENERATE( - xsf_test_cases< - std::tuple, std::tuple, double>( + xsf_test_cases, std::tuple, double>( hyp2f1_tables_path / "In_d_d_d_d-d.parquet", hyp2f1_tables_path / "Out_d_d_d_d-d.parquet", hyp2f1_tables_path / ("Err_d_d_d_d-d_" + get_platform_str() + ".parquet") ) @@ -55,14 +54,15 @@ TEST_CASE("hyp2f1 real scipy.special cases", "[hyp2f1][real][scipy-special]") { auto out = xsf::hyp2f1(a, b, c, z); auto error = xsf::extended_relative_error(out, desired); tol = adjust_tolerance(tol); - INFO("a := " << std::setprecision(std::numeric_limits::max_digits10) << a << '\n' - << "b := " << b << '\n' - << "c := " << c << '\n' - << "z := " << z << '\n' - << "out := " << out << '\n' - << "desired := " << desired << '\n' - << "error := " << error << '\n' - << "tolerance := " << tol << '\n' - ); + INFO( + "a := " << std::setprecision(std::numeric_limits::max_digits10) << a << '\n' + << "b := " << b << '\n' + << "c := " << c << '\n' + << "z := " << z << '\n' + << "out := " << out << '\n' + << "desired := " << desired << '\n' + << "error := " << error << '\n' + << "tolerance := " << tol << '\n' + ); REQUIRE(error <= tol); } From b442eedf9e9d85b00d396c5138c5a60668f30b64 Mon Sep 17 00:00:00 2001 From: steppi <1953382+steppi@users.noreply.github.com> Date: Fri, 25 Apr 2025 19:53:27 -0400 Subject: [PATCH 4/4] MAINT: Add clang-format commit to .git-blame-ignore-revs --- .git-blame-ignore-revs | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 .git-blame-ignore-revs diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs new file mode 100644 index 0000000..d54bfb0 --- /dev/null +++ b/.git-blame-ignore-revs @@ -0,0 +1,2 @@ +# clang-format repo gh-5 +e6323cae55daee686221c54160994ee1c7825ba5