├── .github └── workflows │ └── CI.yml ├── .gitignore ├── LICENSE.md ├── README.md ├── codecov.yml ├── ford.md ├── fpm.toml ├── media ├── logo.png └── logo.svg ├── polyroots-fortran.code-workspace ├── src └── polyroots_module.F90 └── test ├── dcbcrt_test.f90 ├── example.f90 ├── numpy-test.py ├── polyroots_test.f90 └── polyroots_test_10.f90 /.github/workflows/CI.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | on: [push] 3 | jobs: 4 | 5 | Build: 6 | runs-on: ${{ matrix.os }} 7 | permissions: 8 | contents: write 9 | strategy: 10 | fail-fast: false 11 | matrix: 12 | os: [ubuntu-latest] 13 | gcc_v: [10] # Version of GFortran we want to use. 14 | python-version: [3.9] 15 | env: 16 | FC: gfortran-${{ matrix.gcc_v }} 17 | GCC_V: ${{ matrix.gcc_v }} 18 | 19 | steps: 20 | - name: Checkout code 21 | uses: actions/checkout@v3 22 | with: 23 | submodules: recursive 24 | 25 | - name: Install Python 26 | uses: actions/setup-python@v4 # Use pip to install latest CMake, & FORD/Jin2For, etc. 27 | with: 28 | python-version: ${{ matrix.python-version }} 29 | 30 | - name: Setup Graphviz 31 | uses: ts-graphviz/setup-graphviz@v1 32 | 33 | - name: Setup Fortran Package Manager 34 | uses: fortran-lang/setup-fpm@v5 35 | with: 36 | github-token: ${{ secrets.GITHUB_TOKEN }} 37 | 38 | - name: Install Python dependencies 39 | if: contains( matrix.os, 'ubuntu') 40 | run: | 41 | python -m pip install --upgrade pip 42 | pip install ford numpy matplotlib 43 | if [ -f requirements.txt ]; then pip install -r requirements.txt; fi 44 | 45 | - name: Install GFortran Linux 46 | if: contains( matrix.os, 'ubuntu') 47 | run: | 48 | sudo apt-get install lcov 49 | sudo add-apt-repository ppa:ubuntu-toolchain-r/test 50 | sudo apt-get update 51 | sudo apt-get install -y gcc-${{ matrix.gcc_v }} gfortran-${{ matrix.gcc_v }} 52 | sudo update-alternatives \ 53 | --install /usr/bin/gcc gcc /usr/bin/gcc-${{ matrix.gcc_v }} 100 \ 54 | --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${{ matrix.gcc_v }} \ 55 | --slave /usr/bin/gcov gcov /usr/bin/gcov-${{ matrix.gcc_v }} 56 | 57 | # - name: Compile 58 | # run: fpm build --profile release 59 | 60 | - name: Run tests 61 | run: fpm test --profile debug --flag -coverage 62 | 63 | - name: Create coverage report 64 | run: | 65 | mkdir -p ${{ env.COV_DIR }} 66 | mv ./build/gfortran_*/*/* ${{ env.COV_DIR }} 67 | lcov --capture --initial --base-directory . --directory ${{ env.COV_DIR }} --output-file ${{ env.COV_DIR }}/coverage.base 68 | lcov --capture --base-directory . --directory ${{ env.COV_DIR }} --output-file ${{ env.COV_DIR }}/coverage.capture 69 | lcov --add-tracefile ${{ env.COV_DIR }}/coverage.base --add-tracefile ${{ env.COV_DIR }}/coverage.capture --output-file ${{ env.COV_DIR }}/coverage.info 70 | env: 71 | COV_DIR: build/coverage 72 | 73 | - name: Upload coverage report 74 | uses: codecov/codecov-action@v3 75 | with: 76 | files: build/coverage/coverage.info 77 | 78 | - name: Build documentation 79 | run: ford ./ford.md 80 | 81 | - name: Deploy Documentation 82 | if: github.ref == 'refs/heads/master' 83 | uses: JamesIves/github-pages-deploy-action@v4.4.1 84 | with: 85 | branch: gh-pages # The branch the action should deploy to. 86 | folder: doc # The folder the action should deploy. 87 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Prerequisites 2 | *.d 3 | 4 | # Compiled Object files 5 | *.slo 6 | *.lo 7 | *.o 8 | *.obj 9 | 10 | # Precompiled Headers 11 | *.gch 12 | *.pch 13 | 14 | # Compiled Dynamic libraries 15 | *.so 16 | *.dylib 17 | *.dll 18 | 19 | # Fortran module files 20 | *.mod 21 | *.smod 22 | 23 | # Compiled Static libraries 24 | *.lai 25 | *.la 26 | *.a 27 | *.lib 28 | 29 | # Executables 30 | *.exe 31 | *.out 32 | *.app 33 | 34 | # misc 35 | .DS_Store 36 | /build 37 | /doc 38 | /tmp -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Polyroots-Fortran: Root solvers for modern Fortran 2 | 3 | 4 | Copyright (c) 2022-2024, Jacob Williams 5 | All rights reserved. 6 | 7 | Redistribution and use in source and binary forms, with or without modification, 8 | are permitted provided that the following conditions are met: 9 | 10 | * Redistributions of source code must retain the above copyright notice, this 11 | list of conditions and the following disclaimer. 12 | 13 | * Redistributions in binary form must reproduce the above copyright notice, this 14 | list of conditions and the following disclaimer in the documentation and/or 15 | other materials provided with the distribution. 16 | 17 | * The names of its contributors may not be used to endorse or promote products 18 | derived from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 21 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 22 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 24 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 25 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 26 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 27 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 28 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | 31 | ---------------------------------------------------------------------------------- 32 | 33 | "General Complex Polynomial Root Solver and Its Further Optimization for Binary Microlenses" 34 | Copyright 2012 Jan Skowron & Andrew Gould 35 | 36 | Apache License 37 | Version 2.0, January 2004 38 | http://www.apache.org/licenses/ 39 | 40 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 41 | 42 | 1. Definitions. 43 | 44 | "License" shall mean the terms and conditions for use, reproduction, 45 | and distribution as defined by Sections 1 through 9 of this document. 46 | 47 | "Licensor" shall mean the copyright owner or entity authorized by 48 | the copyright owner that is granting the License. 49 | 50 | "Legal Entity" shall mean the union of the acting entity and all 51 | other entities that control, are controlled by, or are under common 52 | control with that entity. For the purposes of this definition, 53 | "control" means (i) the power, direct or indirect, to cause the 54 | direction or management of such entity, whether by contract or 55 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 56 | outstanding shares, or (iii) beneficial ownership of such entity. 57 | 58 | "You" (or "Your") shall mean an individual or Legal Entity 59 | exercising permissions granted by this License. 60 | 61 | "Source" form shall mean the preferred form for making modifications, 62 | including but not limited to software source code, documentation 63 | source, and configuration files. 64 | 65 | "Object" form shall mean any form resulting from mechanical 66 | transformation or translation of a Source form, including but 67 | not limited to compiled object code, generated documentation, 68 | and conversions to other media types. 69 | 70 | "Work" shall mean the work of authorship, whether in Source or 71 | Object form, made available under the License, as indicated by a 72 | copyright notice that is included in or attached to the work 73 | (an example is provided in the Appendix below). 74 | 75 | "Derivative Works" shall mean any work, whether in Source or Object 76 | form, that is based on (or derived from) the Work and for which the 77 | editorial revisions, annotations, elaborations, or other modifications 78 | represent, as a whole, an original work of authorship. For the purposes 79 | of this License, Derivative Works shall not include works that remain 80 | separable from, or merely link (or bind by name) to the interfaces of, 81 | the Work and Derivative Works thereof. 82 | 83 | "Contribution" shall mean any work of authorship, including 84 | the original version of the Work and any modifications or additions 85 | to that Work or Derivative Works thereof, that is intentionally 86 | submitted to Licensor for inclusion in the Work by the copyright owner 87 | or by an individual or Legal Entity authorized to submit on behalf of 88 | the copyright owner. For the purposes of this definition, "submitted" 89 | means any form of electronic, verbal, or written communication sent 90 | to the Licensor or its representatives, including but not limited to 91 | communication on electronic mailing lists, source code control systems, 92 | and issue tracking systems that are managed by, or on behalf of, the 93 | Licensor for the purpose of discussing and improving the Work, but 94 | excluding communication that is conspicuously marked or otherwise 95 | designated in writing by the copyright owner as "Not a Contribution." 96 | 97 | "Contributor" shall mean Licensor and any individual or Legal Entity 98 | on behalf of whom a Contribution has been received by Licensor and 99 | subsequently incorporated within the Work. 100 | 101 | 2. Grant of Copyright License. Subject to the terms and conditions of 102 | this License, each Contributor hereby grants to You a perpetual, 103 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 104 | copyright license to reproduce, prepare Derivative Works of, 105 | publicly display, publicly perform, sublicense, and distribute the 106 | Work and such Derivative Works in Source or Object form. 107 | 108 | 3. Grant of Patent License. Subject to the terms and conditions of 109 | this License, each Contributor hereby grants to You a perpetual, 110 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 111 | (except as stated in this section) patent license to make, have made, 112 | use, offer to sell, sell, import, and otherwise transfer the Work, 113 | where such license applies only to those patent claims licensable 114 | by such Contributor that are necessarily infringed by their 115 | Contribution(s) alone or by combination of their Contribution(s) 116 | with the Work to which such Contribution(s) was submitted. If You 117 | institute patent litigation against any entity (including a 118 | cross-claim or counterclaim in a lawsuit) alleging that the Work 119 | or a Contribution incorporated within the Work constitutes direct 120 | or contributory patent infringement, then any patent licenses 121 | granted to You under this License for that Work shall terminate 122 | as of the date such litigation is filed. 123 | 124 | 4. Redistribution. You may reproduce and distribute copies of the 125 | Work or Derivative Works thereof in any medium, with or without 126 | modifications, and in Source or Object form, provided that You 127 | meet the following conditions: 128 | 129 | (a) You must give any other recipients of the Work or 130 | Derivative Works a copy of this License; and 131 | 132 | (b) You must cause any modified files to carry prominent notices 133 | stating that You changed the files; and 134 | 135 | (c) You must retain, in the Source form of any Derivative Works 136 | that You distribute, all copyright, patent, trademark, and 137 | attribution notices from the Source form of the Work, 138 | excluding those notices that do not pertain to any part of 139 | the Derivative Works; and 140 | 141 | (d) If the Work includes a "NOTICE" text file as part of its 142 | distribution, then any Derivative Works that You distribute must 143 | include a readable copy of the attribution notices contained 144 | within such NOTICE file, excluding those notices that do not 145 | pertain to any part of the Derivative Works, in at least one 146 | of the following places: within a NOTICE text file distributed 147 | as part of the Derivative Works; within the Source form or 148 | documentation, if provided along with the Derivative Works; or, 149 | within a display generated by the Derivative Works, if and 150 | wherever such third-party notices normally appear. The contents 151 | of the NOTICE file are for informational purposes only and 152 | do not modify the License. You may add Your own attribution 153 | notices within Derivative Works that You distribute, alongside 154 | or as an addendum to the NOTICE text from the Work, provided 155 | that such additional attribution notices cannot be construed 156 | as modifying the License. 157 | 158 | You may add Your own copyright statement to Your modifications and 159 | may provide additional or different license terms and conditions 160 | for use, reproduction, or distribution of Your modifications, or 161 | for any such Derivative Works as a whole, provided Your use, 162 | reproduction, and distribution of the Work otherwise complies with 163 | the conditions stated in this License. 164 | 165 | 5. Submission of Contributions. Unless You explicitly state otherwise, 166 | any Contribution intentionally submitted for inclusion in the Work 167 | by You to the Licensor shall be under the terms and conditions of 168 | this License, without any additional terms or conditions. 169 | Notwithstanding the above, nothing herein shall supersede or modify 170 | the terms of any separate license agreement you may have executed 171 | with Licensor regarding such Contributions. 172 | 173 | 6. Trademarks. This License does not grant permission to use the trade 174 | names, trademarks, service marks, or product names of the Licensor, 175 | except as required for reasonable and customary use in describing the 176 | origin of the Work and reproducing the content of the NOTICE file. 177 | 178 | 7. Disclaimer of Warranty. Unless required by applicable law or 179 | agreed to in writing, Licensor provides the Work (and each 180 | Contributor provides its Contributions) on an "AS IS" BASIS, 181 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 182 | implied, including, without limitation, any warranties or conditions 183 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 184 | PARTICULAR PURPOSE. You are solely responsible for determining the 185 | appropriateness of using or redistributing the Work and assume any 186 | risks associated with Your exercise of permissions under this License. 187 | 188 | 8. Limitation of Liability. In no event and under no legal theory, 189 | whether in tort (including negligence), contract, or otherwise, 190 | unless required by applicable law (such as deliberate and grossly 191 | negligent acts) or agreed to in writing, shall any Contributor be 192 | liable to You for damages, including any direct, indirect, special, 193 | incidental, or consequential damages of any character arising as a 194 | result of this License or out of the use or inability to use the 195 | Work (including but not limited to damages for loss of goodwill, 196 | work stoppage, computer failure or malfunction, or any and all 197 | other commercial damages or losses), even if such Contributor 198 | has been advised of the possibility of such damages. 199 | 200 | 9. Accepting Warranty or Additional Liability. While redistributing 201 | the Work or Derivative Works thereof, You may choose to offer, 202 | and charge a fee for, acceptance of support, warranty, indemnity, 203 | or other liability obligations and/or rights consistent with this 204 | License. However, in accepting such obligations, You may act only 205 | on Your own behalf and on Your sole responsibility, not on behalf 206 | of any other Contributor, and only if You agree to indemnify, 207 | defend, and hold each Contributor harmless for any liability 208 | incurred by, or claims asserted against, such Contributor by reason 209 | of your accepting any such warranty or additional liability. 210 | 211 | END OF TERMS AND CONDITIONS 212 | 213 | ---------------------------------------------------------------------------------- 214 | 215 | License for https://netlib.org/numeralgo/na10 216 | 217 | ``` 218 | *************************************************************************** 219 | * All the software contained in this library is protected by copyright. * 220 | * Permission to use, copy, modify, and distribute this software for any * 221 | * purpose without fee is hereby granted, provided that this entire notice * 222 | * is included in all copies of any software which is or includes a copy * 223 | * or modification of this software and in all copies of the supporting * 224 | * documentation for such software. * 225 | *************************************************************************** 226 | * THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED * 227 | * WARRANTY. IN NO EVENT, NEITHER THE AUTHORS, NOR THE PUBLISHER, NOR ANY * 228 | * MEMBER OF THE EDITORIAL BOARD OF THE JOURNAL "NUMERICAL ALGORITHMS", * 229 | * NOR ITS EDITOR-IN-CHIEF, BE LIABLE FOR ANY ERROR IN THE SOFTWARE, ANY * 230 | * MISUSE OF IT OR ANY DAMAGE ARISING OUT OF ITS USE. THE ENTIRE RISK OF * 231 | * USING THE SOFTWARE LIES WITH THE PARTY DOING SO. * 232 | *************************************************************************** 233 | * ANY USE OF THE SOFTWARE CONSTITUTES ACCEPTANCE OF THE TERMS OF THE * 234 | * ABOVE STATEMENT. * 235 | *************************************************************************** 236 | AUTHOR: 237 | DARIO ANDREA BINI 238 | UNIVERSITY OF PISA, ITALY 239 | E-MAIL: bini@dm.unipi.it 240 | REFERENCE: 241 | - NUMERICAL COMPUTATION OF POLYNOMIAL ZEROS BY MEANS OF 242 | ABERTH'S METHOD 243 | NUMERICAL ALGORITHMS, 13 (1996), PP. 179-200 244 | SOFTWARE REVISION DATE: 245 | JUNE, 1996 246 | *************************************************************************** 247 | ``` 248 | 249 | ---------------------------------------------------------------------------------- 250 | 251 | This library also contains code derived from EISPACK, presumed to be in the public domain 252 | https://netlib.org/eispack/ 253 | 254 | EISPACK is a collection of double-precision Fortran subroutines that 255 | compute the eigenvalues and eigenvectors of nine classes of matrices: 256 | complex general, complex Hermitian, real general, real symmetric, real 257 | symmetric banded, real symmetric tridiagonal, special real 258 | tridiagonal, generalized real, and generalized real symmetric matices. 259 | In addition, two routines are included that use singular value 260 | decomposition to solve certain least-squares problems. The 261 | single-precsion versions are in SEISPACK. 262 | 263 | ---------------------------------------------------------------------------------- 264 | 265 | This library also contains code derived from SLATEC, presumed to be in the public domain 266 | https://netlib.org/slatec/ 267 | 268 | SLATEC Common Mathematical Library, Version 4.1, July 1993 269 | a comprehensive software library containing over 270 | 1400 general purpose mathematical and statistical routines 271 | written in Fortran 77. 272 | 273 | ---------------------------------------------------------------------------------- 274 | 275 | FPML: Fourth order Parallelizable Modification of Laguerre's method 276 | Author: Thomas R. Cameron, Davidson College 277 | Last Modified: 1 November 2018 278 | https://github.com/trcameron/FPML 279 | 280 | MIT License 281 | 282 | Copyright (c) 2018 Thomas R. Cameron 283 | 284 | Permission is hereby granted, free of charge, to any person obtaining a copy 285 | of this software and associated documentation files (the "Software"), to deal 286 | in the Software without restriction, including without limitation the rights 287 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 288 | copies of the Software, and to permit persons to whom the Software is 289 | furnished to do so, subject to the following conditions: 290 | 291 | * The above copyright notice and this permission notice shall be included in all 292 | copies or substantial portions of the Software. 293 | 294 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 295 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 296 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 297 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 298 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 299 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 300 | SOFTWARE. 301 | 302 | ---------------------------------------------------------------------------------- 303 | 304 | JPL MATH77 Library 305 | https://netlib.org/math/license.html 306 | 307 | The License 308 | 309 | Copyright © 1996 California Institute of Technology, Pasadena, California. ALL RIGHTS RESERVED. Based on Government Sponsored Research NAS7-03001. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 310 | * Redistributions of source code must retain this copyright notice, this list of conditions and the following disclaimer. 311 | * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 312 | * Neither the name of the California Institute of Technology (Caltech) nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. 313 | 314 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 315 | 316 | For those codes indicated with a Math a la Carte copyright, the same rules apply, except without the full force of the Caltech legal team. 317 | When citing this software we request that you also mention the names of the people who wrote the software you are using. 318 | 319 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ![polyroots-fortran](media/logo.png) 2 | ============ 3 | 4 | **polyroots-fortran**: Polynomial Roots with Modern Fortran 5 | 6 | [![Language](https://img.shields.io/badge/-Fortran-734f96?logo=fortran&logoColor=white)](https://github.com/topics/fortran) 7 | [![GitHub release](https://img.shields.io/github/release/jacobwilliams/polyroots-fortran.svg)](https://github.com/jacobwilliams/polyroots-fortran/releases/latest) 8 | [![CI Status](https://github.com/jacobwilliams/polyroots-fortran/actions/workflows/CI.yml/badge.svg)](https://github.com/jacobwilliams/polyroots-fortran/actions) 9 | [![codecov](https://codecov.io/gh/jacobwilliams/polyroots-fortran/branch/master/graph/badge.svg)](https://codecov.io/gh/jacobwilliams/polyroots-fortran) 10 | [![last-commit](https://img.shields.io/github/last-commit/jacobwilliams/polyroots-fortran)](https://github.com/jacobwilliams/polyroots-fortran/commits/master) 11 | 12 | ## Description 13 | 14 | A modern Fortran library for finding the roots of polynomials. 15 | 16 | ## Methods 17 | 18 | Many of the methods are from legacy libraries. They have been extensively modified and refactored into Modern Fortran. 19 | 20 | Method name | Polynomial type | Coefficients | Roots | Reference 21 | --- | --- | --- | --- | --- 22 | [`cpoly`](https://jacobwilliams.github.io/polyroots-fortran/proc/cpoly.html) | General | complex | complex | [Jenkins & Traub (1972)](https://dl.acm.org/doi/abs/10.1145/361254.361262) 23 | [`rpoly`](https://jacobwilliams.github.io/polyroots-fortran/proc/rpoly.html) | General | real | complex | [Jenkins & Traub (1975)](https://dl.acm.org/doi/10.1145/355637.355643) 24 | [`rpzero`](https://jacobwilliams.github.io/polyroots-fortran/proc/rpzero.html) | General | real | complex | [SLATEC](https://netlib.org/slatec/src/rpzero.f) 25 | [`cpzero`](https://jacobwilliams.github.io/polyroots-fortran/proc/cpzero.html) | General | complex | complex | [SLATEC](https://netlib.org/slatec/src/cpzero.f) 26 | [`rpqr79`](https://jacobwilliams.github.io/polyroots-fortran/proc/rpqr79.html) | General | real | complex | [SLATEC](https://netlib.org/slatec/src/rpqr79.f) 27 | [`cpqr79`](https://jacobwilliams.github.io/polyroots-fortran/proc/cpqr79.html) | General | complex | complex | [SLATEC](https://netlib.org/slatec/src/cpqr79.f) 28 | [`dqtcrt`](https://jacobwilliams.github.io/polyroots-fortran/proc/dqtcrt.html) | Quartic | real | complex | [NSWC Library](https://github.com/jacobwilliams/nswc) 29 | [`dcbcrt`](https://jacobwilliams.github.io/polyroots-fortran/proc/dcbcrt.html) | Cubic | real | complex | [NSWC Library](https://github.com/jacobwilliams/nswc) 30 | [`dqdcrt`](https://jacobwilliams.github.io/polyroots-fortran/proc/dqdcrt.html) | Quadratic | real | complex | [NSWC Library](https://github.com/jacobwilliams/nswc) 31 | [`quadpl`](https://jacobwilliams.github.io/polyroots-fortran/proc/quadpl.html) | Quadratic | real | complex | [NSWC Library](https://github.com/jacobwilliams/nswc) 32 | [`dpolz`](https://jacobwilliams.github.io/polyroots-fortran/proc/dpolz.html) | General | real | complex | [MATH77 Library](https://netlib.org/math/) 33 | [`cpolz`](https://jacobwilliams.github.io/polyroots-fortran/proc/cpolz.html) | General | complex | complex | [MATH77 Library](https://netlib.org/math/) 34 | [`polyroots`](https://jacobwilliams.github.io/polyroots-fortran/proc/polyroots.html) | General | real | complex | [LAPACK](https://netlib.org/lapack/explore-html/index.html) 35 | [`cpolyroots`](https://jacobwilliams.github.io/polyroots-fortran/proc/cpolyroots.html) | General | complex | complex | [LAPACK](https://netlib.org/lapack/explore-html/index.html) 36 | [`rroots_chebyshev_cubic`](https://jacobwilliams.github.io/polyroots-fortran/proc/rroots_chebyshev_cubic.html) | Cubic | real | complex | [Lebedev (1991)](https://doi.org/10.1515/rnam.1991.6.4.315) 37 | [`qr_algeq_solver`](https://jacobwilliams.github.io/polyroots-fortran/proc/qr_algeq_solver.html) | General | real | complex | [Edelman & Murakami (1995)](https://www.ams.org/journals/mcom/1995-64-210/S0025-5718-1995-1262279-2/S0025-5718-1995-1262279-2.pdf) 38 | [`polzeros`](https://jacobwilliams.github.io/polyroots-fortran/proc/polzeros.html) | General | complex | complex | [Bini (1996)](https://link.springer.com/article/10.1007/BF02207694) 39 | [`cmplx_roots_gen`](https://jacobwilliams.github.io/polyroots-fortran/proc/cmplx_roots_gen.html) | General | complex | complex | [Skowron & Gould (2012)](http://www.astrouw.edu.pl/~jskowron/cmplx_roots_sg/) 40 | [`fpml`](https://jacobwilliams.github.io/polyroots-fortran/proc/fpml.html) | General | complex | complex | [Cameron (2019)](https://link.springer.com/article/10.1007/s11075-018-0641-9) 41 | 42 | The library also includes some utility routines: 43 | 44 | * [newton_root_polish](https://jacobwilliams.github.io/polyroots-fortran/interface/newton_root_polish.html) 45 | * [sort_roots](https://jacobwilliams.github.io/polyroots-fortran/proc/sort_roots.html) 46 | 47 | ## Example 48 | 49 | An example of using `polyroots` to compute the zeros for a 5th order real polynomial $$P(x) = x^5 + 2x^4 + 3x^3 + 4x^2 + 5x + 6$$ 50 | 51 | ```fortran 52 | program example 53 | 54 | use iso_fortran_env 55 | use polyroots_module, wp => polyroots_module_rk 56 | 57 | implicit none 58 | 59 | integer,parameter :: degree = 5 !! polynomial degree 60 | real(wp),dimension(degree+1) :: p = [1,2,3,4,5,6] !! coefficients 61 | 62 | integer :: i !! counter 63 | integer :: istatus !! status code 64 | real(wp),dimension(degree) :: zr !! real components of roots 65 | real(wp),dimension(degree) :: zi !! imaginary components of roots 66 | 67 | call polyroots(degree, p, zr, zi, istatus) 68 | 69 | write(*,'(A,1x,I3)') 'istatus: ', istatus 70 | write(*, '(*(a22,1x))') 'real part', 'imaginary part' 71 | do i = 1, degree 72 | write(*,'(*(e22.15,1x))') zr(i), zi(i) 73 | end do 74 | 75 | end program example 76 | ``` 77 | 78 | The result is: 79 | 80 | ``` 81 | istatus: 0 82 | real part imaginary part 83 | 0.551685463458982E+00 0.125334886027721E+01 84 | 0.551685463458982E+00 -0.125334886027721E+01 85 | -0.149179798813990E+01 0.000000000000000E+00 86 | -0.805786469389031E+00 0.122290471337441E+01 87 | -0.805786469389031E+00 -0.122290471337441E+01 88 | ``` 89 | 90 | ## Compiling 91 | 92 | A `fpm.toml` file is provided for compiling polyroots-fortran with the [Fortran Package Manager](https://github.com/fortran-lang/fpm). For example, to build: 93 | 94 | ``` 95 | fpm build --profile release 96 | ``` 97 | 98 | By default, the library is built with double precision (`real64`) real values. Explicitly specifying the real kind can be done using the following processor flags: 99 | 100 | Preprocessor flag | Kind | Number of bytes 101 | ----------------- | ----- | --------------- 102 | `REAL32` | `real(kind=real32)` | 4 103 | `REAL64` | `real(kind=real64)` | 8 104 | `REAL128` | `real(kind=real128)` | 16 105 | 106 | For example, to build a single precision version of the library, use: 107 | 108 | ``` 109 | fpm build --profile release --flag "-DREAL32" 110 | ``` 111 | 112 | All routines, except for `polyroots` are available for any of the three real kinds. `polyroots` is not available for `real128` kinds since there is no corresponding LAPACK eigenvalue solver. 113 | 114 | To run the unit tests: 115 | 116 | ``` 117 | fpm test 118 | ``` 119 | 120 | To use `polyroots-fortran` within your fpm project, add the following to your `fpm.toml` file: 121 | ```toml 122 | [dependencies] 123 | polyroots-fortran = { git="https://github.com/jacobwilliams/polyroots-fortran.git" } 124 | ``` 125 | 126 | or, to use a specific version: 127 | ```toml 128 | [dependencies] 129 | polyroots-fortran = { git="https://github.com/jacobwilliams/polyroots-fortran.git", tag = "1.2.0" } 130 | ``` 131 | 132 | To generate the documentation using [ford](https://github.com/Fortran-FOSS-Programmers/ford), run: ```ford ford.md``` 133 | 134 | ## Documentation 135 | 136 | The latest API documentation for the `master` branch can be found [here](https://jacobwilliams.github.io/polyroots-fortran/). This was generated from the source code using [FORD](https://github.com/Fortran-FOSS-Programmers/ford). 137 | 138 | ## License 139 | 140 | The polyroots-fortran source code and related files and documentation are distributed under a permissive free software [license](https://github.com/jacobwilliams/polyroots-fortran/blob/master/LICENSE.md) (BSD-style). 141 | 142 | ## See also 143 | 144 | * [Roots-Fortran](https://github.com/jacobwilliams/roots-fortran) 145 | 146 | ## Similar libraries in other programming languages 147 | 148 | * R: [polyroot](https://stat.ethz.ch/R-manual/R-devel/library/base/html/polyroot.html) 149 | * MATLAB: [roots](https://www.mathworks.com/help/matlab/ref/roots.html) 150 | * C: [GSL - Polynomials](https://www.gnu.org/software/gsl/doc/html/poly.html), [MPSolve](https://numpi.dm.unipi.it/software/mpsolve) 151 | * Julia: [PolynomialRoots.jl](https://github.com/giordano/PolynomialRoots.jl), [FastPolynomialRoots.jl](https://github.com/andreasnoack/FastPolynomialRoots.jl), [Polynomials.jl](https://github.com/JuliaMath/Polynomials.jl) 152 | * Python: [numpy.polynomial.polynomial](https://docs.scipy.org/doc//numpy-1.10.4/reference/routines.polynomials.polynomial.html) 153 | 154 | ## Other references and codes 155 | 156 | * [GAMS Class F1a](https://gams.nist.gov/cgi-bin/serve.cgi/Class/F1a). 157 | * [eiscor - eigensolvers based on unitary core transformations](https://github.com/eiscor/eiscor) containing the AMVW method from the work of [Aurentz et al. (2015), Fast and Backward Stable Computation of Roots of Polynomials](https://doi.org/10.1137/140983434) (an earlier version can be picked up from [the website of Ran Vandebril](https://people2.cs.kuleuven.be/~raf.vandebril/homepage/software/companion_qr.php?menu=5), one of the co-authors of that paper). 158 | * [PA03](https://www.hsl.rl.ac.uk/archive/specs/pa03.pdf) HSL Archive code for computing all the roots of a cubic polynomial 159 | * [PA05](https://www.hsl.rl.ac.uk/archive/specs/pa05.pdf) HSL Archive code for computing all the roots of a quartic polynomial 160 | * [PA16](https://www.hsl.rl.ac.uk/catalogue/pa16.html), [PA17](https://www.hsl.rl.ac.uk/catalogue/pa17.html) HSL codes for computing zeros of polynomials using method of Madsen and Reid 161 | * Various codes from [Alan Miller](https://jblevins.org/mirror/amiller/) 162 | * [A solver using the companion matrix and LAPACK](https://fortran-lang.discourse.group/t/cardanos-solution-of-the-cubic-equation/111/5?u=ivanpribec) 163 | * [Root-finding algorithms: Roots of Polynomials | Wikipedia](https://en.wikipedia.org/wiki/Root-finding_algorithms#Roots_of_polynomials) 164 | * [Polynomial Roots | Wolfram MathWorld](https://mathworld.wolfram.com/PolynomialRoots.html) 165 | * [What is a Companion Matrix | Nick Higham](https://nhigham.com/2021/03/23/what-is-a-companion-matrix/) 166 | * [19 Dubious Ways to Compute the Zeros of a Polynomial | Cleve's Corner](https://blogs.mathworks.com/cleve/2016/06/27/19-dubious-ways-to-compute-the-zeros-of-a-polynomial/) 167 | * [New Progress in Polynomial Root-finding | Victor Y. Pan](https://arxiv.org/pdf/1805.12042.pdf) 168 | 169 | ## See also 170 | 171 | * [Code coverage statistics](https://app.codecov.io/gh/jacobwilliams/polyroots-fortran) [codecov.io] 172 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: 2 | layout: header, changes, diff, sunburst 3 | coverage: 4 | ignore: 5 | - test 6 | - doc 7 | status: 8 | patch: 9 | default: 10 | target: 20% 11 | project: 12 | default: 13 | target: 60% 14 | -------------------------------------------------------------------------------- /ford.md: -------------------------------------------------------------------------------- 1 | project: polyroots-fortran 2 | src_dir: ./src 3 | output_dir: ./doc 4 | media_dir: ./media 5 | project_github: https://github.com/jacobwilliams/polyroots-fortran 6 | summary: Polynomial Roots with Modern Fortran 7 | author: Jacob Williams 8 | github: https://github.com/jacobwilliams 9 | predocmark_alt: > 10 | predocmark: < 11 | docmark_alt: 12 | docmark: ! 13 | display: public 14 | private 15 | source: true 16 | graph: true 17 | search: true 18 | preprocessor: gfortran -E 19 | extra_mods: iso_fortran_env:https://gcc.gnu.org/onlinedocs/gfortran/ISO_005fFORTRAN_005fENV.html 20 | 21 | {!README.md!} -------------------------------------------------------------------------------- /fpm.toml: -------------------------------------------------------------------------------- 1 | name = "polyroots-fortran" 2 | author = "Jacob Williams" 3 | copyright = "Copyright (c) 2022-2024, Jacob Williams" 4 | license = "BSD-3" 5 | description = "Polynomial Roots with Modern Fortran" 6 | homepage = "https://github.com/jacobwilliams/polyroots-fortran" 7 | keywords = ["root"] 8 | 9 | [build] 10 | auto-executables = false 11 | auto-examples = false 12 | auto-tests = true 13 | link = ["lapack", "blas"] 14 | 15 | [dev-dependencies] 16 | mersenne-twister-fortran = { git="https://github.com/jacobwilliams/mersenne-twister-fortran.git", tag = "1.0.1" } 17 | pyplot-fortran = { git="https://github.com/jacobwilliams/pyplot-fortran.git", tag = "3.2.0" } 18 | 19 | [library] 20 | source-dir = "src" 21 | 22 | [install] 23 | library = true -------------------------------------------------------------------------------- /media/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jacobwilliams/polyroots-fortran/242a453972d5ca3e4ecc0e4a7cee9e86d2c0d382/media/logo.png -------------------------------------------------------------------------------- /media/logo.svg: -------------------------------------------------------------------------------- 1 | 2 | 20 | 22 | 25 | 32 | 33 | 36 | 43 | 44 | 46 | 50 | 54 | 55 | 56 | 79 | 81 | 82 | 84 | image/svg+xml 85 | 87 | 88 | 89 | 90 | 91 | 96 | 104 | Fortran 117 | Polyroots 128 | 129 | 130 | -------------------------------------------------------------------------------- /polyroots-fortran.code-workspace: -------------------------------------------------------------------------------- 1 | { 2 | "folders": [ 3 | { 4 | "path": "." 5 | } 6 | ], 7 | "settings": { 8 | "files.trimTrailingWhitespace": true, 9 | "editor.insertSpaces": true, 10 | "editor.tabSize": 4, 11 | "editor.trimAutoWhitespace": true, 12 | "fortran.formatting.fprettifyArgs": [ 13 | "-i 4", 14 | "--disable-indent-mod", 15 | "--enable-decl" 16 | ], 17 | "fortran.formatting.formatter": "fprettify" 18 | } 19 | } -------------------------------------------------------------------------------- /test/dcbcrt_test.f90: -------------------------------------------------------------------------------- 1 | !***************************************************************************************** 2 | !> 3 | ! Tests for [[dcbcrt]] and [[dqdcrt]]. 4 | 5 | program dcbcrt_test 6 | 7 | use iso_fortran_env 8 | use polyroots_module, wp => polyroots_module_rk 9 | 10 | implicit none 11 | 12 | real(wp), dimension(5) :: a !! coefficients 13 | real(wp), dimension(4) :: zr !! real components of roots 14 | real(wp), dimension(4) :: zi !! imaginary components of roots 15 | 16 | integer :: i !! counter 17 | complex(wp) :: z, root 18 | 19 | a = [1.0_wp, 2.0_wp, 3.0_wp, 4.0_wp, 5.0_wp] 20 | 21 | write(*,'(/A)') 'dqtcrt test:' 22 | call dqtcrt(a, zr(1:4), zi(1:4)) 23 | do i = 1, 4 24 | z = cmplx(zr(i), zi(i), wp) 25 | root = a(1) + a(2)*z + a(3)*z**2 + a(4)*z**3 + a(5)*z**4 26 | write(*,'(A,1x,*(e22.15,1x))') 'root is: ', zr(i), zi(i), abs(root) 27 | if (abs(root) > 100*epsilon(1.0_wp)) error stop 'Error: insufficient accuracy' 28 | end do 29 | 30 | write(*,'(/A)') 'dcbcrt test:' 31 | call dcbcrt(a, zr(1:3), zi(1:3)) 32 | do i = 1, 3 33 | z = cmplx(zr(i), zi(i), wp) 34 | root = a(1) + a(2)*z + a(3)*z**2 + a(4)*z**3 35 | write(*,'(A,1x,*(e22.15,1x))') 'root is: ', zr(i), zi(i), abs(root) 36 | if (abs(root) > 100*epsilon(1.0_wp)) error stop 'Error: insufficient accuracy' 37 | end do 38 | 39 | write(*,'(/A)') 'dqdcrt test:' 40 | call dqdcrt(a(1:3), zr(1:2), zi(1:2)) 41 | do i = 1, 2 42 | z = cmplx(zr(i), zi(i), wp) 43 | root = a(1) + a(2)*z + a(3)*z**2 44 | write(*,'(A,1x,*(e22.15,1x))') 'root is: ', zr(i), zi(i), abs(root) 45 | if (abs(root) > 100*epsilon(1.0_wp)) error stop 'Error: insufficient accuracy' 46 | end do 47 | 48 | write(*,'(/A)') 'quadpl test:' 49 | call quadpl(a(3), a(2), a(1), zr(1), zi(1), zr(2), zi(2)) 50 | do i = 1, 2 51 | z = cmplx(zr(i), zi(i), wp) 52 | root = a(1) + a(2)*z + a(3)*z**2 53 | write(*,'(A,1x,*(e22.15,1x))') 'root is: ', zr(i), zi(i), abs(root) 54 | if (abs(root) > 100*epsilon(1.0_wp)) error stop 'Error: insufficient accuracy' 55 | end do 56 | 57 | end program dcbcrt_test 58 | !***************************************************************************************** -------------------------------------------------------------------------------- /test/example.f90: -------------------------------------------------------------------------------- 1 | !***************************************************************************************** 2 | !> 3 | ! Example in the readme. 4 | 5 | program example 6 | 7 | use iso_fortran_env 8 | use polyroots_module, wp => polyroots_module_rk 9 | 10 | implicit none 11 | 12 | integer,parameter :: degree = 5 !! polynomial degree 13 | real(wp),dimension(degree+1) :: p = [1,2,3,4,5,6] !! coefficients 14 | 15 | integer :: i !! counter 16 | integer :: istatus !! status code 17 | real(wp),dimension(degree) :: zr !! real components of roots 18 | real(wp),dimension(degree) :: zi !! imaginary components of roots 19 | 20 | if (wp==real128) stop ! don't have a quad solver 21 | 22 | call polyroots(degree, p, zr, zi, istatus) 23 | 24 | write(*,'(/A,1x,I3)') 'istatus: ', istatus 25 | write(*, '(*(a22,1x))') 'real part', 'imaginary part' 26 | do i = 1, degree 27 | write(*,'(*(e22.15,1x))') zr(i), zi(i) 28 | end do 29 | 30 | end program example 31 | !***************************************************************************************** -------------------------------------------------------------------------------- /test/numpy-test.py: -------------------------------------------------------------------------------- 1 | import numpy as np 2 | 3 | # weird cases that produce a root that doesn't evaluate to zero. 4 | # 5 | # case 90 6 | # (-140.66232642249253+0j) --> 3.8840212075494556 7 | # (-0.8495747907453617-0.18984925426537902j) --> 4.895797037288796e-13 8 | # (-0.8495747907453617+0.18984925426537902j) --> 4.895797037288796e-13 9 | # (0.014327558420734632-0.9296444676629798j) --> 5.176163245255504e-13 10 | # (0.014327558420734632+0.9296444676629798j) --> 5.176163245255504e-13 11 | # (0.055116133964008746+0j) --> 0.0 12 | # (0.6838441575682882+0j) --> 1.1048939541069558e-12 13 | 14 | # case 113 15 | # (-0.8104330345121576+0j) --> 9.094947017729282e-13 16 | # (-0.7930272777739451-0.7498282775774507j) --> 4.004940581991954e-12 17 | # (-0.7930272777739451+0.7498282775774507j) --> 4.004940581991954e-12 18 | # (0.020968472437567498-1.0338747234876766j) --> 4.466550987380886e-12 19 | # (0.020968472437567498+1.0338747234876766j) --> 4.466550987380886e-12 20 | # (0.6475070012645461-0.6270937740733488j) --> 2.332658883538351e-12 21 | # (0.6475070012645461+0.6270937740733488j) --> 2.332658883538351e-12 22 | # (1.9014675801855059+0j) --> 3.431068762438372e-10 23 | # (28.257072684212886+0j) --> 0.2127890375388688 24 | 25 | print('\n case 90') 26 | 27 | c = np.flip(np.array([ 6.60460233688354, 28 | 935.171142578125, 29 | 867.901550292969, 30 | 352.381774902344, 31 | 320.264373779297, 32 | -332.592407226562, 33 | -398.892456054688, 34 | 22.9384136199951 ])) 35 | 36 | roots = np.polynomial.polynomial.polyroots(c) 37 | 38 | for r in roots: 39 | val = np.abs(np.polynomial.polynomial.polyval(r, c)) 40 | print(r, ' -->', val) 41 | 42 | 43 | print('\n case 113') 44 | c = np.flip(np.array([ 19.7673424520622, 45 | -575.209969604783, 46 | 454.342995592928, 47 | 422.066614439551, 48 | 781.088236436477, 49 | 358.472540727891, 50 | 788.011551825783, 51 | 14.8576676207117, 52 | 330.581477423860, 53 | 890.813059508382 ])) 54 | 55 | roots = np.polynomial.polynomial.polyroots(c) 56 | 57 | for r in roots: 58 | val = np.abs(np.polynomial.polynomial.polyval(r, c)) 59 | print(r, ' -->', val) 60 | -------------------------------------------------------------------------------- /test/polyroots_test.f90: -------------------------------------------------------------------------------- 1 | !***************************************************************************************** 2 | !> 3 | ! Tests for [[rpoly]]. 4 | 5 | program polyroots_test 6 | 7 | use iso_fortran_env 8 | use polyroots_module, wp => polyroots_module_rk 9 | use mt19937_64 10 | !use eiscor_module, only: z_poly_roots 11 | 12 | implicit none 13 | 14 | integer,parameter :: n_cases = 14 + 110 !! number of cases to run 15 | 16 | real(wp),dimension(:),allocatable :: p, pi, zr, zi, s, q, radius, berr,cond 17 | integer,dimension(:),allocatable :: conv 18 | complex(wp),dimension(:),allocatable :: r, cp, cp_ 19 | integer :: degree, i, istatus, icase, n 20 | !integer,dimension(:),allocatable :: seed 21 | real(wp) :: detil 22 | logical :: fail 23 | logical :: failure !! if any of the tests failed 24 | logical,dimension(:),allocatable :: err 25 | integer :: idegree !! counter for degrees to test 26 | integer :: n_degree !! number of tests run for each degree so far 27 | type(mt19937) :: rand !! for random number generation 28 | 29 | failure = .false. 30 | 31 | ! set random seed for consistent results: 32 | call rand%initialize(42) 33 | ! call random_seed(size=n) 34 | ! allocate(seed(n)) 35 | ! seed = 42 36 | ! call random_seed(put=seed) 37 | idegree = 0 38 | n_degree = 1 39 | 40 | do icase = 1, n_cases 41 | 42 | write(*,'(/A,I3,A)') '--------CASE ', icase, ' ---------' 43 | 44 | select case (icase) 45 | case(1) 46 | call allocate_arrays(10) 47 | p = [1._wp, & 48 | -55._wp, & 49 | 1320._wp, & 50 | -18150._wp, & 51 | 157773._wp, & 52 | -902055._wp, & 53 | 3416930._wp, & 54 | -8409500._wp, & 55 | 12753576._wp, & 56 | -10628640._wp, & 57 | 3628800._wp ] 58 | pi = 0.0_wp 59 | case(2) 60 | call allocate_arrays(4) 61 | p = [1,-3,20,44,54] 62 | pi = 0.0_wp 63 | case(3) 64 | call allocate_arrays(6) 65 | p = [1,-2,2,1,6,-6,8] 66 | pi = 0.0_wp 67 | case(4) 68 | call allocate_arrays(5) 69 | p = [1,1,-8,-16,7,15] 70 | pi = 0.0_wp 71 | case(5) 72 | call allocate_arrays(5) 73 | p = [1,7,5,6,3,2] 74 | pi = 0.0_wp 75 | case(6) 76 | call allocate_arrays(5) 77 | p = [2,3,6,5,7,1] 78 | pi = 0.0_wp 79 | case(7) 80 | call allocate_arrays(6) 81 | p = [1,0,-14,0,49,0,-36] 82 | pi = 0.0_wp 83 | case(8) 84 | call allocate_arrays(8) 85 | p = [1,0,-30,0,273,0,-820,0,576] 86 | pi = 0.0_wp 87 | case(9) 88 | call allocate_arrays(4) 89 | p = [1,0,0,0,-16] 90 | pi = 0.0_wp 91 | case(10) 92 | call allocate_arrays(6) 93 | p = [1,-2,2,1,6,-6,8] 94 | pi = 0.0_wp 95 | case(11) 96 | ! a case where 1 is an obvious root 97 | call allocate_arrays(5) 98 | pi = 0.0_wp 99 | p = [8,-8,16,-16,8,-8] 100 | case(12) 101 | call allocate_arrays(3) 102 | p = [ -8.0e18_wp,3.0e12_wp,5.0e6_wp,1.0_wp] 103 | pi = 0.0_wp 104 | case(13) 105 | call allocate_arrays(3) 106 | p = [4.0_wp, 3.0_wp, 2.0_wp, 1.0_wp] 107 | pi = 0.0_wp 108 | case(14) 109 | call allocate_arrays(2) 110 | p = [3.0_wp, 2.0_wp, 1.0_wp] 111 | pi = 0.0_wp 112 | 113 | ! case(15) ! case 90 when compiled with ifort 114 | 115 | ! ! produces a root that doesn't evaluate to zero 116 | ! ! (same result from numpy) 117 | ! call allocate_arrays(7) 118 | ! p = [ 6.60460235615585_wp,& 119 | ! 935.171169456812_wp,& 120 | ! 867.901578904887_wp,& 121 | ! 352.381787706374_wp,& 122 | ! 320.264380528809_wp,& 123 | ! -332.592394794503_wp,& 124 | ! -398.892469194654_wp,& 125 | ! 22.9384139877562_wp ] 126 | ! pi = 0.0_wp 127 | 128 | case default 129 | ! test a set of random coefficients for each degree: 130 | if (idegree>10) then 131 | idegree = 0 132 | n_degree = n_degree + 1 133 | end if 134 | idegree = idegree + 1 135 | call allocate_arrays(n_degree) 136 | 137 | do i = 1, degree+1 138 | p(i) = get_random_number(-1000.0_wp,1000.0_wp) 139 | pi(i) = get_random_number(-10000.0_wp,10000.0_wp) 140 | end do 141 | end select 142 | do i = 1, degree+1 143 | cp(i) = cmplx(p(i), pi(i), wp) ! put in a complex number 144 | end do 145 | q = reverse(p) ! 146 | cp_ = reversez(cp) ! for the ones that require reverse order 147 | 148 | write(*,'(A,1X,I3)') ' Degree: ', degree 149 | write(*,'(A,1X/,*(g23.15/))') ' Coefficients: ', p(1:degree+1) 150 | 151 | if (icase==90 .or. icase==113) then 152 | write(*,*) 'skipping this case' 153 | cycle 154 | end if 155 | 156 | if (degree==2) then 157 | ! also test this one (only for quadratic equations): 158 | call dqdcrt(q, zr, zi) 159 | call check_results('dqdcrt', 0, zr, zi, degree) 160 | end if 161 | 162 | if (degree==3) then 163 | ! also test these (only for cubic equations): 164 | call dcbcrt(q, zr, zi) 165 | call check_results('dcbcrt', 0, zr, zi, degree) 166 | 167 | call rroots_chebyshev_cubic(p, zr, zi) 168 | call check_results('rroots_chebyshev_cubic', 0, zr, zi, degree) 169 | end if 170 | 171 | if (wp /= real128) then 172 | call polyroots(degree, p, zr, zi, istatus) 173 | call check_results('polyroots', istatus, zr, zi, degree) 174 | 175 | call cpolyroots(degree, cp, r, istatus) 176 | call check_results_complex('cpolyroots [complex coefficients]', istatus, real(r, wp), aimag(r), degree) 177 | end if 178 | 179 | call rpoly(p, degree, zr, zi, istatus) 180 | call check_results('rpoly', istatus, zr, zi, degree) 181 | 182 | istatus = 0 ! no estimates input 183 | call rpzero(degree,p,r,istatus,s) 184 | call check_results('rpzero', istatus, real(r,wp), aimag(r), degree) 185 | 186 | call rpqr79(degree,p,r,istatus) 187 | call check_results('rpqr79', istatus, real(r,wp), aimag(r), degree) 188 | 189 | call dpolz(degree,p,zr,zi,istatus) 190 | call check_results('dpolz', istatus, zr, zi, degree) 191 | 192 | call cpolz(cp,degree,r,istatus) 193 | call check_results_complex('cpolz [complex coefficients]', istatus, real(r,wp), aimag(r), degree) 194 | 195 | istatus = 0 196 | call cpoly(p,pi,degree,zr,zi,fail) 197 | if (fail) istatus = -1 198 | call check_results_complex('cpoly [complex coefficients]', istatus, zr, zi, degree) 199 | 200 | call cpqr79(degree,cp,r,istatus) 201 | call check_results_complex('cpqr79 [complex coefficients]', istatus, real(r,wp), aimag(r), degree) 202 | 203 | call qr_algeq_solver(degree,p,zr,zi,istatus,detil=detil) 204 | call check_results('qr_algeq_solver', istatus, zr,zi, degree) 205 | 206 | ! ,... or add to fpm.toml 207 | ![dev-dependencies] 208 | ! eiscor = { git="https://github.com/jacobwilliams/eiscor.git" } 209 | ! if (degree >=2) then 210 | ! call z_poly_roots(degree,cp,r,zr,istatus) ! just use zr for the residuals 211 | ! call check_results_complex('z_poly_roots [complex coefficients]', istatus, real(r, wp), aimag(r), degree) 212 | ! end if 213 | 214 | !.... 215 | ! these accept the complex coefficients in reverse order 216 | call cmplx_roots_gen(degree, cp_, r) ! no status flag 217 | call check_results_complex('cmplx_roots_gen [complex coefficients]', 0, real(r, wp), aimag(r), degree) 218 | 219 | call polzeros(degree, cp_, 100, r, radius, err); istatus = 0; if (any(err)) istatus = -1 220 | call check_results_complex('polzeros [complex coefficients]', istatus, real(r, wp), aimag(r), degree) 221 | 222 | call fpml(cp_, degree, r, berr, cond, conv, itmax=100) 223 | call check_results_complex('fpml [complex coefficients]', 0, real(r, wp), aimag(r), degree) 224 | !.... 225 | if (failure) error stop 'At least one test failed' 226 | end do 227 | 228 | !if (failure) error stop 'At least one test failed' 229 | 230 | contains 231 | 232 | !******************************************************************** 233 | pure function reverse(x) result(y) 234 | 235 | !! reverse a `real(wp)` vector 236 | 237 | implicit none 238 | 239 | real(wp), dimension(:), intent(in) :: x 240 | real(wp), dimension(size(x)) :: y 241 | 242 | integer :: i !! counter 243 | integer :: n !! size of `x` 244 | 245 | n = size(x) 246 | 247 | do i = 1, n 248 | y(i) = x(n-i+1) 249 | end do 250 | 251 | end function reverse 252 | !******************************************************************** 253 | 254 | !******************************************************************** 255 | pure function reversez(x) result(y) 256 | 257 | !! reverse a `complex(wp)` vector 258 | 259 | implicit none 260 | 261 | complex(wp), dimension(:), intent(in) :: x 262 | complex(wp), dimension(size(x)) :: y 263 | 264 | integer :: i !! counter 265 | integer :: n !! size of `x` 266 | 267 | n = size(x) 268 | 269 | do i = 1, n 270 | y(i) = x(n-i+1) 271 | end do 272 | 273 | end function reversez 274 | !******************************************************************** 275 | 276 | !******************************************************************** 277 | subroutine allocate_arrays(d) 278 | 279 | integer,intent(in) :: d 280 | 281 | integer :: i 282 | 283 | degree = d 284 | 285 | p = [(0, i=1,degree+1)] 286 | pi = [(0, i=1,degree+1)] 287 | q = [(0, i=1,degree+1)] 288 | cp = [(0, i=1,degree+1)] 289 | cp_ = [(0, i=1,degree+1)] 290 | berr = [(0, i=1,degree+1)] 291 | 292 | zr = [(0, i=1,degree)] 293 | zi = [(0, i=1,degree)] 294 | s = [(0, i=1,degree)] 295 | r = [(0, i=1,degree)] 296 | radius = [(0, i=1,degree)] 297 | err = [(.false., i=1,degree)] 298 | cond = [(0, i=1,degree)] 299 | conv = [(0, i=1,degree)] 300 | 301 | end subroutine allocate_arrays 302 | !******************************************************************** 303 | 304 | !***************************************************************************************** 305 | subroutine check_results(name, istatus, zr, zi, degree) 306 | 307 | !! check the results. 308 | !! if any are not within the tolerance, 309 | !! then also try to polish them using the newton method. 310 | 311 | character(len=*),intent(in) :: name !! name of method 312 | integer,intent(in) :: istatus !! status flag (0 = success) 313 | real(wp),dimension(:),intent(in) :: zr, zi 314 | integer,intent(in) :: degree 315 | 316 | real(wp) :: zr_, zi_ ! copy of inputs for polishing 317 | real(wp),dimension(size(zr)) :: re, im ! copy of inputs for sorting 318 | complex(wp) :: z, root 319 | integer :: i,j !! counter 320 | integer :: istat 321 | 322 | real(wp),parameter :: tol = 1.0e-2_wp !! acceptable root tolerance for tests 323 | real(wp),parameter :: ftol = 1.0e-8_wp !! desired root tolerance 324 | real(wp),parameter :: ztol = 10*epsilon(1.0_wp) !! newton tol for x 325 | logical,parameter :: polish = .true. 326 | 327 | write(*, '(/A,1x,i3)') trim(name) 328 | 329 | if (istatus /= 0) then 330 | failure = .true. 331 | write(*,'(A,1x,i3)') 'Error: method did not converge. istatus = ', istatus 332 | !error stop 'Error: method did not converge' 333 | return 334 | end if 335 | 336 | ! sort them in increasing order: 337 | re = zr 338 | im = zi 339 | call sort_roots(re, im) 340 | 341 | write(*, '(a)') ' real part imaginary part root' 342 | 343 | do j = 1, degree 344 | z = cmplx(re(j), im(j), wp) 345 | root = p(1) 346 | do i = 2, degree+1 347 | root = root * z + p(i) ! horner's rule 348 | end do 349 | write(*, '(3(2g23.15,1x))') re(j), im(j), abs(root) 350 | if (polish .and. abs(root) > ftol) then 351 | ! attempt to polish the root: 352 | zr_ = re(j) 353 | zi_ = im(j) 354 | call newton_root_polish(degree, p, zr_, zi_, & 355 | ftol=ftol, ztol=ztol, maxiter=10, & 356 | istat=istat) 357 | z = cmplx(zr_, zi_, wp) ! recompute root with possibly updated values 358 | root = p(1) 359 | do i = 2, degree+1 360 | root = root * z + p(i) ! horner's rule 361 | end do 362 | write(*, '(3(2g23.15,1x),1X,A)') zr_, zi_, abs(root), 'POLISHED' 363 | if (abs(root) > tol) then 364 | failure = .true. 365 | write(*,'(A)') 'Error: insufficient accuracy *******' 366 | error stop 'Error: insufficient accuracy' 367 | end if 368 | end if 369 | end do 370 | 371 | end subroutine check_results 372 | !***************************************************************************************** 373 | 374 | !***************************************************************************************** 375 | subroutine check_results_complex(name, istatus, zr, zi, degree) 376 | 377 | !! check the results (for complex coefficients). 378 | !! if any are not within the tolerance, 379 | !! then also try to polish them using the newton method. 380 | 381 | character(len=*),intent(in) :: name !! name of method 382 | integer,intent(in) :: istatus !! status flag (0 = success) 383 | real(wp),dimension(:),intent(in) :: zr, zi 384 | integer,intent(in) :: degree 385 | 386 | real(wp) :: zr_, zi_ ! copy of inputs for polishing 387 | real(wp),dimension(size(zr)) :: re, im ! copy of inputs for sorting 388 | complex(wp) :: z, root 389 | integer :: i,j !! counter 390 | integer :: istat 391 | 392 | real(wp),parameter :: tol = 1.0e-2_wp !! acceptable root tolerance for tests 393 | real(wp),parameter :: ftol = 1.0e-8_wp !! desired root tolerance 394 | real(wp),parameter :: ztol = 10*epsilon(1.0_wp) !! newton tol for x 395 | logical,parameter :: polish = .true. 396 | 397 | write(*, '(/A,1x,i3)') trim(name) 398 | 399 | if (istatus /= 0) then 400 | failure = .true. 401 | write(*,'(A,1x,i3)') 'Error: method did not converge. istatus = ', istatus 402 | return 403 | end if 404 | 405 | ! sort them in increasing order: 406 | re = zr 407 | im = zi 408 | call sort_roots(re, im) 409 | 410 | write(*, '(a)') ' real part imaginary part root' 411 | 412 | do j = 1, degree 413 | z = cmplx(re(j), im(j), wp) 414 | root = cp(1) 415 | do i = 2, degree+1 416 | root = root * z + cp(i) ! horner's rule 417 | end do 418 | write(*, '(3(2g23.15,1x))') re(j), im(j), abs(root) 419 | if (polish .and. abs(root) > ftol) then 420 | ! attempt to polish the root: 421 | zr_ = re(j) 422 | zi_ = im(j) 423 | call newton_root_polish(degree, cp, zr_, zi_, & 424 | ftol=ftol, ztol=ztol, maxiter=10, & 425 | istat=istat) 426 | z = cmplx(zr_, zi_, wp) ! recompute root with possibly updated values 427 | root = cp(1) 428 | do i = 2, degree+1 429 | root = root * z + cp(i) ! horner's rule 430 | end do 431 | write(*, '(3(2g23.15,1x),1X,A)') zr_, zi_, abs(root), 'POLISHED' 432 | if (abs(root) > tol) then 433 | failure = .true. 434 | write(*,'(A)') 'Error: insufficient accuracy *******' 435 | error stop 'Error: insufficient accuracy' 436 | end if 437 | end if 438 | end do 439 | 440 | end subroutine check_results_complex 441 | !***************************************************************************************** 442 | 443 | !***************************************************************************************** 444 | !> author: Jacob Williams 445 | ! 446 | ! Returns a uniform random number `x`, such that: `a <= x < b`. 447 | ! 448 | ! This routine is from the Fortran Astrodynamics Toolkit. 449 | 450 | function get_random_number(a,b) result(x) 451 | 452 | implicit none 453 | 454 | real(wp) :: x 455 | real(wp),intent(in) :: a 456 | real(wp),intent(in) :: b 457 | 458 | !call random_number(x) 459 | x = rand%genrand64_real1() 460 | 461 | x = a + (b-a)*x 462 | 463 | end function get_random_number 464 | !***************************************************************************************** 465 | 466 | !***************************************************************************************** 467 | end program polyroots_test 468 | !***************************************************************************************** -------------------------------------------------------------------------------- /test/polyroots_test_10.f90: -------------------------------------------------------------------------------- 1 | !***************************************************************************************** 2 | !> 3 | ! Compute roots for all 10th degree polynomials with coefficients +/- 1. 4 | 5 | program polyroots_test_10 6 | 7 | use polyroots_module, only: polyroots, dpolz, wp => polyroots_module_rk 8 | use pyplot_module, only: pyplot 9 | 10 | implicit none 11 | 12 | integer :: degree = 5 !! polynomial degree 13 | integer,dimension(2) :: icoeffs = [-1,1] !! set of coefficients 14 | integer :: ierr !! error code from [[dpolz]] 15 | type(pyplot) :: plt !! for making the plot 16 | integer :: i ,j 17 | character(len=5) :: istr 18 | integer,dimension (:),allocatable :: a !! coefficients of polynomial 19 | real(wp),dimension(:),allocatable :: zr, zi !! roots 20 | 21 | do i = 2, 10, 2 22 | 23 | write(istr,'(I5)') i; istr = adjustl(istr) 24 | degree = i 25 | ! resize 26 | a = [(0, j = 1, degree+1)] 27 | zr = [(0, j = 1, degree)] 28 | zi = [(0, j = 1, degree)] 29 | 30 | !icoeffs = icoeffs + 1 31 | write(*,*) 'degree = ', degree 32 | call plt%initialize(grid=.true.,xlabel='$\Re(z)$',ylabel='$\Im(z)$',& 33 | title='Degree '//trim(istr)//' Polynomial Roots',usetex=.true.,& 34 | font_size=25, axes_labelsize=25, & 35 | xtick_labelsize=25, ytick_labelsize=25, & 36 | figsize=[20,10]) 37 | call generate(1) 38 | call plt%savefig('roots_'//trim(istr)//'.png') 39 | 40 | end do 41 | 42 | contains 43 | 44 | recursive subroutine generate (i) 45 | integer, intent(in) :: i 46 | integer :: ix 47 | if (i > degree+1) then 48 | !write (*, '(*(I2,","))') a 49 | call polyroots(degree,real(a,wp),zr,zi,ierr) !polyroots !! dpolz 50 | if (ierr/=0) return !error stop ierr 51 | call plt%add_plot(zr,zi,label='',linestyle='bo',markersize=2) 52 | else 53 | do ix = 1,size(icoeffs) 54 | a(i) = icoeffs(ix) 55 | call generate(i+1) 56 | end do 57 | end if 58 | end subroutine generate 59 | 60 | end program polyroots_test_10 61 | !***************************************************************************************** --------------------------------------------------------------------------------