├── .gitignore ├── LICENSE.txt ├── README.md ├── demos ├── demo1.py ├── demo10.py ├── demo11.py ├── demo2.py ├── demo3.py ├── demo4.py ├── demo5.py ├── demo6.py ├── demo7.py ├── demo8.py └── demo9.py ├── orthpol ├── __init__.py ├── _lancz.py ├── _orthogonal_polynomial.py └── _quadrature_rule.py ├── setup.cfg ├── setup.py ├── src ├── README ├── d1mach.f ├── dchri.f ├── dfejer.f ├── dgauss.f ├── dknum.f ├── dlancz.f ├── dlob.f ├── dradau.f ├── drecur.f ├── dsti.f ├── eval.f ├── r1mach.f ├── schri.f ├── sfejer.f ├── sgauss.f ├── skern.f ├── sknum.f ├── slancz.f ├── slob.f ├── sradau.f ├── srecur.f └── ssti.f └── unittests └── test.py /.gitignore: -------------------------------------------------------------------------------- 1 | *.~ 2 | *.dot 3 | *.txt 4 | *.pyc 5 | *.html 6 | *.pickle 7 | *.inv 8 | *.js 9 | *.out 10 | *doctree* 11 | *.so 12 | *.swp 13 | *.o??????? 14 | *.png 15 | *.pcl 16 | *.pickle 17 | *.bk 18 | src/CMakeFiles/ 19 | src/Makefile 20 | src/cmake_install.cmake 21 | build 22 | backup 23 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 2.1, February 1999 3 | 4 | Copyright (C) 1991, 1999 Free Software Foundation, Inc. 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | (This is the first released version of the Lesser GPL. It also counts 10 | as the successor of the GNU Library Public License, version 2, hence 11 | the version number 2.1.) 12 | 13 | Preamble 14 | 15 | The licenses for most software are designed to take away your 16 | freedom to share and change it. By contrast, the GNU General Public 17 | Licenses are intended to guarantee your freedom to share and change 18 | free software--to make sure the software is free for all its users. 19 | 20 | This license, the Lesser General Public License, applies to some 21 | specially designated software packages--typically libraries--of the 22 | Free Software Foundation and other authors who decide to use it. You 23 | can use it too, but we suggest you first think carefully about whether 24 | this license or the ordinary General Public License is the better 25 | strategy to use in any particular case, based on the explanations below. 26 | 27 | When we speak of free software, we are referring to freedom of use, 28 | not price. Our General Public Licenses are designed to make sure that 29 | you have the freedom to distribute copies of free software (and charge 30 | for this service if you wish); that you receive source code or can get 31 | it if you want it; that you can change the software and use pieces of 32 | it in new free programs; and that you are informed that you can do 33 | these things. 34 | 35 | To protect your rights, we need to make restrictions that forbid 36 | distributors to deny you these rights or to ask you to surrender these 37 | rights. These restrictions translate to certain responsibilities for 38 | you if you distribute copies of the library or if you modify it. 39 | 40 | For example, if you distribute copies of the library, whether gratis 41 | or for a fee, you must give the recipients all the rights that we gave 42 | you. You must make sure that they, too, receive or can get the source 43 | code. If you link other code with the library, you must provide 44 | complete object files to the recipients, so that they can relink them 45 | with the library after making changes to the library and recompiling 46 | it. And you must show them these terms so they know their rights. 47 | 48 | We protect your rights with a two-step method: (1) we copyright the 49 | library, and (2) we offer you this license, which gives you legal 50 | permission to copy, distribute and/or modify the library. 51 | 52 | To protect each distributor, we want to make it very clear that 53 | there is no warranty for the free library. Also, if the library is 54 | modified by someone else and passed on, the recipients should know 55 | that what they have is not the original version, so that the original 56 | author's reputation will not be affected by problems that might be 57 | introduced by others. 58 | 59 | Finally, software patents pose a constant threat to the existence of 60 | any free program. We wish to make sure that a company cannot 61 | effectively restrict the users of a free program by obtaining a 62 | restrictive license from a patent holder. Therefore, we insist that 63 | any patent license obtained for a version of the library must be 64 | consistent with the full freedom of use specified in this license. 65 | 66 | Most GNU software, including some libraries, is covered by the 67 | ordinary GNU General Public License. This license, the GNU Lesser 68 | General Public License, applies to certain designated libraries, and 69 | is quite different from the ordinary General Public License. We use 70 | this license for certain libraries in order to permit linking those 71 | libraries into non-free programs. 72 | 73 | When a program is linked with a library, whether statically or using 74 | a shared library, the combination of the two is legally speaking a 75 | combined work, a derivative of the original library. The ordinary 76 | General Public License therefore permits such linking only if the 77 | entire combination fits its criteria of freedom. The Lesser General 78 | Public License permits more lax criteria for linking other code with 79 | the library. 80 | 81 | We call this license the "Lesser" General Public License because it 82 | does Less to protect the user's freedom than the ordinary General 83 | Public License. It also provides other free software developers Less 84 | of an advantage over competing non-free programs. These disadvantages 85 | are the reason we use the ordinary General Public License for many 86 | libraries. However, the Lesser license provides advantages in certain 87 | special circumstances. 88 | 89 | For example, on rare occasions, there may be a special need to 90 | encourage the widest possible use of a certain library, so that it becomes 91 | a de-facto standard. To achieve this, non-free programs must be 92 | allowed to use the library. A more frequent case is that a free 93 | library does the same job as widely used non-free libraries. In this 94 | case, there is little to gain by limiting the free library to free 95 | software only, so we use the Lesser General Public License. 96 | 97 | In other cases, permission to use a particular library in non-free 98 | programs enables a greater number of people to use a large body of 99 | free software. For example, permission to use the GNU C Library in 100 | non-free programs enables many more people to use the whole GNU 101 | operating system, as well as its variant, the GNU/Linux operating 102 | system. 103 | 104 | Although the Lesser General Public License is Less protective of the 105 | users' freedom, it does ensure that the user of a program that is 106 | linked with the Library has the freedom and the wherewithal to run 107 | that program using a modified version of the Library. 108 | 109 | The precise terms and conditions for copying, distribution and 110 | modification follow. Pay close attention to the difference between a 111 | "work based on the library" and a "work that uses the library". The 112 | former contains code derived from the library, whereas the latter must 113 | be combined with the library in order to run. 114 | 115 | GNU LESSER GENERAL PUBLIC LICENSE 116 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 117 | 118 | 0. This License Agreement applies to any software library or other 119 | program which contains a notice placed by the copyright holder or 120 | other authorized party saying it may be distributed under the terms of 121 | this Lesser General Public License (also called "this License"). 122 | Each licensee is addressed as "you". 123 | 124 | A "library" means a collection of software functions and/or data 125 | prepared so as to be conveniently linked with application programs 126 | (which use some of those functions and data) to form executables. 127 | 128 | The "Library", below, refers to any such software library or work 129 | which has been distributed under these terms. A "work based on the 130 | Library" means either the Library or any derivative work under 131 | copyright law: that is to say, a work containing the Library or a 132 | portion of it, either verbatim or with modifications and/or translated 133 | straightforwardly into another language. (Hereinafter, translation is 134 | included without limitation in the term "modification".) 135 | 136 | "Source code" for a work means the preferred form of the work for 137 | making modifications to it. For a library, complete source code means 138 | all the source code for all modules it contains, plus any associated 139 | interface definition files, plus the scripts used to control compilation 140 | and installation of the library. 141 | 142 | Activities other than copying, distribution and modification are not 143 | covered by this License; they are outside its scope. The act of 144 | running a program using the Library is not restricted, and output from 145 | such a program is covered only if its contents constitute a work based 146 | on the Library (independent of the use of the Library in a tool for 147 | writing it). Whether that is true depends on what the Library does 148 | and what the program that uses the Library does. 149 | 150 | 1. You may copy and distribute verbatim copies of the Library's 151 | complete source code as you receive it, in any medium, provided that 152 | you conspicuously and appropriately publish on each copy an 153 | appropriate copyright notice and disclaimer of warranty; keep intact 154 | all the notices that refer to this License and to the absence of any 155 | warranty; and distribute a copy of this License along with the 156 | Library. 157 | 158 | You may charge a fee for the physical act of transferring a copy, 159 | and you may at your option offer warranty protection in exchange for a 160 | fee. 161 | 162 | 2. You may modify your copy or copies of the Library or any portion 163 | of it, thus forming a work based on the Library, and copy and 164 | distribute such modifications or work under the terms of Section 1 165 | above, provided that you also meet all of these conditions: 166 | 167 | a) The modified work must itself be a software library. 168 | 169 | b) You must cause the files modified to carry prominent notices 170 | stating that you changed the files and the date of any change. 171 | 172 | c) You must cause the whole of the work to be licensed at no 173 | charge to all third parties under the terms of this License. 174 | 175 | d) If a facility in the modified Library refers to a function or a 176 | table of data to be supplied by an application program that uses 177 | the facility, other than as an argument passed when the facility 178 | is invoked, then you must make a good faith effort to ensure that, 179 | in the event an application does not supply such function or 180 | table, the facility still operates, and performs whatever part of 181 | its purpose remains meaningful. 182 | 183 | (For example, a function in a library to compute square roots has 184 | a purpose that is entirely well-defined independent of the 185 | application. Therefore, Subsection 2d requires that any 186 | application-supplied function or table used by this function must 187 | be optional: if the application does not supply it, the square 188 | root function must still compute square roots.) 189 | 190 | These requirements apply to the modified work as a whole. If 191 | identifiable sections of that work are not derived from the Library, 192 | and can be reasonably considered independent and separate works in 193 | themselves, then this License, and its terms, do not apply to those 194 | sections when you distribute them as separate works. But when you 195 | distribute the same sections as part of a whole which is a work based 196 | on the Library, the distribution of the whole must be on the terms of 197 | this License, whose permissions for other licensees extend to the 198 | entire whole, and thus to each and every part regardless of who wrote 199 | it. 200 | 201 | Thus, it is not the intent of this section to claim rights or contest 202 | your rights to work written entirely by you; rather, the intent is to 203 | exercise the right to control the distribution of derivative or 204 | collective works based on the Library. 205 | 206 | In addition, mere aggregation of another work not based on the Library 207 | with the Library (or with a work based on the Library) on a volume of 208 | a storage or distribution medium does not bring the other work under 209 | the scope of this License. 210 | 211 | 3. You may opt to apply the terms of the ordinary GNU General Public 212 | License instead of this License to a given copy of the Library. To do 213 | this, you must alter all the notices that refer to this License, so 214 | that they refer to the ordinary GNU General Public License, version 2, 215 | instead of to this License. (If a newer version than version 2 of the 216 | ordinary GNU General Public License has appeared, then you can specify 217 | that version instead if you wish.) Do not make any other change in 218 | these notices. 219 | 220 | Once this change is made in a given copy, it is irreversible for 221 | that copy, so the ordinary GNU General Public License applies to all 222 | subsequent copies and derivative works made from that copy. 223 | 224 | This option is useful when you wish to copy part of the code of 225 | the Library into a program that is not a library. 226 | 227 | 4. You may copy and distribute the Library (or a portion or 228 | derivative of it, under Section 2) in object code or executable form 229 | under the terms of Sections 1 and 2 above provided that you accompany 230 | it with the complete corresponding machine-readable source code, which 231 | must be distributed under the terms of Sections 1 and 2 above on a 232 | medium customarily used for software interchange. 233 | 234 | If distribution of object code is made by offering access to copy 235 | from a designated place, then offering equivalent access to copy the 236 | source code from the same place satisfies the requirement to 237 | distribute the source code, even though third parties are not 238 | compelled to copy the source along with the object code. 239 | 240 | 5. A program that contains no derivative of any portion of the 241 | Library, but is designed to work with the Library by being compiled or 242 | linked with it, is called a "work that uses the Library". Such a 243 | work, in isolation, is not a derivative work of the Library, and 244 | therefore falls outside the scope of this License. 245 | 246 | However, linking a "work that uses the Library" with the Library 247 | creates an executable that is a derivative of the Library (because it 248 | contains portions of the Library), rather than a "work that uses the 249 | library". The executable is therefore covered by this License. 250 | Section 6 states terms for distribution of such executables. 251 | 252 | When a "work that uses the Library" uses material from a header file 253 | that is part of the Library, the object code for the work may be a 254 | derivative work of the Library even though the source code is not. 255 | Whether this is true is especially significant if the work can be 256 | linked without the Library, or if the work is itself a library. The 257 | threshold for this to be true is not precisely defined by law. 258 | 259 | If such an object file uses only numerical parameters, data 260 | structure layouts and accessors, and small macros and small inline 261 | functions (ten lines or less in length), then the use of the object 262 | file is unrestricted, regardless of whether it is legally a derivative 263 | work. (Executables containing this object code plus portions of the 264 | Library will still fall under Section 6.) 265 | 266 | Otherwise, if the work is a derivative of the Library, you may 267 | distribute the object code for the work under the terms of Section 6. 268 | Any executables containing that work also fall under Section 6, 269 | whether or not they are linked directly with the Library itself. 270 | 271 | 6. As an exception to the Sections above, you may also combine or 272 | link a "work that uses the Library" with the Library to produce a 273 | work containing portions of the Library, and distribute that work 274 | under terms of your choice, provided that the terms permit 275 | modification of the work for the customer's own use and reverse 276 | engineering for debugging such modifications. 277 | 278 | You must give prominent notice with each copy of the work that the 279 | Library is used in it and that the Library and its use are covered by 280 | this License. You must supply a copy of this License. If the work 281 | during execution displays copyright notices, you must include the 282 | copyright notice for the Library among them, as well as a reference 283 | directing the user to the copy of this License. Also, you must do one 284 | of these things: 285 | 286 | a) Accompany the work with the complete corresponding 287 | machine-readable source code for the Library including whatever 288 | changes were used in the work (which must be distributed under 289 | Sections 1 and 2 above); and, if the work is an executable linked 290 | with the Library, with the complete machine-readable "work that 291 | uses the Library", as object code and/or source code, so that the 292 | user can modify the Library and then relink to produce a modified 293 | executable containing the modified Library. (It is understood 294 | that the user who changes the contents of definitions files in the 295 | Library will not necessarily be able to recompile the application 296 | to use the modified definitions.) 297 | 298 | b) Use a suitable shared library mechanism for linking with the 299 | Library. A suitable mechanism is one that (1) uses at run time a 300 | copy of the library already present on the user's computer system, 301 | rather than copying library functions into the executable, and (2) 302 | will operate properly with a modified version of the library, if 303 | the user installs one, as long as the modified version is 304 | interface-compatible with the version that the work was made with. 305 | 306 | c) Accompany the work with a written offer, valid for at 307 | least three years, to give the same user the materials 308 | specified in Subsection 6a, above, for a charge no more 309 | than the cost of performing this distribution. 310 | 311 | d) If distribution of the work is made by offering access to copy 312 | from a designated place, offer equivalent access to copy the above 313 | specified materials from the same place. 314 | 315 | e) Verify that the user has already received a copy of these 316 | materials or that you have already sent this user a copy. 317 | 318 | For an executable, the required form of the "work that uses the 319 | Library" must include any data and utility programs needed for 320 | reproducing the executable from it. However, as a special exception, 321 | the materials to be distributed need not include anything that is 322 | normally distributed (in either source or binary form) with the major 323 | components (compiler, kernel, and so on) of the operating system on 324 | which the executable runs, unless that component itself accompanies 325 | the executable. 326 | 327 | It may happen that this requirement contradicts the license 328 | restrictions of other proprietary libraries that do not normally 329 | accompany the operating system. Such a contradiction means you cannot 330 | use both them and the Library together in an executable that you 331 | distribute. 332 | 333 | 7. You may place library facilities that are a work based on the 334 | Library side-by-side in a single library together with other library 335 | facilities not covered by this License, and distribute such a combined 336 | library, provided that the separate distribution of the work based on 337 | the Library and of the other library facilities is otherwise 338 | permitted, and provided that you do these two things: 339 | 340 | a) Accompany the combined library with a copy of the same work 341 | based on the Library, uncombined with any other library 342 | facilities. This must be distributed under the terms of the 343 | Sections above. 344 | 345 | b) Give prominent notice with the combined library of the fact 346 | that part of it is a work based on the Library, and explaining 347 | where to find the accompanying uncombined form of the same work. 348 | 349 | 8. You may not copy, modify, sublicense, link with, or distribute 350 | the Library except as expressly provided under this License. Any 351 | attempt otherwise to copy, modify, sublicense, link with, or 352 | distribute the Library is void, and will automatically terminate your 353 | rights under this License. However, parties who have received copies, 354 | or rights, from you under this License will not have their licenses 355 | terminated so long as such parties remain in full compliance. 356 | 357 | 9. You are not required to accept this License, since you have not 358 | signed it. However, nothing else grants you permission to modify or 359 | distribute the Library or its derivative works. These actions are 360 | prohibited by law if you do not accept this License. Therefore, by 361 | modifying or distributing the Library (or any work based on the 362 | Library), you indicate your acceptance of this License to do so, and 363 | all its terms and conditions for copying, distributing or modifying 364 | the Library or works based on it. 365 | 366 | 10. Each time you redistribute the Library (or any work based on the 367 | Library), the recipient automatically receives a license from the 368 | original licensor to copy, distribute, link with or modify the Library 369 | subject to these terms and conditions. You may not impose any further 370 | restrictions on the recipients' exercise of the rights granted herein. 371 | You are not responsible for enforcing compliance by third parties with 372 | this License. 373 | 374 | 11. If, as a consequence of a court judgment or allegation of patent 375 | infringement or for any other reason (not limited to patent issues), 376 | conditions are imposed on you (whether by court order, agreement or 377 | otherwise) that contradict the conditions of this License, they do not 378 | excuse you from the conditions of this License. If you cannot 379 | distribute so as to satisfy simultaneously your obligations under this 380 | License and any other pertinent obligations, then as a consequence you 381 | may not distribute the Library at all. For example, if a patent 382 | license would not permit royalty-free redistribution of the Library by 383 | all those who receive copies directly or indirectly through you, then 384 | the only way you could satisfy both it and this License would be to 385 | refrain entirely from distribution of the Library. 386 | 387 | If any portion of this section is held invalid or unenforceable under any 388 | particular circumstance, the balance of the section is intended to apply, 389 | and the section as a whole is intended to apply in other circumstances. 390 | 391 | It is not the purpose of this section to induce you to infringe any 392 | patents or other property right claims or to contest validity of any 393 | such claims; this section has the sole purpose of protecting the 394 | integrity of the free software distribution system which is 395 | implemented by public license practices. Many people have made 396 | generous contributions to the wide range of software distributed 397 | through that system in reliance on consistent application of that 398 | system; it is up to the author/donor to decide if he or she is willing 399 | to distribute software through any other system and a licensee cannot 400 | impose that choice. 401 | 402 | This section is intended to make thoroughly clear what is believed to 403 | be a consequence of the rest of this License. 404 | 405 | 12. If the distribution and/or use of the Library is restricted in 406 | certain countries either by patents or by copyrighted interfaces, the 407 | original copyright holder who places the Library under this License may add 408 | an explicit geographical distribution limitation excluding those countries, 409 | so that distribution is permitted only in or among countries not thus 410 | excluded. In such case, this License incorporates the limitation as if 411 | written in the body of this License. 412 | 413 | 13. The Free Software Foundation may publish revised and/or new 414 | versions of the Lesser General Public License from time to time. 415 | Such new versions will be similar in spirit to the present version, 416 | but may differ in detail to address new problems or concerns. 417 | 418 | Each version is given a distinguishing version number. If the Library 419 | specifies a version number of this License which applies to it and 420 | "any later version", you have the option of following the terms and 421 | conditions either of that version or of any later version published by 422 | the Free Software Foundation. If the Library does not specify a 423 | license version number, you may choose any version ever published by 424 | the Free Software Foundation. 425 | 426 | 14. If you wish to incorporate parts of the Library into other free 427 | programs whose distribution conditions are incompatible with these, 428 | write to the author to ask for permission. For software which is 429 | copyrighted by the Free Software Foundation, write to the Free 430 | Software Foundation; we sometimes make exceptions for this. Our 431 | decision will be guided by the two goals of preserving the free status 432 | of all derivatives of our free software and of promoting the sharing 433 | and reuse of software generally. 434 | 435 | NO WARRANTY 436 | 437 | 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO 438 | WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 439 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR 440 | OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY 441 | KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE 442 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 443 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 444 | LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME 445 | THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 446 | 447 | 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN 448 | WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY 449 | AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU 450 | FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR 451 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 452 | LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 453 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 454 | FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 455 | SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 456 | DAMAGES. 457 | 458 | END OF TERMS AND CONDITIONS 459 | 460 | How to Apply These Terms to Your New Libraries 461 | 462 | If you develop a new library, and you want it to be of the greatest 463 | possible use to the public, we recommend making it free software that 464 | everyone can redistribute and change. You can do so by permitting 465 | redistribution under these terms (or, alternatively, under the terms of the 466 | ordinary General Public License). 467 | 468 | To apply these terms, attach the following notices to the library. It is 469 | safest to attach them to the start of each source file to most effectively 470 | convey the exclusion of warranty; and each file should have at least the 471 | "copyright" line and a pointer to where the full notice is found. 472 | 473 | {description} 474 | Copyright (C) {year} {fullname} 475 | 476 | This library is free software; you can redistribute it and/or 477 | modify it under the terms of the GNU Lesser General Public 478 | License as published by the Free Software Foundation; either 479 | version 2.1 of the License, or (at your option) any later version. 480 | 481 | This library is distributed in the hope that it will be useful, 482 | but WITHOUT ANY WARRANTY; without even the implied warranty of 483 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 484 | Lesser General Public License for more details. 485 | 486 | You should have received a copy of the GNU Lesser General Public 487 | License along with this library; if not, write to the Free Software 488 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 489 | USA 490 | 491 | Also add information on how to contact you by electronic and paper mail. 492 | 493 | You should also get your employer (if you work as a programmer) or your 494 | school, if any, to sign a "copyright disclaimer" for the library, if 495 | necessary. Here is a sample; alter the names: 496 | 497 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 498 | library `Frob' (a library for tweaking knobs) written by James Random 499 | Hacker. 500 | 501 | {signature of Ty Coon}, 1 April 1990 502 | Ty Coon, President of Vice 503 | 504 | That's all there is to it! -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Orthogonal Polynomials in Python 2 | ================================ 3 | 4 | Description 5 | ----------- 6 | The ``py-orthpol`` package defines the module ``orthpol`` which can be used 7 | easily construct univariate and multivariate orthogonal polynomials in Python. 8 | The purpose of this code is to serve as a component in Python packages that 9 | could use orthogonal polynomials as basis functions for various tasks. 10 | For example: 11 | + The polynomials can be used in least squares applications. 12 | + The polynomials can serve as the mean in Gaussian process regression. 13 | + etc. 14 | 15 | The need to have an easy to use package that can generate polynomials orthogonal 16 | with respect to arbitrary weight functions is motivated by applications in the 17 | field of Uncertainty Quantification (UQ). In UQ, collections of such polynomials 18 | are known as generalized Polynomial Chaos (gPC). My end goal is to provide a tool 19 | that makes it **ridiculously easy** to construct these polynomials. 20 | 21 | Where does this come from? 22 | -------------------------- 23 | 24 | This package serves as a Python wrapper for the legacy Fortran code 25 | [ORTHPOL](http://dl.acm.org/citation.cfm?id=174605). The original ORTHPOL 26 | code can be found 27 | [here](https://www.cs.purdue.edu/archives/2001/wxg/codes/ORTHPOL). 28 | The code that computes tensors products of univariate orthogonal polynomials 29 | is a transolation of [Stockos](http://trilinos.sandia.gov/packages/stokhos/) 30 | C++ routines to Python. 31 | 32 | Installation 33 | ------------ 34 | 35 | Simply clone the repository: 36 | 37 | ``` 38 | git clone https://github.com/ebilionis/py-orthpol.git 39 | ``` 40 | 41 | Go inside the directory and run: 42 | 43 | ``` 44 | python setup.py install 45 | ``` 46 | 47 | Demos 48 | ----- 49 | 50 | I provide several demos that demonstrate how polynomials can be constructed 51 | both from simple weight functions as well as ``scipy.stats`` random variables. 52 | It is quite easy based on these examples to generalize to more complicated cases. 53 | All one has to do is change the weight function or the random variable. 54 | Here is a list of them: 55 | + [demos/demo1.py](demos/demo1.py): Hermite polynomials using a weight function. 56 | + [demos/demo2.py](demos/demo2.py): Laguerre polynomials using a weight function. 57 | + [demos/demo3.py](demos/demo3.py): Chebyshev polynomials using a weight function. 58 | + [demos/demo4.py](demos/demo4.py): Jacobi polynomials using a weight function. 59 | + [demos/demo5.py](demos/demo5.py): Gegenbauer polynomials using a weight function. 60 | + [demos/demo6.py](demos/demo6.py): Legendre polynomials using a weight function. 61 | + [demos/demo7.pv](demos/demo7.py): Legendre polynomials using ``scipy.stats.uniform()``. 62 | + [demos/demo8.pv](demos/demo8.py): Hermite polynomials using ``scipy.stats.norm()``. 63 | + [demos/demo9.pv](demos/demo9.py): Shifted Hermite polynomials using a non-standard ``scipy.stats.norm()``. 64 | + [demos/demo10.py](demos/demo10.py): Orthogonal polynomials with respect to a truncated normal. 65 | + [demos/demo11.py](demos/demo11.py): 2D orthogonal polynomials using the ``ProductBasis`` class and a collection of ``scipy.stats`` random variables. 66 | 67 | 68 | TODO 69 | ---- 70 | 71 | This is a list of things that need to be done: 72 | + Implement the method ``orthopol.ProductBasis.d()`` that calculates the 73 | derivative of a product basis of polynomials with respect to x. 74 | -------------------------------------------------------------------------------- /demos/demo1.py: -------------------------------------------------------------------------------- 1 | """ 2 | Generates a univariate Hermite polynomials. 3 | 4 | This demo demonstrates how to: 5 | + Construct a set of orthogonal univariate polynomials given a weight 6 | function. 7 | + Examine certain properties of a univariate polynomial. 8 | + Evaluate the polynomials at one or more points. 9 | + Evaluate the derivatives of the polynomials at one or more points. 10 | 11 | Author: 12 | Ilias Bilionis 13 | 14 | Date: 15 | 3/18/2014 16 | """ 17 | 18 | 19 | import orthpol 20 | import math 21 | import numpy as np 22 | import matplotlib.pyplot as plt 23 | 24 | 25 | # The desired degree 26 | degree = 4 27 | 28 | # The first way of doing it is by directly supplying the weight function. 29 | wf = lambda(x): 1. / math.sqrt(2. * math.pi) * np.exp(-x ** 2 / 2.) 30 | # Construct it: 31 | p = orthpol.OrthogonalPolynomial(degree, 32 | left=-np.inf, right=np.inf, # Domain 33 | wf=wf) 34 | # An orthogonal polynomial is though of as a function. 35 | # Here is how to get the number of inputs and outputs of that function 36 | print 'Number of inputs:', p.num_input 37 | print 'Number of outputs:', p.num_output 38 | # Test if the polynomials are normalized (i.e., their norm is 1.): 39 | print 'Is normalized:', p.is_normalized 40 | # Get the degree of the polynomial: 41 | print 'Polynomial degree:', p.degree 42 | # Get the alpha-beta recursion coefficients: 43 | print 'Alpha:', p.alpha 44 | print 'Beta:', p.beta 45 | # The following should print a description of the polynomial 46 | print str(p) 47 | # Now you can evaluate the polynomial at any points you want: 48 | X = np.linspace(-2., 2., 100) 49 | # Here is the actual evaluation 50 | phi = p(X) 51 | # Phi should be a 100x11 matrix: phi(i, j) = poly(i, X[j]) 52 | # Let's plot them 53 | plt.plot(X, phi) 54 | plt.title('Hermite Polynomials', fontsize=16) 55 | plt.xlabel('$x$', fontsize=16) 56 | plt.ylabel('$p_i(x)$', fontsize=16) 57 | plt.legend(['$p_{%d}(x)$' % i for i in range(p.num_output)], loc='best') 58 | print 'Close the window to continue...' 59 | plt.show() 60 | # You may also compute the derivatives of the polynomials: 61 | dphi = p.d(X) 62 | # Let's plot them also 63 | plt.plot(X, dphi) 64 | plt.title('Derivatives of Hermite Polynomials', fontsize=16) 65 | plt.xlabel('$x$', fontsize=16) 66 | plt.ylabel(r'$\frac{dp_i(x)}{dx}$', fontsize=16) 67 | plt.legend([r'$\frac{p_{%d}(x)}{dx}$' % i for i in range(p.num_output)], loc='best') 68 | print 'Close the window to end demo...' 69 | plt.show() 70 | -------------------------------------------------------------------------------- /demos/demo10.py: -------------------------------------------------------------------------------- 1 | """ 2 | Generate the orthogonal polynomials using a scipy.stats random variable. 3 | This particular demo generates polynomials orthogonal with respect to a 4 | truncated normal distribution. 5 | 6 | This demo demonstrates how to: 7 | + Construct a set of orthogonal univariate polynomials given a scipy.stats 8 | random variable. 9 | + Examine certain properties of a univariate polynomial. 10 | + Evaluate the polynomials at one or more points. 11 | + Evaluate the derivatives of the polynomials at one or more points. 12 | 13 | Author: 14 | Ilias Bilionis 15 | 16 | Date: 17 | 3/18/2014 18 | """ 19 | 20 | 21 | import orthpol 22 | import math 23 | import numpy as np 24 | import matplotlib.pyplot as plt 25 | import scipy.stats 26 | 27 | 28 | # The desired degree 29 | degree = 4 30 | 31 | # The upper and lower cutoffs: 32 | lower = 0. 33 | upper = 2. 34 | # The first way of doing it is write down the random variable: 35 | rv = scipy.stats.truncnorm(lower, upper) 36 | # Construct it: 37 | p = orthpol.OrthogonalPolynomial(degree, rv=rv) 38 | # An orthogonal polynomial is though of as a function. 39 | # Here is how to get the number of inputs and outputs of that function 40 | print 'Number of inputs:', p.num_input 41 | print 'Number of outputs:', p.num_output 42 | # Test if the polynomials are normalized (i.e., their norm is 1.): 43 | print 'Is normalized:', p.is_normalized 44 | # Get the degree of the polynomial: 45 | print 'Polynomial degree:', p.degree 46 | # Get the alpha-beta recursion coefficients: 47 | print 'Alpha:', p.alpha 48 | print 'Beta:', p.beta 49 | # The following should print a description of the polynomial 50 | print str(p) 51 | # Now you can evaluate the polynomial at any points you want: 52 | X = np.linspace(lower, upper, 100) 53 | # Here is the actual evaluation 54 | phi = p(X) 55 | # Phi should be a 100x11 matrix: phi(i, j) = poly(i, X[j]) 56 | # Let's plot them 57 | plt.plot(X, phi) 58 | plt.title('Truncated Normal Polynomials', fontsize=16) 59 | plt.xlabel('$x$', fontsize=16) 60 | plt.ylabel('$p_i(x)$', fontsize=16) 61 | plt.legend(['$p_{%d}(x)$' % i for i in range(p.num_output)], loc='best') 62 | print 'Close the window to continue...' 63 | plt.show() 64 | # You may also compute the derivatives of the polynomials: 65 | dphi = p.d(X) 66 | # Let's plot them also 67 | plt.plot(X, dphi) 68 | plt.title('Derivatives of Truncated Normal Polynomials', fontsize=16) 69 | plt.xlabel('$x$', fontsize=16) 70 | plt.ylabel(r'$\frac{dp_i(x)}{dx}$', fontsize=16) 71 | plt.legend([r'$\frac{p_{%d}(x)}{dx}$' % i for i in range(p.num_output)], loc='best') 72 | print 'Close the window to end demo...' 73 | plt.show() 74 | -------------------------------------------------------------------------------- /demos/demo11.py: -------------------------------------------------------------------------------- 1 | """ 2 | Demonstration of the construction of multivariate orthogonal polynomials. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | """ 10 | 11 | 12 | import orthpol 13 | import math 14 | import numpy as np 15 | import scipy.stats 16 | import matplotlib.pyplot as plt 17 | 18 | # The desired degree 19 | degree = 4 20 | 21 | # We are going to do it in two dimensions 22 | # First define two random variables and put them in a list 23 | # Here we use a uniform and a normal 24 | rvs = [scipy.stats.uniform(), scipy.stats.norm()] 25 | # Then construct the product basis 26 | p = orthpol.ProductBasis(degree=degree, rvs=rvs) 27 | # Print info about the polynomials 28 | print str(p) 29 | # Evaluate the polynomials at some points 30 | X = np.hstack([rvs[0].rvs(size=(100, 1)), rvs[1].rvs(size=(100, 1))]) 31 | # Look at the shape of X, it should be 100x2: 32 | print 'X shape:', X.shape 33 | # Evaluate the polynomials at X 34 | phi = p(X) 35 | # Look at the shape of phi, it should be 100xp.num_output 36 | print 'phi shape:', phi.shape 37 | # Take a look at the phi's also 38 | print 'phi:' 39 | print phi 40 | -------------------------------------------------------------------------------- /demos/demo2.py: -------------------------------------------------------------------------------- 1 | """ 2 | Same as demo1.py, but generates the Laguerre polynomials. 3 | 4 | This demo demonstrates how to: 5 | + Construct a set of orthogonal univariate polynomials given a weight 6 | function. 7 | + Examine certain properties of a univariate polynomial. 8 | + Evaluate the polynomials at one or more points. 9 | + Evaluate the derivatives of the polynomials at one or more points. 10 | 11 | Author: 12 | Ilias Bilionis 13 | 14 | Date: 15 | 3/18/2014 16 | """ 17 | 18 | 19 | import orthpol 20 | import math 21 | import numpy as np 22 | import matplotlib.pyplot as plt 23 | 24 | 25 | # The desired degree 26 | degree = 4 27 | 28 | # The first way of doing it is by directly supplying the weight function. 29 | wf = lambda(x): np.exp(-x) 30 | # Construct it: 31 | p = orthpol.OrthogonalPolynomial(degree, 32 | left=0, right=np.inf, # Domain 33 | wf=wf) 34 | # An orthogonal polynomial is though of as a function. 35 | # Here is how to get the number of inputs and outputs of that function 36 | print 'Number of inputs:', p.num_input 37 | print 'Number of outputs:', p.num_output 38 | # Test if the polynomials are normalized (i.e., their norm is 1.): 39 | print 'Is normalized:', p.is_normalized 40 | # Get the degree of the polynomial: 41 | print 'Polynomial degree:', p.degree 42 | # Get the alpha-beta recursion coefficients: 43 | print 'Alpha:', p.alpha 44 | print 'Beta:', p.beta 45 | # The following should print a description of the polynomial 46 | print str(p) 47 | # Now you can evaluate the polynomial at any points you want: 48 | X = np.linspace(0., 2., 100) 49 | # Here is the actual evaluation 50 | phi = p(X) 51 | # Phi should be a 100x11 matrix: phi(i, j) = poly(i, X[j]) 52 | # Let's plot them 53 | plt.plot(X, phi) 54 | plt.title('Laguerre Polynomials', fontsize=16) 55 | plt.xlabel('$x$', fontsize=16) 56 | plt.ylabel('$p_i(x)$', fontsize=16) 57 | plt.legend(['$p_{%d}(x)$' % i for i in range(p.num_output)], loc='best') 58 | print 'Close the window to continue...' 59 | plt.show() 60 | # You may also compute the derivatives of the polynomials: 61 | dphi = p.d(X) 62 | # Let's plot them also 63 | plt.plot(X, dphi) 64 | plt.title('Derivatives of Laguerre Polynomials', fontsize=16) 65 | plt.xlabel('$x$', fontsize=16) 66 | plt.ylabel(r'$\frac{dp_i(x)}{dx}$', fontsize=16) 67 | plt.legend([r'$\frac{p_{%d}(x)}{dx}$' % i for i in range(p.num_output)], loc='best') 68 | print 'Close the window to end demo...' 69 | plt.show() 70 | -------------------------------------------------------------------------------- /demos/demo3.py: -------------------------------------------------------------------------------- 1 | """ 2 | Same as demo1.py, but generates the Chebyshev polynomials. 3 | 4 | This demo demonstrates how to: 5 | + Construct a set of orthogonal univariate polynomials given a weight 6 | function. 7 | + Examine certain properties of a univariate polynomial. 8 | + Evaluate the polynomials at one or more points. 9 | + Evaluate the derivatives of the polynomials at one or more points. 10 | 11 | Author: 12 | Ilias Bilionis 13 | 14 | Date: 15 | 3/18/2014 16 | """ 17 | 18 | 19 | import orthpol 20 | import math 21 | import numpy as np 22 | import matplotlib.pyplot as plt 23 | 24 | 25 | # The desired degree 26 | degree = 4 27 | 28 | # The first way of doing it is by directly supplying the weight function. 29 | wf = lambda(x): 1. / np.sqrt(1. - x) 30 | # Construct it: 31 | p = orthpol.OrthogonalPolynomial(degree, 32 | left=-1., right=1., # Domain 33 | wf=wf) 34 | # An orthogonal polynomial is though of as a function. 35 | # Here is how to get the number of inputs and outputs of that function 36 | print 'Number of inputs:', p.num_input 37 | print 'Number of outputs:', p.num_output 38 | # Test if the polynomials are normalized (i.e., their norm is 1.): 39 | print 'Is normalized:', p.is_normalized 40 | # Get the degree of the polynomial: 41 | print 'Polynomial degree:', p.degree 42 | # Get the alpha-beta recursion coefficients: 43 | print 'Alpha:', p.alpha 44 | print 'Beta:', p.beta 45 | # The following should print a description of the polynomial 46 | print str(p) 47 | # Now you can evaluate the polynomial at any points you want: 48 | X = np.linspace(-1., 1., 100) 49 | # Here is the actual evaluation 50 | phi = p(X) 51 | # Phi should be a 100x11 matrix: phi(i, j) = poly(i, X[j]) 52 | # Let's plot them 53 | plt.plot(X, phi) 54 | plt.title('Chebyshev Polynomials', fontsize=16) 55 | plt.xlabel('$x$', fontsize=16) 56 | plt.ylabel('$p_i(x)$', fontsize=16) 57 | plt.legend(['$p_{%d}(x)$' % i for i in range(p.num_output)], loc='best') 58 | print 'Close the window to continue...' 59 | plt.show() 60 | # You may also compute the derivatives of the polynomials: 61 | dphi = p.d(X) 62 | # Let's plot them also 63 | plt.plot(X, dphi) 64 | plt.title('Derivatives of Chebyshev Polynomials', fontsize=16) 65 | plt.xlabel('$x$', fontsize=16) 66 | plt.ylabel(r'$\frac{dp_i(x)}{dx}$', fontsize=16) 67 | plt.legend([r'$\frac{p_{%d}(x)}{dx}$' % i for i in range(p.num_output)], loc='best') 68 | print 'Close the window to end demo...' 69 | plt.show() 70 | -------------------------------------------------------------------------------- /demos/demo4.py: -------------------------------------------------------------------------------- 1 | """ 2 | Same as demo1.py, but generates the Gegenbauer polynomials. 3 | 4 | This demo demonstrates how to: 5 | + Construct a set of orthogonal univariate polynomials given a weight 6 | function. 7 | + Examine certain properties of a univariate polynomial. 8 | + Evaluate the polynomials at one or more points. 9 | + Evaluate the derivatives of the polynomials at one or more points. 10 | 11 | Author: 12 | Ilias Bilionis 13 | 14 | Date: 15 | 3/18/2014 16 | """ 17 | 18 | 19 | import orthpol 20 | import math 21 | import numpy as np 22 | import matplotlib.pyplot as plt 23 | 24 | 25 | # The desired degree 26 | degree = 4 27 | 28 | # Pick the alpha and beta of the Gegenbauer polynomials 29 | alpha = .5 30 | # The first way of doing it is by directly supplying the weight function. 31 | wf = lambda(x): (1. - x ** 2.) ** (alpha - 0.5) 32 | # Construct it: 33 | p = orthpol.OrthogonalPolynomial(degree, 34 | left=-1., right=1., # Domain 35 | wf=wf) 36 | # An orthogonal polynomial is though of as a function. 37 | # Here is how to get the number of inputs and outputs of that function 38 | print 'Number of inputs:', p.num_input 39 | print 'Number of outputs:', p.num_output 40 | # Test if the polynomials are normalized (i.e., their norm is 1.): 41 | print 'Is normalized:', p.is_normalized 42 | # Get the degree of the polynomial: 43 | print 'Polynomial degree:', p.degree 44 | # Get the alpha-beta recursion coefficients: 45 | print 'Alpha:', p.alpha 46 | print 'Beta:', p.beta 47 | # The following should print a description of the polynomial 48 | print str(p) 49 | # Now you can evaluate the polynomial at any points you want: 50 | X = np.linspace(-1., 1., 100) 51 | # Here is the actual evaluation 52 | phi = p(X) 53 | # Phi should be a 100x11 matrix: phi(i, j) = poly(i, X[j]) 54 | # Let's plot them 55 | plt.plot(X, phi) 56 | plt.title('Gegenbauer Polynomials', fontsize=16) 57 | plt.xlabel('$x$', fontsize=16) 58 | plt.ylabel('$p_i(x)$', fontsize=16) 59 | plt.legend(['$p_{%d}(x)$' % i for i in range(p.num_output)], loc='best') 60 | print 'Close the window to continue...' 61 | plt.show() 62 | # You may also compute the derivatives of the polynomials: 63 | dphi = p.d(X) 64 | # Let's plot them also 65 | plt.plot(X, dphi) 66 | plt.title('Derivatives of Gegenbauer Polynomials', fontsize=16) 67 | plt.xlabel('$x$', fontsize=16) 68 | plt.ylabel(r'$\frac{dp_i(x)}{dx}$', fontsize=16) 69 | plt.legend([r'$\frac{p_{%d}(x)}{dx}$' % i for i in range(p.num_output)], loc='best') 70 | print 'Close the window to end demo...' 71 | plt.show() 72 | -------------------------------------------------------------------------------- /demos/demo5.py: -------------------------------------------------------------------------------- 1 | """ 2 | Same as demo1.py, but generates the Jacobi polynomials. 3 | 4 | This demo demonstrates how to: 5 | + Construct a set of orthogonal univariate polynomials given a weight 6 | function. 7 | + Examine certain properties of a univariate polynomial. 8 | + Evaluate the polynomials at one or more points. 9 | + Evaluate the derivatives of the polynomials at one or more points. 10 | 11 | Author: 12 | Ilias Bilionis 13 | 14 | Date: 15 | 3/18/2014 16 | """ 17 | 18 | 19 | import orthpol 20 | import math 21 | import numpy as np 22 | import matplotlib.pyplot as plt 23 | 24 | 25 | # The desired degree 26 | degree = 4 27 | 28 | # Pick the alpha and beta of the Jacobi polynomial 29 | alpha = 2. 30 | beta = 5. 31 | # The first way of doing it is by directly supplying the weight function. 32 | wf = lambda(x): (1. - x) ** alpha * (1 + x) ** beta 33 | # Construct it: 34 | p = orthpol.OrthogonalPolynomial(degree, 35 | left=-1., right=1., # Domain 36 | wf=wf) 37 | # An orthogonal polynomial is though of as a function. 38 | # Here is how to get the number of inputs and outputs of that function 39 | print 'Number of inputs:', p.num_input 40 | print 'Number of outputs:', p.num_output 41 | # Test if the polynomials are normalized (i.e., their norm is 1.): 42 | print 'Is normalized:', p.is_normalized 43 | # Get the degree of the polynomial: 44 | print 'Polynomial degree:', p.degree 45 | # Get the alpha-beta recursion coefficients: 46 | print 'Alpha:', p.alpha 47 | print 'Beta:', p.beta 48 | # The following should print a description of the polynomial 49 | print str(p) 50 | # Now you can evaluate the polynomial at any points you want: 51 | X = np.linspace(-1., 1., 100) 52 | # Here is the actual evaluation 53 | phi = p(X) 54 | # Phi should be a 100x11 matrix: phi(i, j) = poly(i, X[j]) 55 | # Let's plot them 56 | plt.plot(X, phi) 57 | plt.title('Jacobi Polynomials', fontsize=16) 58 | plt.xlabel('$x$', fontsize=16) 59 | plt.ylabel('$p_i(x)$', fontsize=16) 60 | plt.legend(['$p_{%d}(x)$' % i for i in range(p.num_output)], loc='best') 61 | print 'Close the window to continue...' 62 | plt.show() 63 | # You may also compute the derivatives of the polynomials: 64 | dphi = p.d(X) 65 | # Let's plot them also 66 | plt.plot(X, dphi) 67 | plt.title('Derivatives of Jacobi Polynomials', fontsize=16) 68 | plt.xlabel('$x$', fontsize=16) 69 | plt.ylabel(r'$\frac{dp_i(x)}{dx}$', fontsize=16) 70 | plt.legend([r'$\frac{p_{%d}(x)}{dx}$' % i for i in range(p.num_output)], loc='best') 71 | print 'Close the window to end demo...' 72 | plt.show() 73 | -------------------------------------------------------------------------------- /demos/demo6.py: -------------------------------------------------------------------------------- 1 | """ 2 | Same as demo1.py, but generates the Legendre polynomials. 3 | 4 | This demo demonstrates how to: 5 | + Construct a set of orthogonal univariate polynomials given a weight 6 | function. 7 | + Examine certain properties of a univariate polynomial. 8 | + Evaluate the polynomials at one or more points. 9 | + Evaluate the derivatives of the polynomials at one or more points. 10 | 11 | Author: 12 | Ilias Bilionis 13 | 14 | Date: 15 | 3/18/2014 16 | """ 17 | 18 | 19 | import orthpol 20 | import math 21 | import numpy as np 22 | import matplotlib.pyplot as plt 23 | 24 | 25 | # The desired degree 26 | degree = 4 27 | 28 | # The first way of doing it is by directly supplying the weight function 29 | wf = lambda(x): 1. 30 | # Construct it: 31 | p = orthpol.OrthogonalPolynomial(degree, 32 | left=0., right=1., # Domain 33 | wf=wf) 34 | # An orthogonal polynomial is though of as a function. 35 | # Here is how to get the number of inputs and outputs of that function 36 | print 'Number of inputs:', p.num_input 37 | print 'Number of outputs:', p.num_output 38 | # Test if the polynomials are normalized (i.e., their norm is 1.): 39 | print 'Is normalized:', p.is_normalized 40 | # Get the degree of the polynomial: 41 | print 'Polynomial degree:', p.degree 42 | # Get the alpha-beta recursion coefficients: 43 | print 'Alpha:', p.alpha 44 | print 'Beta:', p.beta 45 | # The following should print a description of the polynomial 46 | print str(p) 47 | # Now you can evaluate the polynomial at any points you want: 48 | X = np.linspace(0., 1., 100) 49 | # Here is the actual evaluation 50 | phi = p(X) 51 | # Phi should be a 100x11 matrix: phi(i, j) = poly(i, X[j]) 52 | # Let's plot them 53 | plt.plot(X, phi) 54 | plt.title('Legendre Polynomials', fontsize=16) 55 | plt.xlabel('$x$', fontsize=16) 56 | plt.ylabel('$p_i(x)$', fontsize=16) 57 | plt.legend(['$p_{%d}(x)$' % i for i in range(p.num_output)], loc='best') 58 | print 'Close the window to continue...' 59 | plt.show() 60 | # You may also compute the derivatives of the polynomials: 61 | dphi = p.d(X) 62 | # Let's plot them also 63 | plt.plot(X, dphi) 64 | plt.title('Derivatives of Legendre Polynomials', fontsize=16) 65 | plt.xlabel('$x$', fontsize=16) 66 | plt.ylabel(r'$\frac{dp_i(x)}{dx}$', fontsize=16) 67 | plt.legend([r'$\frac{p_{%d}(x)}{dx}$' % i for i in range(p.num_output)], loc='best') 68 | print 'Close the window to end demo...' 69 | plt.show() 70 | -------------------------------------------------------------------------------- /demos/demo7.py: -------------------------------------------------------------------------------- 1 | """ 2 | Generate the Legendre polynomials using a scipy.stats random variable. 3 | This particular demo generates the Legendre polynomials. 4 | 5 | This demo demonstrates how to: 6 | + Construct a set of orthogonal univariate polynomials given a scipy.stats 7 | random variable. 8 | + Examine certain properties of a univariate polynomial. 9 | + Evaluate the polynomials at one or more points. 10 | + Evaluate the derivatives of the polynomials at one or more points. 11 | 12 | Author: 13 | Ilias Bilionis 14 | 15 | Date: 16 | 3/18/2014 17 | """ 18 | 19 | 20 | import orthpol 21 | import math 22 | import numpy as np 23 | import matplotlib.pyplot as plt 24 | import scipy.stats 25 | 26 | 27 | # The desired degree 28 | degree = 4 29 | 30 | # The first way of doing it is write down the random variable: 31 | rv = scipy.stats.uniform() 32 | # Construct it: 33 | p = orthpol.OrthogonalPolynomial(degree, rv=rv) 34 | # An orthogonal polynomial is though of as a function. 35 | # Here is how to get the number of inputs and outputs of that function 36 | print 'Number of inputs:', p.num_input 37 | print 'Number of outputs:', p.num_output 38 | # Test if the polynomials are normalized (i.e., their norm is 1.): 39 | print 'Is normalized:', p.is_normalized 40 | # Get the degree of the polynomial: 41 | print 'Polynomial degree:', p.degree 42 | # Get the alpha-beta recursion coefficients: 43 | print 'Alpha:', p.alpha 44 | print 'Beta:', p.beta 45 | # The following should print a description of the polynomial 46 | print str(p) 47 | # Now you can evaluate the polynomial at any points you want: 48 | X = np.linspace(0., 1., 100) 49 | # Here is the actual evaluation 50 | phi = p(X) 51 | # Phi should be a 100x11 matrix: phi(i, j) = poly(i, X[j]) 52 | # Let's plot them 53 | plt.plot(X, phi) 54 | plt.title('Legendre Polynomials', fontsize=16) 55 | plt.xlabel('$x$', fontsize=16) 56 | plt.ylabel('$p_i(x)$', fontsize=16) 57 | plt.legend(['$p_{%d}(x)$' % i for i in range(p.num_output)], loc='best') 58 | print 'Close the window to continue...' 59 | plt.show() 60 | # You may also compute the derivatives of the polynomials: 61 | dphi = p.d(X) 62 | # Let's plot them also 63 | plt.plot(X, dphi) 64 | plt.title('Derivatives of Legendre Polynomials', fontsize=16) 65 | plt.xlabel('$x$', fontsize=16) 66 | plt.ylabel(r'$\frac{dp_i(x)}{dx}$', fontsize=16) 67 | plt.legend([r'$\frac{p_{%d}(x)}{dx}$' % i for i in range(p.num_output)], loc='best') 68 | print 'Close the window to end demo...' 69 | plt.show() 70 | -------------------------------------------------------------------------------- /demos/demo8.py: -------------------------------------------------------------------------------- 1 | """ 2 | Generate the Hermite polynomials using a scipy.stats random variable. 3 | This particular demo generates the Hermite polynomials. 4 | 5 | This demo demonstrates how to: 6 | + Construct a set of orthogonal univariate polynomials given a scipy.stats 7 | random variable. 8 | + Examine certain properties of a univariate polynomial. 9 | + Evaluate the polynomials at one or more points. 10 | + Evaluate the derivatives of the polynomials at one or more points. 11 | 12 | Author: 13 | Ilias Bilionis 14 | 15 | Date: 16 | 3/18/2014 17 | """ 18 | 19 | 20 | import orthpol 21 | import math 22 | import numpy as np 23 | import matplotlib.pyplot as plt 24 | import scipy.stats 25 | 26 | 27 | # The desired degree 28 | degree = 4 29 | 30 | # The first way of doing it is write down the random variable: 31 | rv = scipy.stats.norm() 32 | # Construct it: 33 | p = orthpol.OrthogonalPolynomial(degree, rv=rv) 34 | # An orthogonal polynomial is though of as a function. 35 | # Here is how to get the number of inputs and outputs of that function 36 | print 'Number of inputs:', p.num_input 37 | print 'Number of outputs:', p.num_output 38 | # Test if the polynomials are normalized (i.e., their norm is 1.): 39 | print 'Is normalized:', p.is_normalized 40 | # Get the degree of the polynomial: 41 | print 'Polynomial degree:', p.degree 42 | # Get the alpha-beta recursion coefficients: 43 | print 'Alpha:', p.alpha 44 | print 'Beta:', p.beta 45 | # The following should print a description of the polynomial 46 | print str(p) 47 | # Now you can evaluate the polynomial at any points you want: 48 | X = np.linspace(-2., 2., 100) 49 | # Here is the actual evaluation 50 | phi = p(X) 51 | # Phi should be a 100x11 matrix: phi(i, j) = poly(i, X[j]) 52 | # Let's plot them 53 | plt.plot(X, phi) 54 | plt.title('Hermite Polynomials', fontsize=16) 55 | plt.xlabel('$x$', fontsize=16) 56 | plt.ylabel('$p_i(x)$', fontsize=16) 57 | plt.legend(['$p_{%d}(x)$' % i for i in range(p.num_output)], loc='best') 58 | print 'Close the window to continue...' 59 | plt.show() 60 | # You may also compute the derivatives of the polynomials: 61 | dphi = p.d(X) 62 | # Let's plot them also 63 | plt.plot(X, dphi) 64 | plt.title('Derivatives of Hermite Polynomials', fontsize=16) 65 | plt.xlabel('$x$', fontsize=16) 66 | plt.ylabel(r'$\frac{dp_i(x)}{dx}$', fontsize=16) 67 | plt.legend([r'$\frac{p_{%d}(x)}{dx}$' % i for i in range(p.num_output)], loc='best') 68 | print 'Close the window to end demo...' 69 | plt.show() 70 | -------------------------------------------------------------------------------- /demos/demo9.py: -------------------------------------------------------------------------------- 1 | """ 2 | Generate the Shifted Hermite polynomials using a scipy.stats random variable. 3 | This particular demo generates the Shifted Hermite polynomials. 4 | 5 | This demo demonstrates how to: 6 | + Construct a set of orthogonal univariate polynomials given a scipy.stats 7 | random variable. 8 | + Examine certain properties of a univariate polynomial. 9 | + Evaluate the polynomials at one or more points. 10 | + Evaluate the derivatives of the polynomials at one or more points. 11 | 12 | Author: 13 | Ilias Bilionis 14 | 15 | Date: 16 | 3/18/2014 17 | """ 18 | 19 | 20 | import orthpol 21 | import math 22 | import numpy as np 23 | import matplotlib.pyplot as plt 24 | import scipy.stats 25 | 26 | 27 | # The desired degree 28 | degree = 4 29 | 30 | # The first way of doing it is write down the random variable: 31 | rv = scipy.stats.norm(loc=-5., scale=2.5) 32 | # Construct it: 33 | p = orthpol.OrthogonalPolynomial(degree, rv=rv) 34 | # An orthogonal polynomial is though of as a function. 35 | # Here is how to get the number of inputs and outputs of that function 36 | print 'Number of inputs:', p.num_input 37 | print 'Number of outputs:', p.num_output 38 | # Test if the polynomials are normalized (i.e., their norm is 1.): 39 | print 'Is normalized:', p.is_normalized 40 | # Get the degree of the polynomial: 41 | print 'Polynomial degree:', p.degree 42 | # Get the alpha-beta recursion coefficients: 43 | print 'Alpha:', p.alpha 44 | print 'Beta:', p.beta 45 | # The following should print a description of the polynomial 46 | print str(p) 47 | # Now you can evaluate the polynomial at any points you want: 48 | X = np.linspace(-9., -1., 100) 49 | # Here is the actual evaluation 50 | phi = p(X) 51 | # Phi should be a 100x11 matrix: phi(i, j) = poly(i, X[j]) 52 | # Let's plot them 53 | plt.plot(X, phi) 54 | plt.title('Shifted Hermite Polynomials', fontsize=16) 55 | plt.xlabel('$x$', fontsize=16) 56 | plt.ylabel('$p_i(x)$', fontsize=16) 57 | plt.legend(['$p_{%d}(x)$' % i for i in range(p.num_output)], loc='best') 58 | print 'Close the window to continue...' 59 | plt.show() 60 | # You may also compute the derivatives of the polynomials: 61 | dphi = p.d(X) 62 | # Let's plot them also 63 | plt.plot(X, dphi) 64 | plt.title('Derivatives of Shifted Hermite Polynomials', fontsize=16) 65 | plt.xlabel('$x$', fontsize=16) 66 | plt.ylabel(r'$\frac{dp_i(x)}{dx}$', fontsize=16) 67 | plt.legend([r'$\frac{p_{%d}(x)}{dx}$' % i for i in range(p.num_output)], loc='best') 68 | print 'Close the window to end demo...' 69 | plt.show() 70 | -------------------------------------------------------------------------------- /orthpol/__init__.py: -------------------------------------------------------------------------------- 1 | """Generalized Polynomial Chaos Module 2 | 3 | Author: 4 | Ilias Bilionis 5 | 6 | Date: 7 | 8/10/2013 8 | """ 9 | 10 | 11 | __all__ = ['OrthogonalPolynomial', 'ProductBasis', 'QuadratureRule'] 12 | 13 | 14 | import _orthpol 15 | from ._quadrature_rule import * 16 | from ._orthogonal_polynomial import * 17 | -------------------------------------------------------------------------------- /orthpol/_lancz.py: -------------------------------------------------------------------------------- 1 | """ 2 | 3 | Author: 4 | Ilias Bilionis 5 | 6 | Date: 7 | 7/25/2013 8 | """ 9 | 10 | 11 | __all__ = ['lancz'] 12 | 13 | 14 | import numpy as np 15 | import _orthpol as orthpol 16 | 17 | 18 | def lancz(x, w, n): 19 | """The Lanczos procedure for constructing the recurcive formula 20 | for orthogonal polynomials. 21 | 22 | Wrapper from ORTHPOL. 23 | """ 24 | if x.dtype == 'float32': 25 | func = orthpol.slancz 26 | else: 27 | func = orthpol.dlancz 28 | alpha, beta, ierr = func(n, x, w) 29 | assert ierr == 0 30 | return alpha, beta 31 | 32 | 33 | if __name__ == '__main__': 34 | x = np.linspace(0., 1, 100) 35 | w = np.ones(100) 36 | print x, w 37 | alpha, beta = lancz(x, w, 10) 38 | print alpha 39 | print beta 40 | -------------------------------------------------------------------------------- /orthpol/_orthogonal_polynomial.py: -------------------------------------------------------------------------------- 1 | """ 2 | Describes an orthogonal polynomial. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 7/25/2013 9 | """ 10 | 11 | 12 | __all__ = ['OrthogonalPolynomial', 'ProductBasis'] 13 | 14 | 15 | import numpy as np 16 | import math 17 | import itertools 18 | from ._quadrature_rule import * 19 | from ._lancz import * 20 | import _orthpol as orthpol 21 | 22 | 23 | class OrthogonalPolynomial(object): 24 | 25 | """1D Orthogonal Polynomial via recursive relation. 26 | 27 | A polynomial is of course a function. 28 | """ 29 | 30 | # Recurrence coefficient alpha 31 | _alpha = None 32 | 33 | # Recurrence coefficient beta 34 | _beta = None 35 | 36 | # Recurrence coefficient gamma 37 | _gamma = None 38 | 39 | # Is the polynomial normalized 40 | _is_normalized = None 41 | 42 | # The number of inputs 43 | _num_input = None 44 | 45 | # The number of outputs 46 | _num_output = None 47 | 48 | @property 49 | def degree(self): 50 | """Return the degree of the polynomial.""" 51 | return self.alpha.shape[0] - 1 52 | 53 | @property 54 | def alpha(self): 55 | return self._alpha 56 | 57 | @property 58 | def beta(self): 59 | return self._beta 60 | 61 | @property 62 | def gamma(self): 63 | return self._gamma 64 | 65 | @property 66 | def is_normalized(self): 67 | return self._is_normalized 68 | 69 | @property 70 | def num_input(self): 71 | return self._num_input 72 | 73 | @property 74 | def num_output(self): 75 | return self._num_output 76 | 77 | def __init__(self, degree, rv=None, left=-1, right=1, wf=lambda(x): 1., 78 | ncap=50, quad=None, 79 | name='Orthogonal Polynomial'): 80 | """Construct the polynomial. 81 | 82 | Keyword Arguments: 83 | rv --- If not None, then it is assumed to be a 84 | RandomVariable object which used to define 85 | the support interval and the pdf. 86 | degree --- The degree of the polynomial. 87 | left --- The left end of the interval. 88 | right --- The right end of the interval. 89 | wf --- The weight function. The default is the identity. 90 | ncap --- The number of quadrature points. 91 | quad --- A quadrature rule you might want to use in 92 | case you are not satisfied with the default 93 | one. 94 | name --- A name for the polynomial. 95 | """ 96 | self.__name__ = name 97 | if rv is not None: 98 | left, right = rv.interval(1) 99 | wf = rv.pdf 100 | if quad is None: 101 | quad = QuadratureRule(left=left, right=right, wf=wf, ncap=ncap) 102 | self._alpha, self._beta = lancz(quad.x, quad.w, degree + 1) 103 | self._gamma = np.ones(self.degree + 1, dtype='float64') 104 | self.normalize() 105 | self._num_input = 1 106 | self._num_output = self.degree + 1 107 | 108 | def __call__(self, x): 109 | """Evaluate the function at x.""" 110 | return orthpol.poly_eval_all(x, self.alpha, self.beta, self.gamma) 111 | 112 | def d(self, x): 113 | return orthpol.poly_deval_all(x, self.alpha, self.beta, self.gamma) 114 | 115 | def _eval(self, x): 116 | """Evaluate the polynomial basis at x.""" 117 | return orthpol.poly_eval(x, self.alpha, self.beta, self.gamma) 118 | 119 | def _d_eval(self, x): 120 | """Evaluate the derivative of the polynomial. 121 | 122 | Arguments: 123 | x --- The input point(s). 124 | """ 125 | return orthpol.poly_deval(x, self.alpha, self.beta, self.gamma) 126 | 127 | def _evaluate_square_norms(self): 128 | """Evaluate the square norms of the polynomials.""" 129 | s_norm = np.zeros(self.degree + 1) 130 | s_norm[0] = self.beta[0] / (self.gamma[0] ** 2) 131 | for i in range(1, self.degree + 1): 132 | s_norm[i] = (self.beta[i] / self.gamma[i]) * s_norm[i - 1] 133 | return s_norm 134 | 135 | def normalize(self): 136 | """Normalize the polynomials.""" 137 | self._beta, self._gamma = orthpol.poly_normalize(self.beta, self.gamma) 138 | self._is_normalized = True 139 | 140 | def __str__(self): 141 | """Return a string representation of the object.""" 142 | s = self.__name__ + '\n' 143 | s += ' alpha: ' + str(self.alpha) + '\n' 144 | s += ' beta: ' + str(self.beta) + '\n' 145 | s += ' gamma: ' + str(self.gamma) + '\n' 146 | s += ' normalized: ' + str(self.is_normalized) 147 | return s 148 | 149 | 150 | class ProductBasis(object): 151 | 152 | """A multi-input orthogonal polynomial basis.""" 153 | 154 | # A container of polynomials 155 | _polynomials = None 156 | 157 | # The total order of the basis 158 | _degree = None 159 | 160 | # An array of basis terms 161 | _terms = None 162 | 163 | # The number of terms up to each order 164 | _num_terms = None 165 | 166 | # The number of inputs 167 | _num_input = None 168 | 169 | # The number of outputs 170 | _num_output = None 171 | 172 | @property 173 | def polynomials(self): 174 | return self._polynomials 175 | 176 | @property 177 | def degree(self): 178 | return self._degree 179 | 180 | @property 181 | def terms(self): 182 | return self._terms 183 | 184 | @property 185 | def num_terms(self): 186 | return self._num_terms 187 | 188 | @property 189 | def num_input(self): 190 | return self._num_input 191 | 192 | @property 193 | def num_output(self): 194 | return self._num_output 195 | 196 | def __init__(self, rvs=None, degree=1, polynomials=None, ncap=50, 197 | quad=None, name='Product basis'): 198 | """Initialize the object. 199 | 200 | Keyword Argument 201 | rvs --- If not None, then it is assumed to 202 | be a list of random variables. 203 | degree --- The total degree of the basis. Each 204 | one of the polynomials will have this 205 | degree. 206 | polynomials --- We only look at this if rv is None. 207 | A collection of 1D orthogonal 208 | polynomials. 209 | ncap --- The number of quadrature points. 210 | quad --- A quadrature rule you might want to use in 211 | case you are not satisfied with the default 212 | one. 213 | name --- A name for the basis. 214 | """ 215 | self.__name__ = name 216 | assert isinstance(degree, int) 217 | assert degree >= 0 218 | if rvs is not None: 219 | assert isinstance(rvs, list) or isinstance(rvs, tuple) 220 | polynomials = [OrthogonalPolynomial(degree, rv=r, ncap=ncap, 221 | quad=quad) for r in rvs] 222 | assert (isinstance(polynomials, tuple) or 223 | isinstance(polynomials, list)) 224 | for p in polynomials: 225 | assert isinstance(p, OrthogonalPolynomial) 226 | self._polynomials = polynomials 227 | # Find the total order of the basis 228 | self._degree = max([p.degree for p in polynomials]) 229 | # The number of inputs 230 | self._num_input = len(polynomials) 231 | # Compute the basis terms 232 | self._num_output = self._compute_basis_terms() 233 | 234 | def _compute_basis_terms(self): 235 | """Compute the basis terms. 236 | 237 | The following is taken from Stokhos. 238 | 239 | The approach here for ordering the terms is inductive on the total 240 | order p. We get the terms of total order p from the terms of total 241 | order p-1 by incrementing the orders of the first dimension by 1. 242 | We then increment the orders of the second dimension by 1 for all of the 243 | terms whose first dimension order is 0. We then repeat for the third 244 | dimension whose first and second dimension orders are 0, and so on. 245 | How this is done is most easily illustrated by an example of dimension 3: 246 | 247 | Order terms cnt Order terms cnt 248 | 0 0 0 0 4 4 0 0 15 5 1 249 | 3 1 0 250 | 1 1 0 0 3 2 1 3 0 1 251 | 0 1 0 2 2 0 252 | 0 0 1 2 1 1 253 | 2 0 2 254 | 2 2 0 0 6 3 1 1 3 0 255 | 1 1 0 1 2 1 256 | 1 0 1 1 1 2 257 | 0 2 0 1 0 3 258 | 0 1 1 0 4 0 259 | 0 0 2 0 3 1 260 | 0 2 2 261 | 3 3 0 0 10 4 1 0 1 3 262 | 2 1 0 0 0 4 263 | 2 0 1 264 | 1 2 0 265 | 1 1 1 266 | 1 0 2 267 | 0 3 0 268 | 0 2 1 269 | 0 1 2 270 | 0 0 3 271 | """ 272 | # Number of inputs 273 | num_dim = len(self.polynomials) 274 | 275 | # Temporary array of terms grouped in terms of same order 276 | terms_order = [[] for i in range(self.degree + 1)] 277 | 278 | # Store number of terms up to each order 279 | self._num_terms = np.zeros(self.degree + 2, dtype='i') 280 | 281 | # Set order zero 282 | terms_order[0] = ([np.zeros(num_dim, dtype='i')]) 283 | self.num_terms[0] = 1 284 | 285 | # The array cnt stores the number of terms we need to 286 | # increment for each dimension. 287 | cnt = np.zeros(num_dim, dtype='i') 288 | for j, p in itertools.izip(range(num_dim), self.polynomials): 289 | if p.degree >= 1: 290 | cnt[j] = 1 291 | 292 | cnt_next = np.zeros(num_dim, dtype='i') 293 | term = np.zeros(num_dim, dtype='i') 294 | 295 | # Number of basis functions 296 | num_basis = 1 297 | 298 | # Loop over orders 299 | for k in range(1, self.degree + 1): 300 | self.num_terms[k] = self.num_terms[k - 1] 301 | # Stores the inde of the term we are copying 302 | prev = 0 303 | # Loop over dimensions 304 | for j, p in itertools.izip(range(num_dim), self.polynomials): 305 | # Increment orders of cnt[j] terms for dimension j 306 | for i in range(cnt[j]): 307 | if terms_order[k - 1][prev + i][j] < p.degree: 308 | term = terms_order[k - 1][prev + i].copy() 309 | term[j] += 1 310 | terms_order[k].append(term) 311 | num_basis += 1 312 | self.num_terms[k] += 1 313 | for l in range(j + 1): 314 | cnt_next[l] += 1 315 | if j < num_dim - 1: 316 | prev += cnt[j] - cnt[j + 1] 317 | cnt[:] = cnt_next 318 | cnt_next[:] = 0 319 | self.num_terms[self.degree + 1] = num_basis 320 | # Copy into final terms array 321 | self._terms = [] 322 | for k in range(self.degree + 1): 323 | num_k = len(terms_order[k]) 324 | for j in range(num_k): 325 | self._terms.append(terms_order[k][j]) 326 | return num_basis 327 | 328 | def __str__(self): 329 | """Return a string representation of the object.""" 330 | s = self.__name__ + '\n' 331 | s += ' sz = ' + str(self.num_output) + '\n' 332 | for i in range(self.num_output): 333 | s += ' ' + str(i) + ': ' 334 | for j in range(self.num_input): 335 | s += str(self.terms[i][j]) + ' ' 336 | s += '\n' 337 | s += ' num_terms = ' 338 | for i in range(self.degree + 1): 339 | s += str(self.num_terms[i]) + ' ' 340 | return s 341 | 342 | def __call__(self, x): 343 | num_pt = x.shape[0] 344 | basis_eval_tmp = [self.polynomials[j](x[:, j]) 345 | for j in range(self.num_input)] 346 | phi = np.ndarray((num_pt, self.num_output)) 347 | for k in range(self.num_output): 348 | phi[:, k] = 1. 349 | for j in range(self.num_input): 350 | phi[:, k] *= basis_eval_tmp[j][:, self.terms[k][j]] 351 | return phi 352 | 353 | def _eval(self, x, hyp): 354 | """Evaluate the polynomials at x.""" 355 | phi = np.ndarray(self.num_output) 356 | basis_eval_tmp = [[] for j in range(self.num_input)] 357 | for j in range(self.num_input): 358 | basis_eval_tmp[j] = self.polynomials[j](x[j]).flatten() 359 | for k in range(self.num_output): 360 | phi[k] = 1. 361 | for j in range(self.num_input): 362 | phi[k] *= basis_eval_tmp[j][self.terms[k][j]] 363 | return phi 364 | -------------------------------------------------------------------------------- /orthpol/_quadrature_rule.py: -------------------------------------------------------------------------------- 1 | """ 2 | Implements a generic quadrature rule. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 7/25/2013 9 | """ 10 | 11 | 12 | __all__ = ['QuadratureRule'] 13 | 14 | 15 | import numpy as np 16 | import math 17 | import _orthpol as orthpol 18 | 19 | 20 | def symtr(t): 21 | """Implements a tranformation of [-1, 1] to [-Infinity, Infinity]. 22 | 23 | Return: 24 | phi(t) --- The transformation. 25 | dphi(t) --- The derivative of the tranformation. 26 | """ 27 | t2 = t * t 28 | dphi = 1. - t2 29 | phi = t / dphi 30 | dphi *= dphi 31 | dphi = (t2 + 1.) / dphi 32 | return phi, dphi 33 | 34 | 35 | def tr(t): 36 | """Implements a transformation of [-1, 1] to [0, Infinity]. 37 | 38 | Return: 39 | phi(t) --- The transformation. 40 | dphi(t) --- The derivative of the tranformation. 41 | """ 42 | dphi = 1. - t 43 | phi = (1. + t) / dphi 44 | dphi *= dphi 45 | dphi = 2. / dphi 46 | return phi, dphi 47 | 48 | 49 | def fejer(n, dtype='float64'): 50 | """Generate the n-point Fejer quadrature rule.""" 51 | if dtype == 'float64': 52 | func = orthpol.dfejer 53 | else: 54 | func = orthpol.fejer 55 | return func(n) 56 | 57 | 58 | class QuadratureRule(object): 59 | 60 | """An object representing a quadrature rule.""" 61 | 62 | # The quadrature points (N x D) 63 | _x = None 64 | 65 | # The quadrature weights (N x 1) 66 | _w = None 67 | 68 | @property 69 | def x(self): 70 | return self._x 71 | 72 | @property 73 | def w(self): 74 | return self._w 75 | 76 | @property 77 | def num_quad(self): 78 | return self._x.shape[0] 79 | 80 | def __init__(self, left=-1, right=1, wf=lambda(x): 1., ncap=500, 81 | name='Quadrature Rule'): 82 | """Construct a quadrature rule. 83 | 84 | Keyword Arguments 85 | left --- The left end of the interval. 86 | right --- The right end of the interval. 87 | wf --- The weight function. The default is the identity. 88 | ncap --- The number of quadrature points. 89 | name --- A name for the object. 90 | """ 91 | x, w = fejer(ncap) 92 | if wf is None: 93 | wf = lambda(x): np.ones(x.shape) 94 | if math.isinf(left) and math.isinf(right): 95 | phi, dphi = symtr(x) 96 | self._x = phi 97 | elif math.isinf(right): 98 | phi, dphi = tr(x) 99 | self._x = left + phi 100 | elif math.isinf(left): 101 | phi, dphi = tr(-x) 102 | self._x = right - phi 103 | else: 104 | self._x = 0.5 * ((right - left) * x + right + left) 105 | dphi = 0.5 * (right - left) 106 | self._w = w * wf(self.x) * dphi 107 | self.__name__ = name 108 | 109 | def integrate(self, f): 110 | """Integrate the function f. 111 | 112 | When evaluating f(x) with x an N x D matrix, 113 | then f(x) should be an N x Q matrix. 114 | """ 115 | return np.dot(f(self.x).T, self.w) # Q x 1 116 | 117 | def _to_string(self, pad): 118 | """Return a string representation of the object.""" 119 | s = self.__name__ + '\n' 120 | s += pad + ' x: ' + str(self.x) + '\n' 121 | s += pad + ' w: ' + str(self.w) + '\n' 122 | return s 123 | -------------------------------------------------------------------------------- /setup.cfg: -------------------------------------------------------------------------------- 1 | [metadata] 2 | description-file = README.md 3 | -------------------------------------------------------------------------------- /setup.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | 3 | 4 | from numpy.distutils.core import setup 5 | from numpy.distutils.core import Extension 6 | import os 7 | import glob 8 | 9 | 10 | setup(name='py-orthpol', 11 | version='1.1', 12 | description='Construct orthogonal polynomials with respect to arbitrary measures in Python', 13 | author='Ilias Bilionis', 14 | author_email='ibilion@purdue.edu', 15 | url='https://github.com/ebilionis/py-orthpol', 16 | download_url='https://github.com/ebilionis/py-orthpol/tarball/1.1', 17 | keywords=['orthogonal polynomails', 'arbitrary probability measures', 'polynomial chaos', 18 | 'generalized polynomial chaos', 'uncertainty quantification'], 19 | ext_modules=[Extension('orthpol._orthpol', 20 | glob.glob(os.path.join('src', 21 | '*.f')))], 22 | packages=['orthpol']) 23 | -------------------------------------------------------------------------------- /src/README: -------------------------------------------------------------------------------- 1 | 2 | This is a package of routines, called ORTHPOL, for generating 3 | orthogonal polynomials and Gauss-type quadrature rules developed 4 | by Walter Gautschi. A description of the underlying methods can be 5 | found in a companion paper published in ACM Transactions on 6 | Mathematical Software'', vol. 20 (1994), pp.21-62. 7 | 8 | There are files of four kinds in this package: the fortran netlib 9 | programs r1mach,d1mach, generating single- and double-precision 10 | machine constants for a variety of computers (Chapter 0); driver 11 | programs in fortran, called test1.f, test2.f, ... (Chapter 1); files 12 | called test1.out, test2.out, ... containing the output of the 13 | respective drivers when run on the Cyber 205 (Chapter 1); the fortran 14 | subroutines making up the core of the package (Chapters 2 - 6). 15 | 16 | The machine constants highlighted in the netlib programs are those for 17 | the Sun 4/670 MP workstation. If the package is to be run on a different 18 | computer, the Sun machine constants have to be commented out and the 19 | constants appropriate for the particular machine uncommented. 20 | 21 | Structurally, the package is one single UNIX file, which, when given a 22 | name, say package'', can be broken up into its individual component 23 | files by the command 24 | 25 | sh < package 26 | 27 | At the same time, this will create a Makefile which allows the user 28 | to compile and run (on a variety of computers) all test programs by 29 | typing 30 | 31 | make 32 | 33 | or the N-th test by typing 34 | 35 | make testN.out.local 36 | 37 | The output of testN in either case is placed into a file called 38 | testN.out.local. 39 | 40 | On computers which do not support UNIX, the individual files can be 41 | recovered by noting that they each start with a line of the form 42 | 43 | cat < filename 44 | 45 | and end with the line 46 | 47 | C-END-OF-FILE 48 | 49 | To see which files must be assembled to run each test, refer to the 50 | lines starting with 'TESTn = ' in Makefile. 51 | 52 | The following is a brief description of the individual files of the 53 | package. 54 | 55 | r1mach.f a netlib program generating single-precision machine 56 | constants for a variety of computers 57 | 58 | d1mach.f a netlib program generating double-precision machine 59 | constants for a variety of computers 60 | 61 | test1.f relates to Example 3.1 of the companion paper, where 62 | orthogonal polynomials are generated relative to a weight 63 | function on (-1,1) having square root singularities at 64 | 1, -1, 1/omega, -1/omega, with omega between 0 and 1 65 | test1.out contains the output of test1.f 66 | 67 | test2.f relates to Example 3.2, where orthogonal polynomials are 68 | generated relative to a weight function on (0,1) having 69 | a logarithmic singularity at the origin as well as an 70 | algebraic singularity with degree sigma greater than -1 71 | test2.out contains the output of test2.f 72 | 73 | test3.f relates to Example 4.1, implementing Stieltjes's 74 | procedure and the Lanczos algorithm to generate discrete 75 | Legendre polynomials 76 | test3.out contains the output of test3.f 77 | 78 | test4.f relates to Example 4.2, where a discretization procedure 79 | is applied to generate orthogonal polynomials relative 80 | to the Chebyshev weight function plus a constant 81 | test4.out contains the output of test4.f 82 | 83 | test5.f relates to Example 4.3 illustrating the use of a 84 | discretization procedure to generate orthogonal 85 | polynomials relative to the Jacobi weight function with 86 | a mass point of given strength placed at the left end 87 | point 88 | test5.out contains the output of test5.f 89 | 90 | test6.f relates to Example 4.4 implementing a discretization 91 | procedure to generate orthogonal polynomials for the 92 | logistics density function 93 | test6.out contains the output of test6.f 94 | 95 | test7.f relates to Example 4.5 employing a general-purpose 96 | discretization procedure to generate the half-range 97 | Hermite polynomials 98 | test7.out contains the output of test7.f 99 | 100 | test8.f relates to Example 4.6, where Example 3.1 is redone by 101 | means of a discretized modified Chebyshev algorithm 102 | test8.out contains the output of test8.f 103 | 104 | test9.f relates to Example 5.1, redoing Example 3.2 for sigma=1/2, 105 | using a modification algorithm 106 | test9.out contains the output of test9.f 107 | 108 | test10.f relates to Example 5.2, generating induced Legendre 109 | polynomials 110 | test10.out contains the output of test10.f 111 | 112 | test11.f relates to Example 5.3, illustrating the performance of 113 | the routines chri.f and gchri.f (see below) in the 114 | case of the Jacobi weight function multiplied or divided 115 | by a linear and quadratic factor 116 | test11.out contains the output of test11.f 117 | 118 | recur.f a subroutine generating the recursion coefficients of 119 | classical orthogonal polynomials 120 | drecur.f a double-precision version of recur.f 121 | 122 | cheb.f a subroutine implementing the modified Chebyshev 123 | algorithm 124 | dcheb.f a double-precision version of cheb.f 125 | 126 | sti.f a subroutine generating the recursion coefficients of 127 | discrete orthogonal polynomials by Stieltjes's procedure 128 | dsti.f a double-precision version of sti.f 129 | 130 | lancz.f a subroutine generating the recursion coefficients of 131 | discrete orthogonal polynomials by Lanczos's algorithm 132 | dlancz.f a double-precision version of lancz.f 133 | 134 | mcdis.f a subroutine computing the recursion coefficients (to 135 | a given degree of approximation) of continuous and 136 | mixed-type orthogonal polynomials by means of a multi- 137 | component discretization procedure 138 | dmcdis.f a double-precision version of mcdis.f 139 | 140 | qgp.f a general-purpose quadrature routine for use in mcdis.f 141 | or in mccheb.f 142 | 143 | dqgp.f a general-purpose quadrature routine for use in dmcdis.f 144 | or in dmcheb.f 145 | 146 | mccheb.f a subroutine implementing the discretized modified 147 | Chebyshev algorithm whereby modified moments are 148 | approximated by discrete modified moments 149 | dmcheb.f a double-precision version of mccheb.f 150 | 151 | chri.f a subroutine for computing the recursion coefficients of 152 | polynomials orthogonal with respect to a weight function 153 | obtained by a linear or quadratic modification of a given 154 | weight function 155 | dchri.f a double-precision version of chri.f 156 | 157 | knum.f a subroutine which applies a backward recurrence algorithm 158 | to generate weighted integrals of orthogonal polynomials 159 | multiplied by a Cauchy kernel 160 | nu0jac.f auxiliary routines providing an estimate for the starting 161 | nu0lag.f index in the backward recurrence algorithm of knum.f for 162 | nu0her.f respectively the Jacobi, Laguerre and Hermite weights 163 | dknum.f a double-precision version of knum.f 164 | 165 | kern.f a subroutine generating the kernels in the remainder term 166 | of Gauss quadrature rules applied to analytic functions 167 | dkern.f a double-precision version of kern.f 168 | 169 | gchri.f an alternative subroutine (to chri.f) for computing the 170 | recursion coefficients of polynomials orthogonal with 171 | with respect to a weight function obtained by dividing a 172 | given weight function by a linear or quadratic factor 173 | dgchri.f a double-precision version of gchri.f 174 | 175 | gauss.f a subroutine generating Gauss quadrature rules relative 176 | to a given integration measure 177 | dgauss.f a double-precision version of gauss.f 178 | 179 | radau.f a subroutine generating Gauss-Radau quadrature rules 180 | relative to a given integration measure 181 | dradau.f a double-precision version of radau.f 182 | 183 | lob.f a subroutine generating Gauss-Lobatto quadrature rules 184 | relative to a given integration measure 185 | dlob.f a double-precision version of lob.f 186 | 187 | -------------------------------------------------------------------------------- /src/d1mach.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | double precision function d1mach(i) 4 | c 5 | c Double-precision machine constants 6 | c 7 | c d1mach( 1) = b**(emin-1), the smallest positive magnitude. 8 | c 9 | c d1mach( 2) = b**emax*(1 - b**(-t)), the largest magnitude. 10 | c 11 | c d1mach( 3) = b**(-t), the smallest relative spacing. 12 | c 13 | c d1mach( 4) = b**(1-t), the largest relative spacing. 14 | c 15 | c d1mach( 5) = log10(b) 16 | c 17 | c To alter this function for a particular environment, 18 | c the desired set of data statements should be activated by 19 | c removing the c from column 1. 20 | c On rare machines a static statement may need to be added. 21 | c (But probably more systems prohibit it than require it.) 22 | c 23 | c For IEEE-arithmetic machines (binary standard), one of the second 24 | c two sets of constants below should be appropriate. 25 | c 26 | c Where possible, decimal, octal or hexadecimal constants are used 27 | c to specify the constants exactly. Sometimes this requires using 28 | c equivalent integer arrays. If your compiler uses half-word 29 | c integers by default (sometimes called integer*2), you may need to 30 | c change integer to integer*4 or otherwise instruct your compiler 31 | c to use full-word integers in the next 5 declarations. 32 | c 33 | integer small(2) 34 | integer large(2) 35 | integer right(2) 36 | integer diver(2) 37 | integer log10(2) 38 | integer sc 39 | c 40 | double precision dmach(5) 41 | c 42 | equivalence (dmach(1),small(1)) 43 | equivalence (dmach(2),large(1)) 44 | equivalence (dmach(3),right(1)) 45 | equivalence (dmach(4),diver(1)) 46 | equivalence (dmach(5),log10(1)) 47 | c 48 | c machine constants for cdc cyber 205 and eta-10. 49 | c 50 | c data small(1) / x'9000400000000000' / 51 | c data small(2) / x'8000000000000000' / 52 | c 53 | c data large(1) / x'6FFF7FFFFFFFFFFF' / 54 | c data large(2) / x'6FD07FFFFFFFFFFF' / 55 | c 56 | c data right(1) / x'FF74400000000000' / 57 | c data right(2) / x'8000000000000000' / 58 | c 59 | c data diver(1) / x'FF75400000000000' / 60 | c data diver(2) / x'8000000000000000' / 61 | c 62 | c data log10(1) / x'FFD04D104D427DE7' / 63 | c data log10(2) / x'FFA17DE623E2566B' /, sc/987/ 64 | c 65 | c machine constants for ieee arithmetic machines, such as the at&t 66 | c 3b series and motorola 68000 based machines (e.g. sun 3 and at&t 67 | c pc 7300), in which the most significant byte is stored first. 68 | c 69 | data small(1),small(2) / 1048576, 0 / 70 | data large(1),large(2) / 2146435071, -1 / 71 | data right(1),right(2) / 1017118720, 0 / 72 | data diver(1),diver(2) / 1018167296, 0 / 73 | data log10(1),log10(2) / 1070810131, 1352628735 /, sc/987/ 74 | c 75 | c machine constants for ieee arithmetic machines and 8087-based 76 | c micros, such as the ibm pc and at&t 6300, in which the least 77 | c significant byte is stored first. 78 | c 79 | c data small(1),small(2) / 0, 1048576 / 80 | c data large(1),large(2) / -1, 2146435071 / 81 | c data right(1),right(2) / 0, 1017118720 / 82 | c data diver(1),diver(2) / 0, 1018167296 / 83 | c data log10(1),log10(2) / 1352628735, 1070810131 /, sc/987/ 84 | c 85 | c machine constants for amdahl machines. 86 | c 87 | c data small(1),small(2) / 1048576, 0 / 88 | c data large(1),large(2) / 2147483647, -1 / 89 | c data right(1),right(2) / 856686592, 0 / 90 | c data diver(1),diver(2) / 873463808, 0 / 91 | c data log10(1),log10(2) / 1091781651, 1352628735 /, sc/987/ 92 | c 93 | c machine constants for the burroughs 1700 system. 94 | c 95 | c data small(1) / zc00800000 / 96 | c data small(2) / z000000000 / 97 | c 98 | c data large(1) / zdffffffff / 99 | c data large(2) / zfffffffff / 100 | c 101 | c data right(1) / zcc5800000 / 102 | c data right(2) / z000000000 / 103 | c 104 | c data diver(1) / zcc6800000 / 105 | c data diver(2) / z000000000 / 106 | c 107 | c data log10(1) / zd00e730e7 / 108 | c data log10(2) / zc77800dc0 /, sc/987/ 109 | c 110 | c machine constants for the burroughs 5700 system. 111 | c 112 | c data small(1) / o1771000000000000 / 113 | c data small(2) / o0000000000000000 / 114 | c 115 | c data large(1) / o0777777777777777 / 116 | c data large(2) / o0007777777777777 / 117 | c 118 | c data right(1) / o1461000000000000 / 119 | c data right(2) / o0000000000000000 / 120 | c 121 | c data diver(1) / o1451000000000000 / 122 | c data diver(2) / o0000000000000000 / 123 | c 124 | c data log10(1) / o1157163034761674 / 125 | c data log10(2) / o0006677466732724 /, sc/987/ 126 | c 127 | c machine constants for the burroughs 6700/7700 systems. 128 | c 129 | c data small(1) / o1771000000000000 / 130 | c data small(2) / o7770000000000000 / 131 | c 132 | c data large(1) / o0777777777777777 / 133 | c data large(2) / o7777777777777777 / 134 | c 135 | c data right(1) / o1461000000000000 / 136 | c data right(2) / o0000000000000000 / 137 | c 138 | c data diver(1) / o1451000000000000 / 139 | c data diver(2) / o0000000000000000 / 140 | c 141 | c data log10(1) / o1157163034761674 / 142 | c data log10(2) / o0006677466732724 /, sc/987/ 143 | c 144 | c machine constants for ftn4 on the cdc 6000/7000 series. 145 | c 146 | c data small(1) / 00564000000000000000b / 147 | c data small(2) / 00000000000000000000b / 148 | c 149 | c data large(1) / 37757777777777777777b / 150 | c data large(2) / 37157777777777777774b / 151 | c 152 | c data right(1) / 15624000000000000000b / 153 | c data right(2) / 00000000000000000000b / 154 | c 155 | c data diver(1) / 15634000000000000000b / 156 | c data diver(2) / 00000000000000000000b / 157 | c 158 | c data log10(1) / 17164642023241175717b / 159 | c data log10(2) / 16367571421742254654b /, sc/987/ 160 | c 161 | c machine constants for ftn5 on the cdc 6000/7000 series. 162 | c 163 | c data small(1) / o"00564000000000000000" / 164 | c data small(2) / o"00000000000000000000" / 165 | c 166 | c data large(1) / o"37757777777777777777" / 167 | c data large(2) / o"37157777777777777774" / 168 | c 169 | c data right(1) / o"15624000000000000000" / 170 | c data right(2) / o"00000000000000000000" / 171 | c 172 | c data diver(1) / o"15634000000000000000" / 173 | c data diver(2) / o"00000000000000000000" / 174 | c 175 | c data log10(1) / o"17164642023241175717" / 176 | c data log10(2) / o"16367571421742254654" /, sc/987/ 177 | c 178 | c machine constants for convex c-1 179 | c 180 | c data small(1),small(2) / '00100000'x, '00000000'x / 181 | c data large(1),large(2) / '7fffffff'x, 'ffffffff'x / 182 | c data right(1),right(2) / '3cc00000'x, '00000000'x / 183 | c data diver(1),diver(2) / '3cd00000'x, '00000000'x / 184 | c data log10(1),log10(2) / '3ff34413'x, '509f79ff'x /, sc/987/ 185 | c 186 | c machine constants for the cray 1, xmp, 2, and 3. 187 | c 188 | c data small(1) / 201354000000000000000b / 189 | c data small(2) / 000000000000000000000b / 190 | c 191 | c data large(1) / 577767777777777777777b / 192 | c data large(2) / 000007777777777777776b / 193 | c 194 | c data right(1) / 376434000000000000000b / 195 | c data right(2) / 000000000000000000000b / 196 | c 197 | c data diver(1) / 376444000000000000000b / 198 | c data diver(2) / 000000000000000000000b / 199 | c 200 | c data log10(1) / 377774642023241175717b / 201 | c data log10(2) / 000007571421742254654b /, sc/987/ 202 | c 203 | c machine constants for the data general eclipse s/200 204 | c 205 | c small, large, right, diver, log10 should be declared 206 | c integer small(4), large(4), right(4), diver(4), log10(4) 207 | c 208 | c note - it may be appropriate to include the following line - 209 | c static dmach(5) 210 | c 211 | c data small/20k,3*0/,large/77777k,3*177777k/ 212 | c data right/31420k,3*0/,diver/32020k,3*0/ 213 | c data log10/40423k,42023k,50237k,74776k/, sc/987/ 214 | c 215 | c machine constants for the harris slash 6 and slash 7 216 | c 217 | c data small(1),small(2) / '20000000, '00000201 / 218 | c data large(1),large(2) / '37777777, '37777577 / 219 | c data right(1),right(2) / '20000000, '00000333 / 220 | c data diver(1),diver(2) / '20000000, '00000334 / 221 | c data log10(1),log10(2) / '23210115, '10237777 /, sc/987/ 222 | c 223 | c machine constants for the honeywell dps 8/70 series. 224 | c 225 | c data small(1),small(2) / o402400000000, o000000000000 / 226 | c data large(1),large(2) / o376777777777, o777777777777 / 227 | c data right(1),right(2) / o604400000000, o000000000000 / 228 | c data diver(1),diver(2) / o606400000000, o000000000000 / 229 | c data log10(1),log10(2) / o776464202324, o117571775714 /, sc/987/ 230 | c 231 | c machine constants for the ibm 360/370 series, 232 | c the xerox sigma 5/7/9 and the sel systems 85/86. 233 | c 234 | c data small(1),small(2) / z00100000, z00000000 / 235 | c data large(1),large(2) / z7fffffff, zffffffff / 236 | c data right(1),right(2) / z33100000, z00000000 / 237 | c data diver(1),diver(2) / z34100000, z00000000 / 238 | c data log10(1),log10(2) / z41134413, z509f79ff /, sc/987/ 239 | c 240 | c machine constants for the interdata 8/32 241 | c with the unix system fortran 77 compiler. 242 | c 243 | c for the interdata fortran vii compiler replace 244 | c the z's specifying hex constants with y's. 245 | c 246 | c data small(1),small(2) / z'00100000', z'00000000' / 247 | c data large(1),large(2) / z'7effffff', z'ffffffff' / 248 | c data right(1),right(2) / z'33100000', z'00000000' / 249 | c data diver(1),diver(2) / z'34100000', z'00000000' / 250 | c data log10(1),log10(2) / z'41134413', z'509f79ff' /, sc/987/ 251 | c 252 | c machine constants for the pdp-10 (ka processor). 253 | c 254 | c data small(1),small(2) / "033400000000, "000000000000 / 255 | c data large(1),large(2) / "377777777777, "344777777777 / 256 | c data right(1),right(2) / "113400000000, "000000000000 / 257 | c data diver(1),diver(2) / "114400000000, "000000000000 / 258 | c data log10(1),log10(2) / "177464202324, "144117571776 /, sc/987/ 259 | c 260 | c machine constants for the pdp-10 (ki processor). 261 | c 262 | c data small(1),small(2) / "000400000000, "000000000000 / 263 | c data large(1),large(2) / "377777777777, "377777777777 / 264 | c data right(1),right(2) / "103400000000, "000000000000 / 265 | c data diver(1),diver(2) / "104400000000, "000000000000 / 266 | c data log10(1),log10(2) / "177464202324, "047674776746 /, sc/987/ 267 | c 268 | c machine constants for pdp-11 fortrans supporting 269 | c 32-bit integers (expressed in integer and octal). 270 | c 271 | c data small(1),small(2) / 8388608, 0 / 272 | c data large(1),large(2) / 2147483647, -1 / 273 | c data right(1),right(2) / 612368384, 0 / 274 | c data diver(1),diver(2) / 620756992, 0 / 275 | c data log10(1),log10(2) / 1067065498, -2063872008 /, sc/987/ 276 | c 277 | c data small(1),small(2) / o00040000000, o00000000000 / 278 | c data large(1),large(2) / o17777777777, o37777777777 / 279 | c data right(1),right(2) / o04440000000, o00000000000 / 280 | c data diver(1),diver(2) / o04500000000, o00000000000 / 281 | c data log10(1),log10(2) / o07746420232, o20476747770 /, sc/987/ 282 | c 283 | c machine constants for pdp-11 fortrans supporting 284 | c 16-bit integers (expressed in integer and octal). 285 | c 286 | c small, large, right, diver, log10 should be declared 287 | c integer small(4), large(4), right(4), diver(4), log10(4) 288 | c 289 | c data small(1),small(2) / 128, 0 / 290 | c data small(3),small(4) / 0, 0 / 291 | c 292 | c data large(1),large(2) / 32767, -1 / 293 | c data large(3),large(4) / -1, -1 / 294 | c 295 | c data right(1),right(2) / 9344, 0 / 296 | c data right(3),right(4) / 0, 0 / 297 | c 298 | c data diver(1),diver(2) / 9472, 0 / 299 | c data diver(3),diver(4) / 0, 0 / 300 | c 301 | c data log10(1),log10(2) / 16282, 8346 / 302 | c data log10(3),log10(4) / -31493, -12296 /, sc/987/ 303 | c 304 | c data small(1),small(2) / o000200, o000000 / 305 | c data small(3),small(4) / o000000, o000000 / 306 | c 307 | c data large(1),large(2) / o077777, o177777 / 308 | c data large(3),large(4) / o177777, o177777 / 309 | c 310 | c data right(1),right(2) / o022200, o000000 / 311 | c data right(3),right(4) / o000000, o000000 / 312 | c 313 | c data diver(1),diver(2) / o022400, o000000 / 314 | c data diver(3),diver(4) / o000000, o000000 / 315 | c 316 | c data log10(1),log10(2) / o037632, o020232 / 317 | c data log10(3),log10(4) / o102373, o147770 /, sc/987/ 318 | c 319 | c machine constants for the prime 50 series systems 320 | c with 32-bit integers and 64v mode instructions, 321 | c supplied by igor bray. 322 | c 323 | c data small(1),small(2) / :10000000000, :00000100001 / 324 | c data large(1),large(2) / :17777777777, :37777677775 / 325 | c data right(1),right(2) / :10000000000, :00000000122 / 326 | c data diver(1),diver(2) / :10000000000, :00000000123 / 327 | c data log10(1),log10(2) / :11504046501, :07674600177 /, sc/987/ 328 | c 329 | c machine constants for the sequent balance 8000 330 | c 331 | c data small(1),small(2) / sh, / 332 | c data large(1),large(2) / , fefffff / 333 | c data right(1),right(2) / sh, ca00000 / 334 | c data diver(1),diver(2) / sh, cb00000 / 335 | c data log10(1),log10(2) / f79ff, fd34413 /, sc/987/ 336 | c 337 | c machine constants for the univac 1100 series. 338 | c 339 | c data small(1),small(2) / o000040000000, o000000000000 / 340 | c data large(1),large(2) / o377777777777, o777777777777 / 341 | c data right(1),right(2) / o170540000000, o000000000000 / 342 | c data diver(1),diver(2) / o170640000000, o000000000000 / 343 | c data log10(1),log10(2) / o177746420232, o411757177572 /, sc/987/ 344 | c 345 | c machine constants for the vax unix f77 compiler 346 | c 347 | c data small(1),small(2) / 128, 0 / 348 | c data large(1),large(2) / -32769, -1 / 349 | c data right(1),right(2) / 9344, 0 / 350 | c data diver(1),diver(2) / 9472, 0 / 351 | c data log10(1),log10(2) / 546979738, -805796613 /, sc/987/ 352 | c 353 | c machine constants for the vax-11 with 354 | c fortran iv-plus compiler 355 | c 356 | c data small(1),small(2) / z00000080, z00000000 / 357 | c data large(1),large(2) / zffff7fff, zffffffff / 358 | c data right(1),right(2) / z00002480, z00000000 / 359 | c data diver(1),diver(2) / z00002500, z00000000 / 360 | c data log10(1),log10(2) / z209a3f9a, zcff884fb /, sc/987/ 361 | c 362 | c machine constants for vax/vms version 2.2 363 | c 364 | c data small(1),small(2) / '80'x, '0'x / 365 | c data large(1),large(2) / 'ffff7fff'x, 'ffffffff'x / 366 | c data right(1),right(2) / '2480'x, '0'x / 367 | c data diver(1),diver(2) / '2500'x, '0'x / 368 | c data log10(1),log10(2) / '209a3f9a'x, 'cff884fb'x /, sc/987/ 369 | c 370 | c *** issue stop 779 if all data statements are commented... 371 | if (sc .ne. 987) stop 779 372 | c *** issue stop 778 if all data statements are obviously wrong... 373 | if (dmach(4) .ge. 1.0d0) stop 778 374 | if (i .lt. 1 .or. i .gt. 5) goto 999 375 | d1mach = dmach(i) 376 | return 377 | 999 write(*,1999) i 378 | 1999 format(' d1mach - i out of bounds',i10) 379 | stop 380 | end 381 | 382 | -------------------------------------------------------------------------------- /src/dchri.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine dchri(n,iopt,da,db,dx,dy,dhr,dhi,dalpha,dbeta,ierr) 4 | c 5 | c This is a double-precision version of the routine chri. 6 | c 7 | double precision da,db,dx,dy,dhr,dhi,dalpha,dbeta,deps,d1mach, 8 | *de,dq,ds,dt,deio,dd,der,dei,deroo,deioo,dso,dero,deoo,deo,du,dc, 9 | *dc0,dgam,dcm1,dp2 10 | dimension da(*),db(*),dalpha(n),dbeta(n) 11 | c 12 | c The arrays da,db are assumed to have dimension n+1. 13 | c 14 | deps=5.d0*d1mach(3) 15 | ierr=0 16 | if(n.lt.2) then 17 | ierr=1 18 | return 19 | end if 20 | if(iopt.eq.1) then 21 | de=0.d0 22 | do 10 k=1,n 23 | dq=da(k)-de-dx 24 | dbeta(k)=dq*de 25 | de=db(k+1)/dq 26 | dalpha(k)=dx+dq+de 27 | 10 continue 28 | dbeta(1)=db(1)*(da(1)-dx) 29 | return 30 | else if(iopt.eq.2) then 31 | ds=dx-da(1) 32 | dt=dy 33 | deio=0.d0 34 | do 20 k=1,n 35 | dd=ds*ds+dt*dt 36 | der=-db(k+1)*ds/dd 37 | dei=db(k+1)*dt/dd 38 | ds=dx+der-da(k+1) 39 | dt=dy+dei 40 | dalpha(k)=dx+dt*der/dei-ds*dei/dt 41 | dbeta(k)=dt*deio*(1.d0+(der/dei)**2) 42 | deio=dei 43 | 20 continue 44 | dbeta(1)=db(1)*(db(2)+(da(1)-dx)**2+dy*dy) 45 | return 46 | else if(iopt.eq.3) then 47 | dt=dy 48 | deio=0.d0 49 | do 30 k=1,n 50 | dei=db(k+1)/dt 51 | dt=dy+dei 52 | dalpha(k)=0.d0 53 | dbeta(k)=dt*deio 54 | deio=dei 55 | 30 continue 56 | dbeta(1)=db(1)*(db(2)+dy*dy) 57 | return 58 | else if(iopt.eq.4) then 59 | dalpha(1)=dx-db(1)/dhr 60 | dbeta(1)=-dhr 61 | dq=-db(1)/dhr 62 | do 40 k=2,n 63 | de=da(k-1)-dx-dq 64 | dbeta(k)=dq*de 65 | dq=db(k)/de 66 | dalpha(k)=dq+de+dx 67 | 40 continue 68 | return 69 | else if(iopt.eq.5) then 70 | nm1=n-1 71 | dd=dhr*dhr+dhi*dhi 72 | deroo=da(1)-dx+db(1)*dhr/dd 73 | deioo=-db(1)*dhi/dd-dy 74 | dalpha(1)=dx+dhr*dy/dhi 75 | dbeta(1)=-dhi/dy 76 | dalpha(2)=dx-db(1)*dhi*deroo/(dd*deioo)+dhr*deioo/dhi 77 | dbeta(2)=dy*deioo*(1.d0+(dhr/dhi)**2) 78 | if(n.eq.2) return 79 | dso=db(2)/(deroo**2+deioo**2) 80 | dero=da(2)-dx-dso*deroo 81 | deio=dso*deioo-dy 82 | dalpha(3)=dx+deroo*deio/deioo+dso*deioo*dero/deio 83 | dbeta(3)=-db(1)*dhi*deio*(1.d0+(deroo/deioo)**2)/dd 84 | if(n.eq.3) return 85 | do 50 k=3,nm1 86 | ds=db(k)/(dero**2+deio**2) 87 | der=da(k)-dx-ds*dero 88 | dei=ds*deio-dy 89 | dalpha(k+1)=dx+dero*dei/deio+ds*deio*der/dei 90 | dbeta(k+1)=dso*deioo*dei*(1.d0+(dero/deio)**2) 91 | deroo=dero 92 | deioo=deio 93 | dero=der 94 | deio=dei 95 | dso=ds 96 | 50 continue 97 | return 98 | else if(iopt.eq.6) then 99 | nm1=n-1 100 | deoo=-db(1)/dhi-dy 101 | deo=db(2)/deoo-dy 102 | dalpha(1)=0.d0 103 | dbeta(1)=-dhi/dy 104 | dalpha(2)=0.d0 105 | dbeta(2)=dy*deoo 106 | if(n.eq.2) return 107 | dalpha(3)=0.d0 108 | dbeta(3)=-db(1)*deo/dhi 109 | if(n.eq.3) return 110 | do 60 k=3,nm1 111 | de=db(k)/deo-dy 112 | dbeta(k+1)=db(k-1)*de/deoo 113 | dalpha(k+1)=0.d0 114 | deoo=deo 115 | deo=de 116 | 60 continue 117 | return 118 | else if(iopt.eq.7) then 119 | du=0.d0 120 | dc=1.d0 121 | dc0=0.d0 122 | do 70 k=1,n 123 | dgam=da(k)-dx-du 124 | dcm1=dc0 125 | dc0=dc 126 | if(dabs(dc0).gt.deps) then 127 | dp2=(dgam**2)/dc0 128 | else 129 | dp2=dcm1*db(k) 130 | end if 131 | if(k.gt.1) dbeta(k)=ds*(dp2+db(k+1)) 132 | ds=db(k+1)/(dp2+db(k+1)) 133 | dc=dp2/(dp2+db(k+1)) 134 | du=ds*(dgam+da(k+1)-dx) 135 | dalpha(k)=dgam+du+dx 136 | 70 continue 137 | dbeta(1)=db(1)*(db(2)+(dx-da(1))**2) 138 | return 139 | else 140 | ierr=2 141 | return 142 | end if 143 | end 144 | 145 | -------------------------------------------------------------------------------- /src/dfejer.f: -------------------------------------------------------------------------------- 1 | subroutine dfejer(n,x,w) 2 | c 3 | c This is a double-precision version of fejer. 4 | c 5 | double precision x,w,dpi,dn,dc1,dc0,dt,dsum,dc2 6 | dimension x(n),w(n) 7 | cf2py integer intent(in) :: n 8 | cf2py real*8 intent(out),depend(n),dimension(n) :: x 9 | cf2py real*8 intent(out),depend(n),dimension(n) :: w 10 | dpi=4.d0*datan(1.d0) 11 | nh=n/2 12 | np1h=(n+1)/2 13 | dn=dble(n) 14 | do 10 k=1,nh 15 | x(n+1-k)=dcos(.5d0*dble(2*k-1)*dpi/dn) 16 | x(k)=-x(n+1-k) 17 | 10 continue 18 | if(2*nh.ne.n) x(np1h)=0.d0 19 | do 30 k=1,np1h 20 | dc1=1.d0 21 | dc0=2.d0*x(k)*x(k)-1.d0 22 | dt=2.d0*dc0 23 | dsum=dc0/3.d0 24 | do 20 m=2,nh 25 | dc2=dc1 26 | dc1=dc0 27 | dc0=dt*dc1-dc2 28 | dsum=dsum+dc0/dble(4*m*m-1) 29 | 20 continue 30 | w(k)=2.d0*(1.d0-2.d0*dsum)/dn 31 | w(n+1-k)=w(k) 32 | 30 continue 33 | return 34 | end 35 | 36 | -------------------------------------------------------------------------------- /src/dgauss.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine dgauss(n,alpha,beta,deps,zero,weigh,ierr,de) 4 | c 5 | c This is a double-precision version of the routine gauss. 6 | c 7 | double precision alpha,beta,deps,zero,weigh,de,dp,dg,dr, 8 | *ds,dc,df,db 9 | dimension alpha(n),beta(n),zero(n),weigh(n),de(n) 10 | cf2py integer intent(hide),depend(alpha) :: n=len(alpha) 11 | cf2py real*8 intent(in) :: alpha 12 | cf2py real*8 intent(in),depend(n),dimension(n) :: beta 13 | cf2py real*8 optional, intent(in) :: eps=1e-6 14 | cf2py real*8 intent(out),depend(n),dimension(n) :: zero 15 | cf2py real*8 intent(out),depend(n),dimension(n) :: weight 16 | cf2py integer intent(out) :: ierr 17 | cf2py real*8 intent(hide),depend(n),dimension(n) :: de 18 | if(n.lt.1) then 19 | ierr=-1 20 | return 21 | end if 22 | ierr=0 23 | zero(1)=alpha(1) 24 | if(beta(1).lt.0.d0) then 25 | ierr=-2 26 | return 27 | end if 28 | weigh(1)=beta(1) 29 | if (n.eq.1) return 30 | weigh(1)=1.d0 31 | de(n)=0.d0 32 | do 100 k=2,n 33 | zero(k)=alpha(k) 34 | if(beta(k).lt.0.d0) then 35 | ierr=-2 36 | return 37 | end if 38 | de(k-1)=dsqrt(beta(k)) 39 | weigh(k)=0.d0 40 | 100 continue 41 | do 240 l=1,n 42 | j=0 43 | 105 do 110 m=l,n 44 | if(m.eq.n) goto 120 45 | if(dabs(de(m)).le.deps*(dabs(zero(m))+dabs(zero(m+1)))) 46 | * goto 120 47 | 110 continue 48 | 120 dp=zero(l) 49 | if(m.eq.l) goto 240 50 | if(j.eq.30) goto 400 51 | j=j+1 52 | dg=(zero(l+1)-dp)/(2.d0*de(l)) 53 | dr=dsqrt(dg*dg+1.d0) 54 | dg=zero(m)-dp+de(l)/(dg+dsign(dr,dg)) 55 | ds=1.d0 56 | dc=1.d0 57 | dp=0.d0 58 | mml=m-l 59 | do 200 ii=1,mml 60 | i=m-ii 61 | df=ds*de(i) 62 | db=dc*de(i) 63 | if(dabs(df).lt.dabs(dg)) goto 150 64 | dc=dg/df 65 | dr=dsqrt(dc*dc+1.d0) 66 | de(i+1)=df*dr 67 | ds=1.d0/dr 68 | dc=dc*ds 69 | goto 160 70 | 150 ds=df/dg 71 | dr=dsqrt(ds*ds+1.d0) 72 | de(i+1)=dg*dr 73 | dc=1.d0/dr 74 | ds=ds*dc 75 | 160 dg=zero(i+1)-dp 76 | dr=(zero(i)-dg)*ds+2.d0*dc*db 77 | dp=ds*dr 78 | zero(i+1)=dg+dp 79 | dg=dc*dr-db 80 | df=weigh(i+1) 81 | weigh(i+1)=ds*weigh(i)+dc*df 82 | weigh(i)=dc*weigh(i)-ds*df 83 | 200 continue 84 | zero(l)=zero(l)-dp 85 | de(l)=dg 86 | de(m)=0.d0 87 | goto 105 88 | 240 continue 89 | do 300 ii=2,n 90 | i=ii-1 91 | k=i 92 | dp=zero(i) 93 | do 260 j=ii,n 94 | if(zero(j).ge.dp) goto 260 95 | k=j 96 | dp=zero(j) 97 | 260 continue 98 | if(k.eq.i) goto 300 99 | zero(k)=zero(i) 100 | zero(i)=dp 101 | dp=weigh(i) 102 | weigh(i)=weigh(k) 103 | weigh(k)=dp 104 | 300 continue 105 | do 310 k=1,n 106 | weigh(k)=beta(1)*weigh(k)*weigh(k) 107 | 310 continue 108 | return 109 | 400 ierr=l 110 | return 111 | end 112 | 113 | -------------------------------------------------------------------------------- /src/dknum.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine dknum(n,nu0,numax,dx,dy,deps,da,db,drhor,drhoi,nu, 4 | *ierr,droldr,droldi) 5 | c 6 | c This is a double-precision version of the routine knum. 7 | c 8 | double precision dx,dy,deps,da(numax),db(numax),drhor(*), 9 | *drhoi(*),droldr(*),droldi(*),drr,dri,dden,dt 10 | c 11 | c The arrays drhor,drhoi,droldr,droldi are assumed to have 12 | c dimension n+1. 13 | c 14 | ierr=0 15 | np1=n+1 16 | if(nu0.gt.numax) then 17 | ierr=nu0 18 | return 19 | end if 20 | if(nu0.lt.np1) nu0=np1 21 | nu=nu0-5 22 | do 10 k=1,np1 23 | drhor(k)=0.d0 24 | drhoi(k)=0.d0 25 | 10 continue 26 | 20 nu=nu+5 27 | if(nu.gt.numax) then 28 | ierr=numax 29 | goto 60 30 | end if 31 | do 30 k=1,np1 32 | droldr(k)=drhor(k) 33 | droldi(k)=drhoi(k) 34 | 30 continue 35 | drr=0.d0 36 | dri=0.d0 37 | do 40 j=1,nu 38 | j1=nu-j+1 39 | dden=(dx-da(j1)-drr)**2+(dy-dri)**2 40 | drr=db(j1)*(dx-da(j1)-drr)/dden 41 | dri=-db(j1)*(dy-dri)/dden 42 | if(j1.le.np1) then 43 | drhor(j1)=drr 44 | drhoi(j1)=dri 45 | end if 46 | 40 continue 47 | do 50 k=1,np1 48 | if((drhor(k)-droldr(k))**2+(drhoi(k)-droldi(k))**2.gt. 49 | * deps*(drhor(k)**2+drhoi(k)**2)) goto 20 50 | 50 continue 51 | 60 if(n.eq.0) return 52 | do 70 k=2,np1 53 | dt=drhor(k)*drhor(k-1)-drhoi(k)*drhoi(k-1) 54 | drhoi(k)=drhor(k)*drhoi(k-1)+drhoi(k)*drhor(k-1) 55 | drhor(k)=dt 56 | 70 continue 57 | return 58 | end 59 | 60 | -------------------------------------------------------------------------------- /src/dlancz.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine dlancz(n,ncap,x,w,alpha,beta,ierr,dp0,dp1) 4 | c 5 | c This is a double-precision version of the routine lancz. 6 | c 7 | double precision x(ncap),w(ncap),alpha(n),beta(n), 8 | *dp0(ncap),dp1(ncap),dpi,dgam,dsig,dt,xlam,drho,dtmp, 9 | *dtsig,dtk 10 | cf2py integer intent(in) :: n 11 | cf2py integer intent(hide),depend(x) :: ncap=len(x) 12 | cf2py real*8 intent(in) :: x 13 | cf2py real*8 intent(in),depend(ncap),check(len(w)>=ncap) :: w 14 | cf2py real*8 intent(out,out=alpha),depend(n),dimension(n) :: alpha 15 | cf2py real*8 intent(out,out=beta),depend(n),dimension(n) :: beta 16 | cf2py real*8 intent(hide),depend(ncap),dimension(ncap) :: dp0 17 | cf2py real*8 intent(hide),depend(ncap),dimension(ncap) :: dp1 18 | cf2py integer intent(out) :: ierr 19 | if(n.le.0 .or. n.gt.ncap) then 20 | ierr=1 21 | return 22 | else 23 | ierr=0 24 | end if 25 | do 10 i=1,ncap 26 | dp0(i)=x(i) 27 | dp1(i)=0.d0 28 | 10 continue 29 | dp1(1)=w(1) 30 | do 30 i=1,ncap-1 31 | dpi=w(i+1) 32 | dgam=1.d0 33 | dsig=0.d0 34 | dt=0.d0 35 | xlam=x(i+1) 36 | do 20 k=1,i+1 37 | drho=dp1(k)+dpi 38 | dtmp=dgam*drho 39 | dtsig=dsig 40 | if(drho.le.0.d0) then 41 | dgam=1.d0 42 | dsig=0.d0 43 | else 44 | dgam=dp1(k)/drho 45 | dsig=dpi/drho 46 | end if 47 | dtk=dsig*(dp0(k)-xlam)-dgam*dt 48 | dp0(k)=dp0(k)-(dtk-dt) 49 | dt=dtk 50 | if(dsig.le.0.d0) then 51 | dpi=dtsig*dp1(k) 52 | else 53 | dpi=(dt**2)/dsig 54 | end if 55 | dtsig=dsig 56 | dp1(k)=dtmp 57 | 20 continue 58 | 30 continue 59 | do 40 k=1,n 60 | alpha(k)=dp0(k) 61 | beta(k)=dp1(k) 62 | 40 continue 63 | return 64 | end 65 | 66 | -------------------------------------------------------------------------------- /src/dlob.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | 4 | subroutine dlob(n,alpha,beta,aleft,right,zero,weight, 5 | *ierr,de,da,db) 6 | c 7 | c This is a double-precision version of the routine lob. 8 | c 9 | double precision aleft,right,depsma,dp0l,dp0r,dp1l,dp1r,dpm1l, 10 | *dpm1r,ddet,alpha(*),beta(*),zero(*),weight(*),de(*),da(*), 11 | *db(*),d1mach 12 | c 13 | c The arrays alpha,beta,zero,weight,de,da,db are assumed to have 14 | c dimension n+2. 15 | cf2py integer intent(hide),depend(alpha) :: n=len(alpha) 16 | cf2py real intent(in) :: alpha 17 | cf2py real intent(in),depend(n),dimension(n) :: beta 18 | cf2py real intent(in) :: aleft 19 | cf2py real intent(in) :: right 20 | cf2py real intent(out),depend(n),dimension(n+2) :: zero 21 | cf2py real intent(out),depend(n),dimension(n+2) :: weight 22 | cf2py real intent(hide),depend(n),dimension(n+2) :: de 23 | cf2py real intent(hide),depend(n),dimension(n+2) :: da 24 | cf2py real intent(hide),depend(n),dimension(n+2) :: db 25 | cf2py integer intent(out) :: ierr 26 | c 27 | depsma=d1mach(3) 28 | c 29 | c depsma is the machine double precision. 30 | c 31 | np1=n+1 32 | np2=n+2 33 | do 10 k=1,np2 34 | da(k)=alpha(k) 35 | db(k)=beta(k) 36 | 10 continue 37 | dp0l=0.d0 38 | dp0r=0.d0 39 | dp1l=1.d0 40 | dp1r=1.d0 41 | do 20 k=1,np1 42 | dpm1l=dp0l 43 | dp0l=dp1l 44 | dpm1r=dp0r 45 | dp0r=dp1r 46 | dp1l=(aleft-da(k))*dp0l-db(k)*dpm1l 47 | dp1r=(right-da(k))*dp0r-db(k)*dpm1r 48 | 20 continue 49 | ddet=dp1l*dp0r-dp1r*dp0l 50 | da(np2)=(aleft*dp1l*dp0r-right*dp1r*dp0l)/ddet 51 | db(np2)=(right-aleft)*dp1l*dp1r/ddet 52 | call dgauss(np2,da,db,depsma,zero,weight,ierr,de) 53 | return 54 | end 55 | 56 | -------------------------------------------------------------------------------- /src/dradau.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine dradau(n,alpha,beta,end,zero,weight,ierr,de, 4 | *da,db) 5 | c 6 | c This is a double-precision version of the routine radau. 7 | c 8 | double precision end,depsma,dp0,dp1,dpm1,alpha(*),beta(*), 9 | *zero(*),weight(*),de(*),da(*),db(*),d1mach 10 | c 11 | c The arrays alpha,beta,zero,weight,de,da,db are assumed to have 12 | c dimension n+1. 13 | cf2py integer intent(hide),depend(alpha) :: n=len(alpha) 14 | cf2py real intent(in) :: alpha 15 | cf2py real intent(in),depend(n),dimension(n) :: beta 16 | cf2py real intent(in) :: end 17 | cf2py real intent(out),depend(n),dimension(n+1) :: zero 18 | cf2py real intent(out),depend(n),dimension(n+1) :: weight 19 | cf2py real intent(hide),depend(n),dimension(n+1) :: de 20 | cf2py real intent(hide),depend(n),dimension(n+1) :: da 21 | cf2py real intent(hide),depend(n),dimension(n+1) :: db 22 | c 23 | depsma=d1mach(3) 24 | c 25 | c depsma is the machine double precision. 26 | c 27 | np1=n+1 28 | do 10 k=1,np1 29 | da(k)=alpha(k) 30 | db(k)=beta(k) 31 | 10 continue 32 | dp0=0.d0 33 | dp1=1.d0 34 | do 20 k=1,n 35 | dpm1=dp0 36 | dp0=dp1 37 | dp1=(end-da(k))*dp0-db(k)*dpm1 38 | 20 continue 39 | da(np1)=end-db(np1)*dp0/dp1 40 | call dgauss(np1,da,db,depsma,zero,weight,ierr,de) 41 | return 42 | end 43 | 44 | -------------------------------------------------------------------------------- /src/drecur.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine drecur(n,ipoly,dal,dbe,da,db,iderr) 4 | c 5 | c This is a double-precision version of the routine recur. 6 | c 7 | external dgamma 8 | double precision dal,dbe,da,db,dlmach,d1mach,dkm1,dalpbe,dt, 9 | *dlga,dal2,dbe2,dgamma 10 | dimension da(n),db(n) 11 | cf2py integer intent(in) :: n 12 | cf2py integer intent(in) :: ipoly 13 | cf2py real optional,intent(in) :: dal=-.5 14 | cf2py real optional,intent(in) :: dbe=.5 15 | cf2py real intent(out,out=a),depend(n),dimension(n) :: da 16 | cf2py real intent(out,out=b),depend(n),dimension(n) :: db 17 | cf2py integer intent(out,out=ierr) :: iderr 18 | if(n.lt.1) then 19 | iderr=3 20 | return 21 | end if 22 | dlmach=dlog(d1mach(2)) 23 | iderr=0 24 | do 10 k=1,n 25 | da(k)=0.d0 26 | 10 continue 27 | if(ipoly.eq.1) then 28 | db(1)=2.d0 29 | if (n.eq.1) return 30 | do 20 k=2,n 31 | dkm1=dble(k-1) 32 | db(k)=1.d0/(4.d0-1.d0/(dkm1*dkm1)) 33 | 20 continue 34 | return 35 | else if(ipoly.eq.2) then 36 | da(1)=.5d0 37 | db(1)=1.d0 38 | if(n.eq.1) return 39 | do 30 k=2,n 40 | da(k)=.5d0 41 | dkm1=dble(k-1) 42 | db(k)=.25d0/(4.d0-1.d0/(dkm1*dkm1)) 43 | 30 continue 44 | return 45 | else if(ipoly.eq.3) then 46 | db(1)=4.d0*datan(1.d0) 47 | if(n.eq.1) return 48 | db(2)=.5d0 49 | if(n.eq.2) return 50 | do 40 k=3,n 51 | db(k)=.25d0 52 | 40 continue 53 | return 54 | else if(ipoly.eq.4) then 55 | db(1)=2.d0*datan(1.d0) 56 | if(n.eq.1) return 57 | do 50 k=2,n 58 | db(k)=.25d0 59 | 50 continue 60 | return 61 | else if(ipoly.eq.5) then 62 | db(1)=4.d0*datan(1.d0) 63 | da(1)=.5d0 64 | if(n.eq.1) return 65 | do 60 k=2,n 66 | db(k)=.25d0 67 | 60 continue 68 | return 69 | else if(ipoly.eq.6) then 70 | if(dal.le.-1.d0 .or. dbe.le.-1.d0) then 71 | iderr=1 72 | return 73 | else 74 | dalpbe=dal+dbe 75 | da(1)=(dbe-dal)/(dalpbe+2.d0) 76 | dt=(dalpbe+1.d0)*dlog(2.d0)+dlga(dal+1.d0)+dlga(dbe+1.d0)- 77 | * dlga(dalpbe+2.d0) 78 | if(dt.gt.dlmach) then 79 | iderr=2 80 | db(1)=d1mach(2) 81 | else 82 | db(1)=dexp(dt) 83 | end if 84 | if(n.eq.1) return 85 | dal2=dal*dal 86 | dbe2=dbe*dbe 87 | da(2)=(dbe2-dal2)/((dalpbe+2.d0)*(dalpbe+4.d0)) 88 | db(2)=4.d0*(dal+1.d0)*(dbe+1.d0)/((dalpbe+3.d0)*(dalpbe+ 89 | * 2.d0)**2) 90 | if(n.eq.2) return 91 | do 70 k=3,n 92 | dkm1=dble(k-1) 93 | da(k)=.25d0*(dbe2-dal2)/(dkm1*dkm1*(1.d0+.5d0*dalpbe/dkm1) 94 | * *(1.d0+.5d0*(dalpbe+2.d0)/dkm1)) 95 | db(k)=.25d0*(1.d0+dal/dkm1)*(1.d0+dbe/dkm1)*(1.d0+dalpbe/ 96 | * dkm1)/((1.d0+.5d0*(dalpbe+1.d0)/dkm1)*(1.d0+.5d0*(dalpbe 97 | * -1.d0)/dkm1)*(1.d0+.5d0*dalpbe/dkm1)**2) 98 | 70 continue 99 | return 100 | end if 101 | else if(ipoly.eq.7) then 102 | if(dal.le.-1.d0) then 103 | iderr=1 104 | return 105 | else 106 | da(1)=dal+1.d0 107 | db(1)=dgamma(dal+1.d0,iderr) 108 | if(iderr.eq.2) db(1)=d1mach(2) 109 | if(n.eq.1) return 110 | do 80 k=2,n 111 | dkm1=dble(k-1) 112 | da(k)=2.d0*dkm1+dal+1.d0 113 | db(k)=dkm1*(dkm1+dal) 114 | 80 continue 115 | return 116 | end if 117 | else if(ipoly.eq.8) then 118 | db(1)=dsqrt(4.d0*datan(1.d0)) 119 | if(n.eq.1) return 120 | do 90 k=2,n 121 | db(k)=.5d0*dble(k-1) 122 | 90 continue 123 | return 124 | else 125 | iderr=4 126 | end if 127 | end 128 | 129 | double precision function dlga(dx) 130 | double precision dbnum,dbden,dx,d1mach,dc,dp,dy,dt,ds 131 | dimension dbnum(8),dbden(8) 132 | c 133 | c This routine evaluates the logarithm of the gamma function by a 134 | c combination of recurrence and asymptotic approximation. 135 | c 136 | c The entries in the next data statement are the numerators and 137 | c denominators, respectively, of the quantities B[16]/(16*15), 138 | c B[14]/(14*13),..., B[2]/(2*1), where B[2n] are the Bernoulli 139 | c numbers. 140 | c 141 | data dbnum/-3.617d3,1.d0,-6.91d2,1.d0,-1.d0,1.d0,-1.d0,1.d0/, 142 | * dbden/1.224d5,1.56d2,3.6036d5,1.188d3,1.68d3,1.26d3,3.6d2, 143 | *1.2d1/ 144 | c 145 | c The quantity dprec in the next statement is the number of decimal 146 | c digits carried in double-precision floating-point arithmetic. 147 | c 148 | dprec=-alog10(sngl(d1mach(3))) 149 | dc=.5d0*dlog(8.d0*datan(1.d0)) 150 | dp=1.d0 151 | dy=dx 152 | y=sngl(dy) 153 | c 154 | c The quantity y0 below is the threshold value beyond which asymptotic 155 | c evaluation gives sufficient accuracy; see Eq. 6.1.42 in M. Abramowitz 156 | c and I.A. Stegun,Handbook of Mathematical Functions''. The constants 157 | c are .12118868... = ln(10)/19 and .05390522... = ln(|B[20]|/190)/19. 158 | c 159 | y0=exp(.121189*dprec+.053905) 160 | 10 if(y.gt.y0) goto 20 161 | dp=dy*dp 162 | dy=dy+1.d0 163 | y=sngl(dy) 164 | goto 10 165 | 20 dt=1.d0/(dy*dy) 166 | c 167 | c The right-hand side of the next assignment statement is B[18]/(18*17). 168 | c 169 | ds=4.3867d4/2.44188d5 170 | do 30 i=1,8 171 | ds=dt*ds+dbnum(i)/dbden(i) 172 | 30 continue 173 | dlga=(dy-.5d0)*dlog(dy)-dy+dc+ds/dy-dlog(dp) 174 | return 175 | end 176 | 177 | double precision function dgamma(dx,iderr) 178 | c 179 | c This evaluates the gamma function for real positive dx, using the 180 | c function subroutine dlga. 181 | c 182 | double precision dx,dlmach,d1mach,dt,dlga 183 | dlmach=dlog(d1mach(2)) 184 | iderr=0 185 | dt=dlga(dx) 186 | if(dt.ge.dlmach) then 187 | iderr=2 188 | dgamma=d1mach(2) 189 | return 190 | else 191 | dgamma=dexp(dt) 192 | return 193 | end if 194 | end 195 | 196 | -------------------------------------------------------------------------------- /src/dsti.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine dsti(n,ncap,x,w,alpha,beta,ierr,dp0,dp1,dp2) 4 | c 5 | c This is a double-precision version of the routine sti. 6 | c 7 | double precision x,w,alpha,beta,dp0,dp1,dp2,dtiny,d1mach, 8 | *dhuge,dsum0,dsum1,dsum2,dt 9 | dimension x(ncap),w(ncap),alpha(n),beta(n),dp0(ncap), 10 | *dp1(ncap),dp2(ncap) 11 | cf2py integer intent(in) :: n 12 | cf2py integer intent(hide),depend(x) :: ncap=len(x) 13 | cf2py real*8 intent(in) :: x 14 | cf2py real*8 intent(in),depend(ncap),check(len(w)>=ncap) :: w 15 | cf2py real*8 intent(out,out=alpha),depend(n),dimension(n) :: alpha 16 | cf2py real*8 intent(out,out=beta),depend(n),dimension(n) :: beta 17 | cf2py real*8 intent(hide),depend(ncap),dimension(ncap) :: dp0 18 | cf2py real*8 intent(hide),depend(ncap),dimension(ncap) :: dp1 19 | cf2py real*8 intent(hide),depend(ncap),dimension(ncap) :: dp2 20 | cf2py integer intent(out) :: ierr 21 | dtiny=10.d0*d1mach(1) 22 | dhuge=.1d0*d1mach(2) 23 | ierr=0 24 | if(n.le.0 .or. n.gt.ncap) then 25 | ierr=1 26 | return 27 | end if 28 | nm1=n-1 29 | dsum0=0.d0 30 | dsum1=0.d0 31 | do 10 m=1,ncap 32 | dsum0=dsum0+w(m) 33 | dsum1=dsum1+w(m)*x(m) 34 | 10 continue 35 | alpha(1)=dsum1/dsum0 36 | beta(1)=dsum0 37 | if(n.eq.1) return 38 | do 20 m=1,ncap 39 | dp1(m)=0.d0 40 | dp2(m)=1.d0 41 | 20 continue 42 | do 40 k=1,nm1 43 | dsum1=0.d0 44 | dsum2=0.d0 45 | do 30 m=1,ncap 46 | if(w(m).eq.0.d0) goto 30 47 | dp0(m)=dp1(m) 48 | dp1(m)=dp2(m) 49 | dp2(m)=(x(m)-alpha(k))*dp1(m)-beta(k)*dp0(m) 50 | if(dabs(dp2(m)).gt.dhuge .or. dabs(dsum2).gt.dhuge) then 51 | ierr=k 52 | return 53 | end if 54 | dt=w(m)*dp2(m)*dp2(m) 55 | dsum1=dsum1+dt 56 | dsum2=dsum2+dt*x(m) 57 | 30 continue 58 | if(dabs(dsum1).lt.dtiny) then 59 | ierr=-k 60 | return 61 | end if 62 | alpha(k+1)=dsum2/dsum1 63 | beta(k+1)=dsum1/dsum0 64 | dsum0=dsum1 65 | 40 continue 66 | return 67 | end 68 | 69 | -------------------------------------------------------------------------------- /src/eval.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE POLY_EVAL( X, PHI, P, ALPHA, BETA, GAMMA ) 2 | 3 | INTEGER P 4 | DOUBLE PRECISION X 5 | DOUBLE PRECISION ALPHA( P ), BETA( P ), GAMMA( P ), 6 | $ PHI( P ) 7 | cf2py double precision intent(in) :: x 8 | cf2py double precision intent(out),depend(p),dimension(p) :: phi 9 | cf2py integer intent(hide),depend(alpha) :: p=len(alpha) 10 | cf2py double precision intent(in) :: alpha 11 | cf2py double precision intent(in),depend(p),dimension(p) :: beta 12 | cf2py double precision intent(in),depend(p),dimension(p) :: gamma 13 | PHI(1) = 1. / GAMMA(1) 14 | IF (P.GE.1) THEN 15 | PHI(2) = (X - ALPHA(1)) * (PHI(1) / GAMMA(2)) 16 | END IF 17 | DO I=3,P 18 | PHI(I) = ((X - ALPHA(I-1)) * PHI(I-1) - BETA(I-1) * PHI(I-2)) / 19 | $ GAMMA(I) 20 | END DO 21 | 22 | RETURN 23 | 24 | END SUBROUTINE 25 | 26 | SUBROUTINE POLY_EVAL_ALL( N, X, PHI, P, ALPHA, BETA, GAMMA ) 27 | 28 | INTEGER N, P 29 | DOUBLE PRECISION X( N ), PHI( N, P ), ALPHA( P ), BETA( P ), 30 | $ GAMMA( P ) 31 | cf2py integer intent(hide),depend(x) :: n=len(x) 32 | cf2py integer intent(hide),depend(alpha) :: p=len(alpha) 33 | cf2py double precision intent(in) :: x 34 | cf2py double precision intent(out),depend(n,p),dimension(n,p) :: phi 35 | cf2py double precision intent(in) :: alpha 36 | cf2py double precision intent(in),depend(p),dimension(p) :: beta 37 | cf2py double precision intent(in),depend(p),dimension(p) :: gamma 38 | DO I=1,N 39 | CALL POLY_EVAL( X(I), PHI(I,:), P, ALPHA, BETA, GAMMA ) 40 | END DO 41 | 42 | RETURN 43 | 44 | END SUBROUTINE 45 | 46 | SUBROUTINE POLY_DEVAL(X, DPHI, PHI, P, ALPHA, BETA, GAMMA) 47 | 48 | INTEGER P 49 | DOUBLE PRECISION X 50 | DOUBLE PRECISION ALPHA( P ), BETA( P ), GAMMA( P ), 51 | $ PHI( P ), DPHI( P ) 52 | cf2py double precision intent(in) :: x 53 | cf2py double precision intent(out),depend(p),dimension(p) :: dphi 54 | cf2py integer intent(hide),depend(alpha) :: p=len(alpha) 55 | cf2py double precision intent(in), alpha 56 | cf2py double precision intent(in),depend(p),dimension(p) :: beta 57 | cf2py double precision intent(in),depend(p),dimension(p) :: gamma 58 | cf2py double precision intent(hide),depend(p),dimension(p) :: phi 59 | 60 | CALL POLY_EVAL( X, PHI, P, ALPHA, BETA, GAMMA ) 61 | DPHI(1) = 0. 62 | IF (P.GE.1) THEN 63 | DPHI(2) = PHI(1) / GAMMA(1) 64 | END IF 65 | DO I=3,P 66 | DPHI(I) = (PHI(I-1) + (X - ALPHA(I-1)) * DPHI(I-1) 67 | $ - BETA(I-1) * DPHI(I-2)) / GAMMA(I) 68 | END DO 69 | 70 | RETURN 71 | 72 | END SUBROUTINE 73 | 74 | SUBROUTINE POLY_DEVAL_ALL( N, X, DPHI, PHI, P, ALPHA, BETA, 75 | $ GAMMA ) 76 | 77 | INTEGER N, P 78 | DOUBLE PRECISION X( N ), PHI( N, P ), ALPHA( P ), BETA( P ), 79 | $ GAMMA( P ), DPHI( N, P ) 80 | cf2py integer intent(hide),depend(x) :: n=len(x) 81 | cf2py integer intent(hide),depend(alpha) :: p=len(alpha) 82 | cf2py double precision intent(in) :: x 83 | cf2py double precision intent(hide),depend(n,p),dimension(n,p) :: phi 84 | cf2py double precision intent(out),depend(n,p),dimension(n,p) :: dphi 85 | cf2py double precision intent(in) :: alpha 86 | cf2py double precision intent(in),depend(p),dimension(p) :: beta 87 | cf2py double precision intent(in),depend(p),dimension(p) :: gamma 88 | DO I=1,N 89 | CALL POLY_DEVAL( X(I), DPHI(I,:), PHI(I, :), P, ALPHA, BETA, 90 | $ GAMMA ) 91 | END DO 92 | 93 | RETURN 94 | 95 | END SUBROUTINE 96 | 97 | SUBROUTINE POLY_NORMALIZE( P, BETA, GAMMA ) 98 | 99 | IMPLICIT NONE 100 | 101 | INTEGER P 102 | DOUBLE PRECISION BETA( P ), GAMMA( P ) 103 | cf2py integer intent(in),depend(beta) :: p=len(beta) 104 | cf2py double precision intent(in,out,copy) :: beta 105 | cf2py double precision intent(in,out,copy),depend(p),dimension(p) :: gamma 106 | INTEGER I 107 | 108 | BETA(1) = SQRT(BETA(1)) 109 | GAMMA(1) = BETA(1) 110 | DO I=1,P 111 | BETA(I) = SQRT(BETA(I) * GAMMA(I)) 112 | GAMMA(I) = BETA(I) 113 | END DO 114 | 115 | RETURN 116 | 117 | END SUBROUTINE 118 | 119 | INTEGER FUNCTION N_CHOOSE_K( N, K ) 120 | 121 | IMPLICIT NONE 122 | 123 | INTEGER N, K 124 | 125 | INTEGER NUM, DEN, I, L 126 | 127 | NUM = 1 128 | DEN = 1 129 | L = MIN(N-K, K) 130 | DO I=0,L-1 131 | NUM = NUM * (N - I) 132 | DEN = DEN * (I + L) 133 | END DO 134 | 135 | N_CHOOSE_K = NUM / DEN 136 | 137 | RETURN 138 | 139 | END FUNCTION 140 | -------------------------------------------------------------------------------- /src/r1mach.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION R1MACH(I) 2 | INTEGER I 3 | C 4 | C SINGLE-PRECISION MACHINE CONSTANTS 5 | C R1MACH(1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. 6 | C R1MACH(2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE. 7 | C R1MACH(3) = B**(-T), THE SMALLEST RELATIVE SPACING. 8 | C R1MACH(4) = B**(1-T), THE LARGEST RELATIVE SPACING. 9 | C R1MACH(5) = LOG10(B) 10 | C 11 | INTEGER SMALL(2) 12 | INTEGER LARGE(2) 13 | INTEGER RIGHT(2) 14 | INTEGER DIVER(2) 15 | INTEGER LOG10(2) 16 | C needs to be (2) for AUTODOUBLE, HARRIS SLASH 6, ... 17 | INTEGER SC 18 | SAVE SMALL, LARGE, RIGHT, DIVER, LOG10, SC 19 | REAL RMACH(5) 20 | EQUIVALENCE (RMACH(1),SMALL(1)) 21 | EQUIVALENCE (RMACH(2),LARGE(1)) 22 | EQUIVALENCE (RMACH(3),RIGHT(1)) 23 | EQUIVALENCE (RMACH(4),DIVER(1)) 24 | EQUIVALENCE (RMACH(5),LOG10(1)) 25 | INTEGER J, K, L, T3E(3) 26 | DATA T3E(1) / 9777664 / 27 | DATA T3E(2) / 5323660 / 28 | DATA T3E(3) / 46980 / 29 | C THIS VERSION ADAPTS AUTOMATICALLY TO MOST CURRENT MACHINES, 30 | C INCLUDING AUTO-DOUBLE COMPILERS. 31 | C TO COMPILE ON OLDER MACHINES, ADD A C IN COLUMN 1 32 | C ON THE NEXT LINE 33 | DATA SC/0/ 34 | C AND REMOVE THE C FROM COLUMN 1 IN ONE OF THE SECTIONS BELOW. 35 | C CONSTANTS FOR EVEN OLDER MACHINES CAN BE OBTAINED BY 36 | C mail netlib@research.bell-labs.com 37 | C send old1mach from blas 38 | C PLEASE SEND CORRECTIONS TO dmg OR ehg@bell-labs.com. 39 | C 40 | C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. 41 | C DATA RMACH(1) / O402400000000 / 42 | C DATA RMACH(2) / O376777777777 / 43 | C DATA RMACH(3) / O714400000000 / 44 | C DATA RMACH(4) / O716400000000 / 45 | C DATA RMACH(5) / O776464202324 /, SC/987/ 46 | C 47 | C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING 48 | C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). 49 | C DATA SMALL(1) / 8388608 / 50 | C DATA LARGE(1) / 2147483647 / 51 | C DATA RIGHT(1) / 880803840 / 52 | C DATA DIVER(1) / 889192448 / 53 | C DATA LOG10(1) / 1067065499 /, SC/987/ 54 | C DATA RMACH(1) / O00040000000 / 55 | C DATA RMACH(2) / O17777777777 / 56 | C DATA RMACH(3) / O06440000000 / 57 | C DATA RMACH(4) / O06500000000 / 58 | C DATA RMACH(5) / O07746420233 /, SC/987/ 59 | C 60 | C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. 61 | C DATA RMACH(1) / O000400000000 / 62 | C DATA RMACH(2) / O377777777777 / 63 | C DATA RMACH(3) / O146400000000 / 64 | C DATA RMACH(4) / O147400000000 / 65 | C DATA RMACH(5) / O177464202324 /, SC/987/ 66 | C 67 | IF (SC .NE. 987) THEN 68 | * *** CHECK FOR AUTODOUBLE *** 69 | SMALL(2) = 0 70 | RMACH(1) = 1E13 71 | IF (SMALL(2) .NE. 0) THEN 72 | * *** AUTODOUBLED *** 73 | IF ( SMALL(1) .EQ. 1117925532 74 | * .AND. SMALL(2) .EQ. -448790528) THEN 75 | * *** IEEE BIG ENDIAN *** 76 | SMALL(1) = 1048576 77 | SMALL(2) = 0 78 | LARGE(1) = 2146435071 79 | LARGE(2) = -1 80 | RIGHT(1) = 1017118720 81 | RIGHT(2) = 0 82 | DIVER(1) = 1018167296 83 | DIVER(2) = 0 84 | LOG10(1) = 1070810131 85 | LOG10(2) = 1352628735 86 | ELSE IF ( SMALL(2) .EQ. 1117925532 87 | * .AND. SMALL(1) .EQ. -448790528) THEN 88 | * *** IEEE LITTLE ENDIAN *** 89 | SMALL(2) = 1048576 90 | SMALL(1) = 0 91 | LARGE(2) = 2146435071 92 | LARGE(1) = -1 93 | RIGHT(2) = 1017118720 94 | RIGHT(1) = 0 95 | DIVER(2) = 1018167296 96 | DIVER(1) = 0 97 | LOG10(2) = 1070810131 98 | LOG10(1) = 1352628735 99 | ELSE IF ( SMALL(1) .EQ. -2065213935 100 | * .AND. SMALL(2) .EQ. 10752) THEN 101 | * *** VAX WITH D_FLOATING *** 102 | SMALL(1) = 128 103 | SMALL(2) = 0 104 | LARGE(1) = -32769 105 | LARGE(2) = -1 106 | RIGHT(1) = 9344 107 | RIGHT(2) = 0 108 | DIVER(1) = 9472 109 | DIVER(2) = 0 110 | LOG10(1) = 546979738 111 | LOG10(2) = -805796613 112 | ELSE IF ( SMALL(1) .EQ. 1267827943 113 | * .AND. SMALL(2) .EQ. 704643072) THEN 114 | * *** IBM MAINFRAME *** 115 | SMALL(1) = 1048576 116 | SMALL(2) = 0 117 | LARGE(1) = 2147483647 118 | LARGE(2) = -1 119 | RIGHT(1) = 856686592 120 | RIGHT(2) = 0 121 | DIVER(1) = 873463808 122 | DIVER(2) = 0 123 | LOG10(1) = 1091781651 124 | LOG10(2) = 1352628735 125 | ELSE 126 | WRITE(*,9010) 127 | STOP 777 128 | END IF 129 | ELSE 130 | RMACH(1) = 1234567. 131 | IF (SMALL(1) .EQ. 1234613304) THEN 132 | * *** IEEE *** 133 | SMALL(1) = 8388608 134 | LARGE(1) = 2139095039 135 | RIGHT(1) = 864026624 136 | DIVER(1) = 872415232 137 | LOG10(1) = 1050288283 138 | ELSE IF (SMALL(1) .EQ. -1271379306) THEN 139 | * *** VAX *** 140 | SMALL(1) = 128 141 | LARGE(1) = -32769 142 | RIGHT(1) = 13440 143 | DIVER(1) = 13568 144 | LOG10(1) = 547045274 145 | ELSE IF (SMALL(1) .EQ. 1175639687) THEN 146 | * *** IBM MAINFRAME *** 147 | SMALL(1) = 1048576 148 | LARGE(1) = 2147483647 149 | RIGHT(1) = 990904320 150 | DIVER(1) = 1007681536 151 | LOG10(1) = 1091781651 152 | ELSE IF (SMALL(1) .EQ. 1251390520) THEN 153 | * *** CONVEX C-1 *** 154 | SMALL(1) = 8388608 155 | LARGE(1) = 2147483647 156 | RIGHT(1) = 880803840 157 | DIVER(1) = 889192448 158 | LOG10(1) = 1067065499 159 | ELSE 160 | DO 10 L = 1, 3 161 | J = SMALL(1) / 10000000 162 | K = SMALL(1) - 10000000*J 163 | IF (K .NE. T3E(L)) GO TO 20 164 | SMALL(1) = J 165 | 10 CONTINUE 166 | * *** CRAY T3E *** 167 | CALL I1MCRA(SMALL, K, 16, 0, 0) 168 | CALL I1MCRA(LARGE, K, 32751, 16777215, 16777215) 169 | CALL I1MCRA(RIGHT, K, 15520, 0, 0) 170 | CALL I1MCRA(DIVER, K, 15536, 0, 0) 171 | CALL I1MCRA(LOG10, K, 16339, 4461392, 10451455) 172 | GO TO 30 173 | 20 CALL I1MCRA(J, K, 16405, 9876536, 0) 174 | IF (SMALL(1) .NE. J) THEN 175 | WRITE(*,9020) 176 | STOP 777 177 | END IF 178 | * *** CRAY 1, XMP, 2, AND 3 *** 179 | CALL I1MCRA(SMALL(1), K, 8195, 8388608, 1) 180 | CALL I1MCRA(LARGE(1), K, 24574, 16777215, 16777214) 181 | CALL I1MCRA(RIGHT(1), K, 16338, 8388608, 0) 182 | CALL I1MCRA(DIVER(1), K, 16339, 8388608, 0) 183 | CALL I1MCRA(LOG10(1), K, 16383, 10100890, 8715216) 184 | END IF 185 | END IF 186 | 30 SC = 987 187 | END IF 188 | * SANITY CHECK 189 | IF (RMACH(4) .GE. 1.0) STOP 776 190 | IF (I .LT. 1 .OR. I .GT. 5) THEN 191 | WRITE(*,*) 'R1MACH(I): I =',I,' is out of bounds.' 192 | STOP 193 | END IF 194 | R1MACH = RMACH(I) 195 | RETURN 196 | 9010 FORMAT(/' Adjust autodoubled R1MACH by getting data'/ 197 | *' appropriate for your machine from D1MACH.') 198 | 9020 FORMAT(/' Adjust R1MACH by uncommenting data statements'/ 199 | *' appropriate for your machine.') 200 | * /* C source for R1MACH -- remove the * in column 1 */ 201 | *#include 202 | *#include 203 | *#include 204 | *float r1mach_(long *i) 205 | *{ 206 | * switch(*i){ 207 | * case 1: return FLT_MIN; 208 | * case 2: return FLT_MAX; 209 | * case 3: return FLT_EPSILON/FLT_RADIX; 210 | * case 4: return FLT_EPSILON; 211 | * case 5: return log10((double)FLT_RADIX); 212 | * } 213 | * fprintf(stderr, "invalid argument: r1mach(%ld)\n", *i); 214 | * exit(1); return 0; /* else complaint of missing return value */ 215 | *} 216 | END 217 | SUBROUTINE I1MCRA(A, A1, B, C, D) 218 | **** SPECIAL COMPUTATION FOR CRAY MACHINES **** 219 | INTEGER A, A1, B, C, D 220 | A1 = 16777216*B + C 221 | A = 16777216*A1 + D 222 | END 223 | -------------------------------------------------------------------------------- /src/schri.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine chri(n,iopt,a,b,x,y,hr,hi,alpha,beta,ierr) 4 | c 5 | c This subroutine implements the Christoffel or generalized Christoffel 6 | c theorem. In all cases except iopt=7, it uses nonlinear recurrence 7 | c algorithms described in W. Gautschi,An algorithmic implementation 8 | c of the generalized Christoffel theorem'', Numerical Integration 9 | c (G. Haemmerlin, ed.), Birkhaeuser, Basel, 1982, pp. 89-106. The case 10 | c iopt=7 incorporates a QR step with shift x in the manner of 11 | c J. Kautsky and G.H. Golub, On the calculation of Jacobi matrices'', 12 | c Linear Algebra Appl. 52/53, 1983, 439-455, using the algorithm of 13 | c Eq. (67.11) on p. 567 in J.H. Wilkinson,The Algebraic Eigenvalue 14 | c Problem'', Clarendon Press, Oxford, 1965. Given the recursion 15 | c coefficients a(k),b(k), k=0,1,...,n, for the (monic) orthogonal 16 | c polynomials with respect to some measure dlambda(t), it generates 17 | c the recursion coefficients alpha(k),beta(k), k=0,1,...,n-1, for the 18 | c measure 19 | c 20 | c (t-x)dlambda(t) if iopt=1 21 | c [(t-x)**2+y**2]dlambda(t) if iopt=2 22 | c (t**2+y**2)dlambda(t) with if iopt=3 23 | c dlambda(t) and supp(dlambda) 24 | c symmetric with respect to 25 | c the origin 26 | c dlambda(t)/(t-x) if iopt=4 27 | c dlambda(t)/[(t-x)**2+y**2] if iopt=5 28 | c dlambda(t)/(t**2+y**2) with if iopt=6 29 | c dlambda(t) and supp(dlambda) 30 | c symmetric with respect to 31 | c the origin 32 | c [(t-x)**2]dlambda(t) if iopt=7 33 | c 34 | c 35 | c Input: n - - - the number of recurrence coefficients 36 | c desired; type integer 37 | c iopt - - an integer selecting the desired weight 38 | c distribution 39 | c a,b - - arrays of dimension n+1 containing the 40 | c recursion coefficients a(k-1),b(k-1),k=1,2, 41 | c ...,n+1, of the polynomials orthogonal with 42 | c respect to the given measure dlambda(t) 43 | c x,y - - real parameters defining the linear and 44 | c quadratic factors, or divisors, of dlambda(t) 45 | c hr,hi - the real and imaginary part, respectively, of 46 | c the integral of dlambda(t)/(z-t), where z=x+iy; 47 | c the parameter hr is used only if iopt=4 or 48 | c 5, the parameter hi only if iopt=5 or 6 49 | c 50 | c Output: alpha,beta - - arrays of dimension n containing the 51 | c desired recursion coefficients alpha(k-1), 52 | c beta(k-1), k=1,2,...,n 53 | c 54 | c It is assumed that n is larger than or equal to 2. Otherwise, the 55 | c routine exits immediately with the error flag ierr set equal to 1. 56 | c If iopt is not between 1 and 7, the routine exits with ierr=2. 57 | c 58 | c The routine uses the function subroutine r1mach to evaluate the 59 | c constant eps , which is used only if iopt=7. 60 | c 61 | dimension a(*),b(*),alpha(n),beta(n) 62 | c 63 | c The arrays a,b are assumed to have dimension n+1. 64 | c 65 | eps=5.*r1mach(3) 66 | c 67 | c The quantity eps is a constant slightly larger than the machine 68 | c precision. 69 | c 70 | ierr=0 71 | if(n.lt.2) then 72 | ierr=1 73 | return 74 | end if 75 | c 76 | c What follows implements Eq. (3.7) of W. Gautschi, op. cit. 77 | c 78 | if (iopt.eq.1) then 79 | e=0. 80 | do 10 k=1,n 81 | q=a(k)-e-x 82 | beta(k)=q*e 83 | e=b(k+1)/q 84 | alpha(k)=x+q+e 85 | 10 continue 86 | c 87 | c Set the first beta-coefficient as discussed in Section 5.1 of the 88 | c companion paper. 89 | c 90 | beta(1)=b(1)*(a(1)-x) 91 | return 92 | c 93 | c What follows implements Eq. (4.7) of W. Gautschi, op. cit. 94 | c 95 | else if(iopt.eq.2) then 96 | s=x-a(1) 97 | t=y 98 | eio=0. 99 | do 20 k=1,n 100 | d=s*s+t*t 101 | er=-b(k+1)*s/d 102 | ei=b(k+1)*t/d 103 | s=x+er-a(k+1) 104 | t=y+ei 105 | alpha(k)=x+t*er/ei-s*ei/t 106 | beta(k)=t*eio*(1.+(er/ei)**2) 107 | eio=ei 108 | 20 continue 109 | c 110 | c Set the first beta-coefficient. 111 | c 112 | beta(1)=b(1)*(b(2)+(a(1)-x)**2+y*y) 113 | return 114 | c 115 | c What follows implements Eq. (4.8) of W. Gautschi, op. cit. 116 | c 117 | else if(iopt.eq.3) then 118 | t=y 119 | eio=0. 120 | do 30 k=1,n 121 | ei=b(k+1)/t 122 | t=y+ei 123 | alpha(k)=0. 124 | beta(k)=t*eio 125 | eio=ei 126 | 30 continue 127 | c 128 | c Set the first beta-coefficient. 129 | c 130 | beta(1)=b(1)*(b(2)+y*y) 131 | return 132 | c 133 | c What follows implements Eqs. (5.1),(5.2) of W. Gautschi, op. cit. 134 | c 135 | else if(iopt.eq.4) then 136 | alpha(1)=x-b(1)/hr 137 | beta(1)=-hr 138 | q=-b(1)/hr 139 | do 40 k=2,n 140 | e=a(k-1)-x-q 141 | beta(k)=q*e 142 | q=b(k)/e 143 | alpha(k)=q+e+x 144 | 40 continue 145 | return 146 | c 147 | c What follows implements Eq. (5.8) of W. Gautschi, op. cit. 148 | c 149 | else if(iopt.eq.5) then 150 | nm1=n-1 151 | d=hr*hr+hi*hi 152 | eroo=a(1)-x+b(1)*hr/d 153 | eioo=-b(1)*hi/d-y 154 | alpha(1)=x+hr*y/hi 155 | beta(1)=-hi/y 156 | alpha(2)=x-b(1)*hi*eroo/(d*eioo)+hr*eioo/hi 157 | beta(2)=y*eioo*(1.+(hr/hi)**2) 158 | if(n.eq.2) return 159 | so=b(2)/(eroo**2+eioo**2) 160 | ero=a(2)-x-so*eroo 161 | eio=so*eioo-y 162 | alpha(3)=x+eroo*eio/eioo+so*eioo*ero/eio 163 | beta(3)=-b(1)*hi*eio*(1.+(eroo/eioo)**2)/d 164 | if(n.eq.3) return 165 | do 50 k=3,nm1 166 | s=b(k)/(ero**2+eio**2) 167 | er=a(k)-x-s*ero 168 | ei=s*eio-y 169 | alpha(k+1)=x+ero*ei/eio+s*eio*er/ei 170 | beta(k+1)=so*eioo*ei*(1.+(ero/eio)**2) 171 | eroo=ero 172 | eioo=eio 173 | ero=er 174 | eio=ei 175 | so=s 176 | 50 continue 177 | return 178 | c 179 | c What follows implements Eq. (5.9) of W. Gautschi, op. cit. 180 | c 181 | else if(iopt.eq.6) then 182 | nm1=n-1 183 | eoo=-b(1)/hi-y 184 | eo=b(2)/eoo-y 185 | alpha(1)=0. 186 | beta(1)=-hi/y 187 | alpha(2)=0. 188 | beta(2)=y*eoo 189 | if(n.eq.2) return 190 | alpha(3)=0. 191 | beta(3)=-b(1)*eo/hi 192 | if(n.eq.3) return 193 | do 60 k=3,nm1 194 | e=b(k)/eo-y 195 | beta(k+1)=b(k-1)*e/eoo 196 | alpha(k+1)=0. 197 | eoo=eo 198 | eo=e 199 | 60 continue 200 | return 201 | c 202 | c What follows implements a QR step with shift x. 203 | c 204 | else if(iopt.eq.7) then 205 | u=0. 206 | c=1. 207 | c0=0. 208 | do 70 k=1,n 209 | gamma=a(k)-x-u 210 | cm1=c0 211 | c0=c 212 | if(abs(c0).gt.eps) then 213 | p2=(gamma**2)/c0 214 | else 215 | p2=cm1*b(k) 216 | end if 217 | if(k.gt.1) beta(k)=s*(p2+b(k+1)) 218 | s=b(k+1)/(p2+b(k+1)) 219 | c=p2/(p2+b(k+1)) 220 | u=s*(gamma+a(k+1)-x) 221 | alpha(k)=gamma+u+x 222 | 70 continue 223 | beta(1)=b(1)*(b(2)+(x-a(1))**2) 224 | return 225 | else 226 | ierr=2 227 | return 228 | end if 229 | end 230 | 231 | -------------------------------------------------------------------------------- /src/sfejer.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine sfejer(n,x,w) 4 | c 5 | c This routine generates the n-point Fejer quadrature rule. 6 | c 7 | c input: n - the number of quadrature nodes 8 | c output: x,w - arrays of dimension n holding the quadrature 9 | c nodes and weights, respectively; the nodes 10 | c are ordered increasingly 11 | c 12 | dimension x(n),w(n) 13 | cf2py integer intent(in) :: n 14 | cf2py real intent(out),depend(n),dimension(n) :: x 15 | cf2py real intent(out),depend(n),dimension(n) :: w 16 | pi=4.*atan(1.) 17 | nh=n/2 18 | np1h=(n+1)/2 19 | fn=real(n) 20 | do 10 k=1,nh 21 | x(n+1-k)=cos(.5*real(2*k-1)*pi/fn) 22 | x(k)=-x(n+1-k) 23 | 10 continue 24 | if(2*nh.ne.n) x(np1h)=0. 25 | do 30 k=1,np1h 26 | c1=1. 27 | c0=2.*x(k)*x(k)-1. 28 | t=2.*c0 29 | sum=c0/3. 30 | do 20 m=2,nh 31 | c2=c1 32 | c1=c0 33 | c0=t*c1-c2 34 | sum=sum+c0/real(4*m*m-1) 35 | 20 continue 36 | w(k)=2.*(1.-2.*sum)/fn 37 | w(n+1-k)=w(k) 38 | 30 continue 39 | return 40 | end 41 | 42 | -------------------------------------------------------------------------------- /src/sgauss.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine sgauss(n,alpha,beta,eps,zero,weight,ierr,e) 4 | c 5 | c Given n and a measure dlambda, this routine generates the n-point 6 | c Gaussian quadrature formula 7 | c 8 | c integral over supp(dlambda) of f(x)dlambda(x) 9 | c 10 | c = sum from k=1 to k=n of w(k)f(x(k)) + R(n;f). 11 | c 12 | c The nodes are returned as zero(k)=x(k) and the weights as 13 | c weight(k)=w(k), k=1,2,...,n. The user has to supply the recursion 14 | c coefficients alpha(k), beta(k), k=0,1,2,...,n-1, for the measure 15 | c dlambda. The routine computes the nodes as eigenvalues, and the 16 | c weights in term of the first component of the respective normalized 17 | c eigenvectors of the n-th order Jacobi matrix associated with dlambda. 18 | c It uses a translation and adaptation of the algol procedure imtql2, 19 | c Numer. Math. 12, 1968, 377-383, by Martin and Wilkinson, as modified 20 | c by Dubrulle, Numer. Math. 15, 1970, 450. See also Handbook for 21 | c Autom. Comput., vol. 2 - Linear Algebra, pp.241-248, and the eispack 22 | c routine imtql2. 23 | c 24 | c Input: n - - the number of points in the Gaussian quadrature 25 | c formula; type integer 26 | c alpha,beta - - arrays of dimension n to be filled 27 | c with the values of alpha(k-1), beta(k-1), k=1,2, 28 | c ...,n 29 | c eps - the relative accuracy desired in the nodes 30 | c and weights 31 | c 32 | c Output: zero- array of dimension n containing the Gaussian 33 | c nodes (in increasing order) zero(k)=x(k), k=1,2, 34 | c ...,n 35 | c weight - array of dimension n containing the 36 | c Gaussian weights weight(k)=w(k), k=1,2,...,n 37 | c ierr- an error flag equal to 0 on normal return, 38 | c equal to i if the QR algorithm does not 39 | c converge within 30 iterations on evaluating the 40 | c i-th eigenvalue, equal to -1 if n is not in 41 | c range, and equal to -2 if one of the beta's is 42 | c negative. 43 | c 44 | c The array e is needed for working space. 45 | c 46 | dimension alpha(n),beta(n),zero(n),weight(n),e(n) 47 | cf2py integer intent(hide),depend(alpha) :: n=len(alpha) 48 | cf2py real intent(in) :: alpha 49 | cf2py real intent(in),depend(n),dimension(n) :: beta 50 | cf2py real optional, intent(in) :: eps=1e-6 51 | cf2py real intent(out),depend(n),dimension(n) :: zero 52 | cf2py real intent(out),depend(n),dimension(n) :: weight 53 | cf2py integer intent(out) :: ierr 54 | cf2py real intent(hide),depend(n),dimension(n) :: e 55 | if(n.lt.1) then 56 | ierr=-1 57 | return 58 | end if 59 | ierr=0 60 | zero(1)=alpha(1) 61 | if(beta(1).lt.0.) then 62 | ierr=-2 63 | return 64 | end if 65 | weight(1)=beta(1) 66 | if (n.eq.1) return 67 | weight(1)=1. 68 | e(n)=0. 69 | do 100 k=2,n 70 | zero(k)=alpha(k) 71 | if(beta(k).lt.0.) then 72 | ierr=-2 73 | return 74 | end if 75 | e(k-1)=sqrt(beta(k)) 76 | weight(k)=0. 77 | 100 continue 78 | do 240 l=1,n 79 | j=0 80 | c 81 | c Look for a small subdiagonal element. 82 | c 83 | 105 do 110 m=l,n 84 | if(m.eq.n) goto 120 85 | if(abs(e(m)).le.eps*(abs(zero(m))+abs(zero(m+1)))) goto 120 86 | 110 continue 87 | 120 p=zero(l) 88 | if(m.eq.l) goto 240 89 | if(j.eq.30) goto 400 90 | j=j+1 91 | c 92 | c Form shift. 93 | c 94 | g=(zero(l+1)-p)/(2.*e(l)) 95 | r=sqrt(g*g+1.) 96 | g=zero(m)-p+e(l)/(g+sign(r,g)) 97 | s=1. 98 | c=1. 99 | p=0. 100 | mml=m-l 101 | c 102 | c For i=m-1 step -1 until l do ... 103 | c 104 | do 200 ii=1,mml 105 | i=m-ii 106 | f=s*e(i) 107 | b=c*e(i) 108 | if(abs(f).lt.abs(g)) goto 150 109 | c=g/f 110 | r=sqrt(c*c+1.) 111 | e(i+1)=f*r 112 | s=1./r 113 | c=c*s 114 | goto 160 115 | 150 s=f/g 116 | r=sqrt(s*s+1.) 117 | e(i+1)=g*r 118 | c=1./r 119 | s=s*c 120 | 160 g=zero(i+1)-p 121 | r=(zero(i)-g)*s +2.*c*b 122 | p=s*r 123 | zero(i+1)=g+p 124 | g=c*r-b 125 | c 126 | c Form first component of vector. 127 | c 128 | f=weight(i+1) 129 | weight(i+1)=s*weight(i)+c*f 130 | weight(i)=c*weight(i)-s*f 131 | 200 continue 132 | zero(l)=zero(l)-p 133 | e(l)=g 134 | e(m)=0. 135 | goto 105 136 | 240 continue 137 | c 138 | c Order eigenvalues and eigenvectors. 139 | c 140 | do 300 ii=2,n 141 | i=ii-1 142 | k=i 143 | p=zero(i) 144 | do 260 j=ii,n 145 | if(zero(j).ge.p) goto 260 146 | k=j 147 | p=zero(j) 148 | 260 continue 149 | if(k.eq.i) goto 300 150 | zero(k)=zero(i) 151 | zero(i)=p 152 | p=weight(i) 153 | weight(i)=weight(k) 154 | weight(k)=p 155 | 300 continue 156 | do 310 k=1,n 157 | weight(k)=beta(1)*weight(k)*weight(k) 158 | 310 continue 159 | return 160 | c 161 | c Set error - no convergence to an eigenvalue after 30 iterations. 162 | c 163 | 400 ierr=l 164 | return 165 | end 166 | 167 | -------------------------------------------------------------------------------- /src/skern.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine kern(n,nu0,numax,z,eps,a,b,ker,nu,ierr,rold) 4 | c 5 | c This routine generates the kernels in the Gauss quadrature remainder 6 | c term, namely 7 | c 8 | c K(k)(z)=rho(k)(z)/pi(k)(z), k=0,1,2,...,n, 9 | c 10 | c where rho(k) are the output quantities of the routine knum, and 11 | c pi(k) the (monic) orthogonal polynomials. The results are returned 12 | c in the array ker as ker(k)=K(k-1)(z), k=1,2,...,n+1. All the other 13 | c input and output parameters have the same meaning as in the routine 14 | c knum. 15 | c 16 | complex z,ker,rold,p0,p,pm1 17 | dimension a(numax),b(numax),ker(*),rold(*) 18 | c 19 | c The arrays ker,rold are assumed to have dimension n+1. 20 | c 21 | call knum(n,nu0,numax,z,eps,a,b,ker,nu,ierr,rold) 22 | p0=(0.,0.) 23 | p=(1.,0.) 24 | do 10 k=1,n 25 | pm1=p0 26 | p0=p 27 | p=(z-a(k))*p0-b(k)*pm1 28 | ker(k+1)=ker(k+1)/p 29 | 10 continue 30 | return 31 | end 32 | 33 | -------------------------------------------------------------------------------- /src/sknum.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine knum(n,nu0,numax,z,eps,a,b,rho,nu,ierr,rold) 4 | c 5 | c This routine generates 6 | c 7 | c rho(k)(z)=integral pi(k)(t)dlambda(t)/(z-t), k=0,1,2,...,n, 8 | c 9 | c where pi(k)(t) is the (monic) k-th degree orthogonal polynomial 10 | c with respect to the measure dlambda(t), and the integral is extended 11 | c over the support of dlambda. It is assumed that z is a complex 12 | c number outside the smallest interval containing the support of 13 | c dlambda. The quantities rho(k)(z) are computed as the first n+1 14 | c members of the minimal solution of the basic three-term recurrence 15 | c relation 16 | c 17 | c y(k+1)(z)=(z-a(k))y(k)(z)-b(k)y(k-1)(z), k=0,1,2,..., 18 | c 19 | c satisfied by the orthogonal polynomials pi(k)(z). 20 | c 21 | c Input: n - - the largest integer k for which rho(k) is 22 | c desired 23 | c nu0 - an estimate of the starting backward recurrence 24 | c index; if no better estimate is known, set 25 | c nu0 = 3*n/2; for Jacobi, Laguerre and Hermite 26 | c weight functions, estimates of nu0 are generated 27 | c respectively by the routines nu0jac,nu0lag and 28 | c nu0her 29 | c numax - an integer larger than n cutting off backward 30 | c recursion in case of nonconvergence; if nu0 31 | c exceeds numax, then the routine aborts with the 32 | c error flag ierr set equal to nu0 33 | c z - - - the variable in rho(k)(z); type complex 34 | c eps - - the relative accuracy to which the rho(k) are 35 | c desired 36 | c a,b - - arrays of dimension numax to be supplied with the 37 | c recurrence coefficients a(k-1), b(k-1), k=1,2,..., 38 | c numax. 39 | c 40 | c Output: rho - - an array of dimension n+1 containing the results 41 | c rho(k)=rho(k-1)(z), k=1,2,...,n+1; type complex 42 | c nu - - the starting backward recurrence index that yields 43 | c convergence 44 | c ierr - an error flag equal to zero on normal return, equal 45 | c to nu0 if nu0 > numax, and equal to numax in 46 | c case of nonconvergence. 47 | c 48 | c The complex array rold of dimension n+1 is used for working space. 49 | c 50 | complex z,rho,rold,r 51 | dimension a(numax),b(numax),rho(*),rold(*) 52 | c 53 | c The arrays rho,rold are assumed to have dimension n+1. 54 | c 55 | ierr=0 56 | np1=n+1 57 | if(nu0.gt.numax) then 58 | ierr=nu0 59 | return 60 | end if 61 | if(nu0.lt.np1) nu0=np1 62 | nu=nu0-5 63 | do 10 k=1,np1 64 | rho(k)=(0.,0.) 65 | 10 continue 66 | 20 nu=nu+5 67 | if(nu.gt.numax) then 68 | ierr=numax 69 | goto 60 70 | end if 71 | do 30 k=1,np1 72 | rold(k)=rho(k) 73 | 30 continue 74 | r=(0.,0.) 75 | do 40 j=1,nu 76 | j1=nu-j+1 77 | r=cmplx(b(j1),0.)/(z-cmplx(a(j1),0.)-r) 78 | if(j1.le.np1) rho(j1)=r 79 | 40 continue 80 | do 50 k=1,np1 81 | if(cabs(rho(k)-rold(k)).gt.eps*cabs(rho(k))) goto 20 82 | 50 continue 83 | 60 if(n.eq.0) return 84 | do 70 k=2,np1 85 | rho(k)=rho(k)*rho(k-1) 86 | 70 continue 87 | return 88 | end 89 | 90 | -------------------------------------------------------------------------------- /src/slancz.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine slancz(n,ncap,x,w,alpha,beta,ierr,p0,p1) 4 | c 5 | c This routine carries out the same task as the routine sti, but 6 | c uses the more stable Lanczos method. The meaning of the input 7 | c and output parameters is the same as in the routine sti. (This 8 | c routine is adapted from the routine RKPW in W.B. Gragg and 9 | c W.J. Harrod,The numerically stable reconstruction of Jacobi 10 | c matrices from spectral data'', Numer. Math. 44, 1984, 317-335.) 11 | c 12 | dimension x(ncap),w(ncap),alpha(n),beta(n),p0(ncap),p1(ncap) 13 | cf2py integer intent(in) :: n 14 | cf2py integer intent(hide),depend(x) :: ncap=len(x) 15 | cf2py real intent(in) :: x 16 | cf2py real intent(in),depend(ncap),check(len(w)>=ncap) :: w 17 | cf2py real intent(out),depend(n),dimension(n) :: alpha 18 | cf2py real intent(out),depend(n),dimension(n) :: beta 19 | cf2py real intent(hide),depend(ncap),dimension(ncap) :: p0 20 | cf2py real intent(hide),depend(ncap),dimension(ncap) :: p1 21 | cf2py integer intent(out) :: ierr 22 | if(n.le.0 .or. n.gt.ncap) then 23 | ierr=1 24 | return 25 | else 26 | ierr=0 27 | end if 28 | do 10 i=1,ncap 29 | p0(i)=x(i) 30 | p1(i)=0. 31 | 10 continue 32 | p1(1)=w(1) 33 | do 30 i=1,ncap-1 34 | pi=w(i+1) 35 | gam=1. 36 | sig=0. 37 | t=0. 38 | xlam=x(i+1) 39 | do 20 k=1,i+1 40 | rho=p1(k)+pi 41 | tmp=gam*rho 42 | tsig=sig 43 | if(rho.le.0.) then 44 | gam=1. 45 | sig=0. 46 | else 47 | gam=p1(k)/rho 48 | sig=pi/rho 49 | end if 50 | tk=sig*(p0(k)-xlam)-gam*t 51 | p0(k)=p0(k)-(tk-t) 52 | t=tk 53 | if(sig.le.0.) then 54 | pi=tsig*p1(k) 55 | else 56 | pi=(t**2)/sig 57 | end if 58 | tsig=sig 59 | p1(k)=tmp 60 | 20 continue 61 | 30 continue 62 | do 40 k=1,n 63 | alpha(k)=p0(k) 64 | beta(k)=p1(k) 65 | 40 continue 66 | return 67 | end 68 | 69 | -------------------------------------------------------------------------------- /src/slob.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine slob(n,alpha,beta,aleft,right,zero,weight,ierr,e,a,b) 4 | c 5 | c Given n and a measure dlambda, this routine generates the 6 | c (n+2)-point Gauss-Lobatto quadrature formula 7 | c 8 | c integral over supp(dlambda) of f(x)dlambda(x) 9 | c 10 | c = w(0)f(x(0)) + sum from k=1 to k=n of w(k)f(x(k)) 11 | c 12 | c + w(n+1)f(x(n+1)) + R(n;f). 13 | c 14 | c The nodes are returned as zero(k)=x(k), the weights as weight(k) 15 | c =w(k), k=0,1,...,n,n+1. The user has to supply the recursion 16 | c coefficients alpha(k), beta(k), k=0,1,...,n,n+1, for the measure 17 | c dlambda. The nodes and weights are computed in terms of the 18 | c eigenvalues and first component of the normalized eigenvectors of 19 | c a slightly modified Jacobi matrix of order n+2. The routine calls 20 | c upon the subroutine gauss and the function subroutine r1mach. 21 | c 22 | c Input: n - - the number of interior points in the Gauss-Lobatto 23 | c formula; type integer 24 | c alpha,beta - arrays of dimension n+2 to be supplied with 25 | c the recursion coefficients alpha(k-1), beta(k-1), 26 | c k=1,2,...,n+2, of the underlying measure; the 27 | c routine does not use alpha(n+2), beta(n+2) 28 | c aleft,right - the prescribed left and right endpoints 29 | c x(0) and x(n+1) of the Gauss-Lobatto formula 30 | c 31 | c Output: zero - an array of dimension n+2 containing the nodes (in 32 | c increasing order) zero(k)=x(k), k=0,1,...,n,n+1 33 | c weight-an array of dimension n+2 containing the weights 34 | c weight(k)=w(k), k=0,1,...,n,n+1 35 | c ierr - an error flag inherited from the routine gauss 36 | c 37 | c The arrays e,a,b are needed for working space. 38 | c 39 | dimension alpha(*),beta(*),zero(*),weight(*),e(*),a(*),b(*) 40 | c 41 | c The arrays alpha,beta,zero,weight,e,a,b are assumed to have 42 | c dimension n+2. 43 | c 44 | cf2py integer intent(hide),depend(alpha) :: n=len(alpha) 45 | cf2py real intent(in) :: alpha 46 | cf2py real intent(in),depend(n),dimension(n) :: beta 47 | cf2py real intent(in) :: aleft 48 | cf2py real intent(in) :: right 49 | cf2py real intent(out),depend(n),dimension(n+2) :: zero 50 | cf2py real intent(out),depend(n),dimension(n+2) :: weight 51 | cf2py real intent(hide),depend(n),dimension(n+2) :: e 52 | cf2py real intent(hide),depend(n),dimension(n+2) :: a 53 | cf2py real intent(hide),depend(n),dimension(n+2) :: b 54 | cf2py integer intent(out) :: ierr 55 | epsma=r1mach(3) 56 | c 57 | c epsma is the machine single precision. 58 | c 59 | np1=n+1 60 | np2=n+2 61 | do 10 k=1,np2 62 | a(k)=alpha(k) 63 | b(k)=beta(k) 64 | 10 continue 65 | p0l=0. 66 | p0r=0. 67 | p1l=1. 68 | p1r=1. 69 | do 20 k=1,np1 70 | pm1l=p0l 71 | p0l=p1l 72 | pm1r=p0r 73 | p0r=p1r 74 | p1l=(aleft-a(k))*p0l-b(k)*pm1l 75 | p1r=(right-a(k))*p0r-b(k)*pm1r 76 | 20 continue 77 | det=p1l*p0r-p1r*p0l 78 | a(np2)=(aleft*p1l*p0r-right*p1r*p0l)/det 79 | b(np2)=(right-aleft)*p1l*p1r/det 80 | call sgauss(np2,a,b,epsma,zero,weight,ierr,e) 81 | return 82 | end 83 | 84 | -------------------------------------------------------------------------------- /src/sradau.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine sradau(n,alpha,beta,end,zero,weight,ierr,e,a,b) 4 | c 5 | c Given n and a measure dlambda, this routine generates the 6 | c (n+1)-point Gauss-Radau quadrature formula 7 | c 8 | c integral over supp(dlambda) of f(t)dlambda(t) 9 | c 10 | c = w(0)f(x(0)) + sum from k=1 to k=n of w(k)f(x(k)) + R(n;f). 11 | c 12 | c The nodes are returned as zero(k)=x(k), the weights as weight(k) 13 | c =w(k), k=0,1,2,...,n. The user has to supply the recursion 14 | c coefficients alpha(k), beta(k), k=0,1,2,...,n, for the measure 15 | c dlambda. The nodes and weights are computed as eigenvalues and 16 | c in terms of the first component of the respective normalized 17 | c eigenvectors of a slightly modified Jacobi matrix of order n+1. 18 | c To do this, the routine calls upon the subroutine gauss. It also 19 | c uses the function subroutine r1mach. 20 | c 21 | c Input: n - - the number of interior points in the Gauss-Radau 22 | c formula; type integer 23 | c alpha,beta - arrays of dimension n+1 to be supplied with 24 | c the recursion coefficients alpha(k-1), beta(k-1), 25 | c k=1,2,...,n+1; the coefficient alpha(n+1) is not 26 | c used by the routine 27 | c end - the prescribed endpoint x(0) of the Gauss-Radau 28 | c formula; type real 29 | c 30 | c Output: zero - array of dimension n+1 containing the nodes (in 31 | c increasing order) zero(k)=x(k), k=0,1,2,...,n 32 | c weight-array of dimension n+1 containing the weights 33 | c weight(k)=w(k), k=0,1,2,...,n 34 | c ierr - an error flag inherited from the routine gauss 35 | c 36 | c The arrays e,a,b are needed for working space. 37 | c 38 | dimension alpha(*),beta(*),zero(*),weight(*),e(*),a(*),b(*) 39 | c 40 | c The arrays alpha,beta,zero,weight,e,a,b are assumed to have 41 | c dimension n+1. 42 | cf2py integer intent(hide),depend(alpha) :: n=len(alpha) 43 | cf2py real intent(in) :: alpha 44 | cf2py real intent(in),depend(n),dimension(n) :: beta 45 | cf2py real intent(in) :: end 46 | cf2py real intent(out),depend(n),dimension(n+1) :: zero 47 | cf2py real intent(out),depend(n),dimension(n+1) :: weight 48 | cf2py real intent(hide),depend(n),dimension(n+1) :: e 49 | cf2py real intent(hide),depend(n),dimension(n+1) :: a 50 | cf2py real intent(hide),depend(n),dimension(n+1) :: b 51 | c 52 | epsma=r1mach(3) 53 | c 54 | c epsma is the machine single precision. 55 | c 56 | np1=n+1 57 | do 10 k=1,np1 58 | a(k)=alpha(k) 59 | b(k)=beta(k) 60 | 10 continue 61 | p0=0. 62 | p1=1. 63 | do 20 k=1,n 64 | pm1=p0 65 | p0=p1 66 | p1=(end-a(k))*p0-b(k)*pm1 67 | 20 continue 68 | a(np1)=end-b(np1)*p0/p1 69 | call sgauss(np1,a,b,epsma,zero,weight,ierr,e) 70 | return 71 | end 72 | 73 | -------------------------------------------------------------------------------- /src/srecur.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine srecur(n,ipoly,al,be,a,b,ierr) 4 | c 5 | c This subroutine generates the coefficients a(k),b(k), k=0,1,...,n-1, 6 | c in the recurrence relation 7 | c 8 | c p(k+1)(x)=(x-a(k))*p(k)(x)-b(k)*p(k-1)(x), 9 | c k=0,1,...,n-1, 10 | c 11 | c p(-1)(x)=0, p(0)(x)=1, 12 | c 13 | c for some classical (monic) orthogonal polynomials, and sets b(0) 14 | c equal to the total mass of the weight distribution. The results are 15 | c stored in the arrays a,b, which hold, respectively, the coefficients 16 | c a(k-1),b(k-1), k=1,2,...,n. 17 | c 18 | c Input: n - - the number of recursion coefficients desired 19 | c ipoly-integer identifying the polynomial as follows: 20 | c 1=Legendre polynomial on (-1,1) 21 | c 2=Legendre polynomial on (0,1) 22 | c 3=Chebyshev polynomial of the first kind 23 | c 4=Chebyshev polynomial of the second kind 24 | c 5=Jacobi polynomial with parameters al=-.5,be=.5 25 | c 6=Jacobi polynomial with parameters al,be 26 | c 7=generalized Laguerre polynomial with 27 | c parameter al 28 | c 8=Hermite polynomial 29 | c al,be-input parameters for Jacobi and generalized 30 | c Laguerre polynomials 31 | c 32 | c Output: a,b - arrays containing, respectively, the recursion 33 | c coefficients a(k-1),b(k-1), k=1,2,...,n. 34 | c ierr -an error flag, equal to 0 on normal return, 35 | c equal to 1 if al or be are out of range 36 | c when ipoly=6 or ipoly=7, equal to 2 if b(0) 37 | c overflows when ipoly=6 or ipoly=7, equal to 3 38 | c if n is out of range, and equal to 4 if ipoly 39 | c is not an admissible integer. In the case ierr=2, 40 | c the coefficient b(0) is set equal to the largest 41 | c machine-representable number. 42 | c 43 | c The subroutine calls for the function subroutines r1mach,gamma and 44 | c alga. The routines gamma and alga , which are included in this 45 | c file, evaluate respectively the gamma function and its logarithm for 46 | c positive arguments. They are used only in the cases ipoly=6 and 47 | c ipoly=7. 48 | c 49 | external gamma 50 | dimension a(n),b(n) 51 | cf2py integer intent(in) :: n 52 | cf2py integer intent(in) :: ipoly 53 | cf2py real optional,intent(in) :: al=-.5 54 | cf2py real optional,intent(in) :: be=.5 55 | cf2py real intent(out),depend(n),dimension(n) :: a 56 | cf2py real intent(out),depend(n),dimension(n) :: b 57 | cf2py integer intent(out) :: ierr 58 | if(n.lt.1) then 59 | ierr=3 60 | return 61 | end if 62 | almach=alog(r1mach(2)) 63 | ierr=0 64 | do 10 k=1,n 65 | a(k)=0. 66 | 10 continue 67 | if(ipoly.eq.1) then 68 | b(1)=2. 69 | if (n.eq.1) return 70 | do 20 k=2,n 71 | fkm1=real(k-1) 72 | b(k)=1./(4.-1./(fkm1*fkm1)) 73 | 20 continue 74 | return 75 | else if (ipoly.eq.2) then 76 | a(1)=.5 77 | b(1)=1. 78 | if(n.eq.1) return 79 | do 30 k=2,n 80 | a(k)=.5 81 | fkm1=real(k-1) 82 | b(k)=.25/(4.-1./(fkm1*fkm1)) 83 | 30 continue 84 | return 85 | else if(ipoly.eq.3) then 86 | b(1)=4.*atan(1.) 87 | if(n.eq.1) return 88 | b(2)=.5 89 | if(n.eq.2) return 90 | do 40 k=3,n 91 | b(k)=.25 92 | 40 continue 93 | return 94 | else if(ipoly.eq.4) then 95 | b(1)=2.*atan(1.) 96 | if(n.eq.1) return 97 | do 50 k=2,n 98 | b(k)=.25 99 | 50 continue 100 | return 101 | else if(ipoly.eq.5) then 102 | b(1)=4.*atan(1.) 103 | a(1)=.5 104 | if(n.eq.1) return 105 | do 60 k=2,n 106 | b(k)=.25 107 | 60 continue 108 | return 109 | else if(ipoly.eq.6) then 110 | if(al.le.-1. .or. be.le.-1.) then 111 | ierr=1 112 | return 113 | else 114 | alpbe=al+be 115 | a(1)=(be-al)/(alpbe+2.) 116 | t=(alpbe+1.)*alog(2.)+alga(al+1.)+alga(be+1.)- 117 | * alga(alpbe+2.) 118 | if(t.gt.almach) then 119 | ierr=2 120 | b(1)=r1mach(2) 121 | else 122 | b(1)=exp(t) 123 | end if 124 | if(n.eq.1) return 125 | al2=al*al 126 | be2=be*be 127 | a(2)=(be2-al2)/((alpbe+2.)*(alpbe+4.)) 128 | b(2)=4.*(al+1.)*(be+1.)/((alpbe+3.)*(alpbe+2.)**2) 129 | if(n.eq.2) return 130 | do 70 k=3,n 131 | fkm1=real(k-1) 132 | a(k)=.25*(be2-al2)/(fkm1*fkm1*(1.+.5*alpbe/fkm1)* 133 | * (1.+.5*(alpbe+2.)/fkm1)) 134 | b(k)=.25*(1.+al/fkm1)*(1.+be/fkm1)*(1.+alpbe/fkm1)/ 135 | * ((1.+.5*(alpbe+1.)/fkm1)*(1.+.5*(alpbe-1.)/fkm1) 136 | * *(1.+.5*alpbe/fkm1)**2) 137 | 70 continue 138 | return 139 | end if 140 | else if(ipoly.eq.7) then 141 | if(al.le.-1.) then 142 | ierr=1 143 | return 144 | else 145 | a(1)=al+1. 146 | b(1)=gamma(al+1.,ierr) 147 | if(ierr.eq.2) b(1)=r1mach(2) 148 | if(n.eq.1) return 149 | do 80 k=2,n 150 | fkm1=real(k-1) 151 | a(k)=2.*fkm1+al+1. 152 | b(k)=fkm1*(fkm1+al) 153 | 80 continue 154 | return 155 | end if 156 | else if(ipoly.eq.8) then 157 | b(1)=sqrt(4.*atan(1.)) 158 | if(n.eq.1) return 159 | do 90 k=2,n 160 | b(k)=.5*real(k-1) 161 | 90 continue 162 | return 163 | else 164 | ierr=4 165 | end if 166 | end 167 | 168 | function alga(x) 169 | c 170 | c This is an auxiliary function subroutine (not optimized in any 171 | c sense) evaluating the logarithm of the gamma function for positive 172 | c arguments x. It is called by the subroutine gamma. The integer m0 173 | c in the first executable statement is the smallest integer m such 174 | c that 1*3*5* ... *(2*m+1)/(2**m) is greater than or equal to the 175 | c largest machine-representable number. The routine is based on a 176 | c rational approximation valid on [.5,1.5] due to W.J. Cody and 177 | c K.E. Hillstrom; see Math. Comp. 21, 1967, 198-203, in particular the 178 | c case n=7 in Table II. For the computation of m0 it calls upon the 179 | c function subroutines t and r1mach. The former, appended below, 180 | c evaluates the inverse function t = t(y) of y = t ln t. 181 | c 182 | dimension cnum(8),cden(8) 183 | data cnum/4.120843185847770,85.68982062831317,243.175243524421, 184 | *-261.7218583856145,-922.2613728801522,-517.6383498023218, 185 | *-77.41064071332953,-2.208843997216182/, 186 | *cden/1.,45.64677187585908,377.8372484823942,951.323597679706, 187 | *846.0755362020782,262.3083470269460,24.43519662506312, 188 | *.4097792921092615/ 189 | c 190 | c The constants in the statement below are exp(1.) and .5*alog(8.). 191 | c 192 | m0=2.71828*t((alog(r1mach(2))-1.03972)/2.71828) 193 | xi=aint(x) 194 | if(x-xi.gt..5) xi=xi+1. 195 | m=ifix(xi)-1 196 | c 197 | c Computation of log gamma on the standard interval (1/2,3/2] 198 | c 199 | xe=x-real(m) 200 | snum=cnum(1) 201 | sden=cden(1) 202 | do 10 k=2,8 203 | snum=xe*snum+cnum(k) 204 | sden=xe*sden+cden(k) 205 | 10 continue 206 | alga=(xe-1.)*snum/sden 207 | c 208 | c Computation of log gamma on (0,1/2] 209 | c 210 | if(m.eq.-1) then 211 | alga=alga-alog(x) 212 | return 213 | else if(m.eq.0) then 214 | return 215 | else 216 | c 217 | c Computation of log gamma on (3/2,5/2] 218 | c 219 | p=xe 220 | if(m.eq.1) then 221 | alga=alga+alog(p) 222 | return 223 | else 224 | c 225 | c Computation of log gamma for arguments larger than 5/2 226 | c 227 | mm1=m-1 228 | c 229 | c The else-clause in the next statement is designed to avoid possible 230 | c overflow in the computation of p in the if-clause, at the expense 231 | c of computing many logarithms. 232 | c 233 | if(m.lt.m0) then 234 | do 20 k=1,mm1 235 | p=(xe+real(k))*p 236 | 20 continue 237 | alga=alga+alog(p) 238 | return 239 | else 240 | alga=alga+alog(xe) 241 | do 30 k=1,mm1 242 | alga=alga+alog(xe+real(k)) 243 | 30 continue 244 | return 245 | end if 246 | end if 247 | end if 248 | end 249 | 250 | function gamma(x,ierr) 251 | c 252 | c This evaluates the gamma function for real positive x, using the 253 | c function subroutines alga and r1mach. In case of overflow, the 254 | c routine returns the largest machine-representable number and the 255 | c error flag ierr=2. 256 | c 257 | almach=alog(r1mach(2)) 258 | ierr=0 259 | t=alga(x) 260 | if(t.ge.almach) then 261 | ierr=2 262 | gamma=r1mach(2) 263 | return 264 | else 265 | gamma=exp(t) 266 | return 267 | end if 268 | end 269 | 270 | function t(y) 271 | c 272 | c This evaluates the inverse function t = t(y) of y = t ln t for 273 | c nonnegative y to an accuracy of about one percent. For the 274 | c approximation used, see pp. 51-52 in W. Gautschi,Computational 275 | c aspects of three-term recurrence relations'', SIAM Rev. 9, 1967, 276 | c 24-82. 277 | c 278 | if(y.le.10.) then 279 | p=.000057941*y-.00176148 280 | p=y*p+.0208645 281 | p=y*p-.129013 282 | p=y*p+.85777 283 | t=y*p+1.0125 284 | else 285 | z=alog(y)-.775 286 | p=(.775-alog(z))/(1.+z) 287 | p=1./(1.+p) 288 | t=y*p/z 289 | end if 290 | return 291 | end 292 | 293 | -------------------------------------------------------------------------------- /src/ssti.f: -------------------------------------------------------------------------------- 1 | c 2 | c 3 | subroutine ssti(n,ncap,x,w,alpha,beta,ierr,p0,p1,p2) 4 | c 5 | c This routine applies Stieltjes's procedure'' (cf. Section 2.1 of 6 | c W. Gautschi,On generating orthogonal polynomials'', SIAM J. Sci. 7 | c Statist. Comput. 3, 1982, 289-317) to generate the recursion 8 | c coefficients alpha(k), beta(k) , k=0,1,...,n-1, for the discrete 9 | c (monic) orthogonal polynomials associated with the inner product 10 | c 11 | c (f,g)=sum over k from 1 to ncap of w(k)*f(x(k))*g(x(k)). 12 | c 13 | c The integer n must be between 1 and ncap, inclusive; otherwise, 14 | c there is an error exit with ierr=1. The results are stored in the 15 | c arrays alpha, beta; the arrays p0, p1, p2 are working arrays. 16 | c 17 | c If there is a threat of underflow or overflow in the calculation 18 | c of the coefficients alpha(k) and beta(k), the routine exits with 19 | c the error flag ierr set equal to -k (in the case of underflow) 20 | c or +k (in the case of overflow), where k is the recursion index 21 | c for which the problem occurs. The former [latter] can often be avoided 22 | c by multiplying all weights w(k) by a sufficiently large [small] 23 | c scaling factor prior to entering the routine, and, upon exit, divide 24 | c the coefficient beta(0) by the same factor. 25 | c 26 | c This routine should be used with caution if n is relatively close 27 | c to ncap, since there is a distinct possibility of numerical 28 | c instability developing. (See W. Gautschi,Is the recurrence relation 29 | c for orthogonal polynomials always stable?'', BIT, 1993, to appear.) 30 | c In that case, the routine lancz should be used. 31 | c 32 | c The routine uses the function subroutine r1mach. 33 | c 34 | dimension x(ncap),w(ncap),alpha(n),beta(n),p0(ncap),p1(ncap), 35 | *p2(ncap) 36 | cf2py integer intent(in) :: n 37 | cf2py integer intent(hide),depend(x) :: ncap=len(x) 38 | cf2py real intent(in) :: x 39 | cf2py real intent(in),depend(ncap),check(len(w)>=ncap) :: w 40 | cf2py real intent(out),depend(n),dimension(n) :: alpha 41 | cf2py real intent(out),depend(n),dimension(n) :: beta 42 | cf2py real intent(hide),depend(ncap),dimension(ncap) :: p0 43 | cf2py real intent(hide),depend(ncap),dimension(ncap) :: p1 44 | cf2py real intent(hide),depend(ncap),dimension(ncap) :: p2 45 | cf2py integer intent(out) :: ierr 46 | tiny=10.*r1mach(1) 47 | huge=.1*r1mach(2) 48 | ierr=0 49 | if(n.le.0 .or. n.gt.ncap) then 50 | ierr=1 51 | return 52 | end if 53 | nm1=n-1 54 | c 55 | c Compute the first alpha- and beta-coefficient. 56 | c 57 | sum0=0. 58 | sum1=0. 59 | do 10 m=1,ncap 60 | sum0=sum0+w(m) 61 | sum1=sum1+w(m)*x(m) 62 | 10 continue 63 | alpha(1)=sum1/sum0 64 | beta(1)=sum0 65 | if(n.eq.1) return 66 | c 67 | c Compute the remaining alpha- and beta-coefficients. 68 | c 69 | do 20 m=1,ncap 70 | p1(m)=0. 71 | p2(m)=1. 72 | 20 continue 73 | do 40 k=1,nm1 74 | sum1=0. 75 | sum2=0. 76 | do 30 m=1,ncap 77 | c 78 | c The following statement is designed to avoid an overflow condition 79 | c in the computation of p2(m) when the weights w(m) go to zero 80 | c faster (and underflow) than the p2(m) grow. 81 | c 82 | if(w(m).eq.0.) goto 30 83 | p0(m)=p1(m) 84 | p1(m)=p2(m) 85 | p2(m)=(x(m)-alpha(k))*p1(m)-beta(k)*p0(m) 86 | c 87 | c Check for impending overflow. 88 | c 89 | if(abs(p2(m)).gt.huge .or. abs(sum2).gt.huge) then 90 | ierr=k 91 | return 92 | end if 93 | t=w(m)*p2(m)*p2(m) 94 | sum1=sum1+t 95 | sum2=sum2+t*x(m) 96 | 30 continue 97 | c 98 | c Check for impending underflow. 99 | c 100 | if(abs(sum1).lt.tiny) then 101 | ierr=-k 102 | return 103 | end if 104 | alpha(k+1)=sum2/sum1 105 | beta(k+1)=sum1/sum0 106 | sum0=sum1 107 | 40 continue 108 | return 109 | end 110 | 111 | -------------------------------------------------------------------------------- /unittests/test.py: -------------------------------------------------------------------------------- 1 | """Unit-tests for orthpol 2 | 3 | Author: 4 | Ilias Bilionis 5 | 6 | Date: 7 | 8/10/2013 8 | 9 | """ 10 | 11 | 12 | import unittest 13 | import numpy as np 14 | import math 15 | import orthpol 16 | import scipy.stats as st 17 | import matplotlib.pyplot as plt 18 | import orthpol 19 | 20 | 21 | class GpcTest(unittest.TestCase): 22 | 23 | def test_normalization(self): 24 | rvs = [st.uniform(loc = -1., scale = 2.)]*2 25 | p = orthpol.ProductBasis(rvs, degree = 5) 26 | U = st.uniform.rvs(loc = -1, scale = 2., size = (10000,2)) 27 | P = p(U) 28 | print np.sum(P**2, axis = 0) / 10000 29 | 30 | if __name__ == '__main__': 31 | unittest.main() 32 | --------------------------------------------------------------------------------