├── .gitignore ├── LICENSE.txt ├── README.md ├── demos ├── demo1.py ├── demo10.py ├── demo11.py ├── demo12.py ├── demo13.py ├── demo14.py ├── demo15.py ├── demo16.py ├── demo17.py ├── demo2.py ├── demo3.py ├── demo4.py ├── demo5.py ├── demo6.py ├── demo7.py ├── demo8.py └── demo9.py ├── design └── __init__.py ├── meson.build ├── pyproject.toml ├── src ├── faure.f90 ├── halton.f90 ├── hammersley.f90 ├── ihs.f90 ├── lambert.f90 ├── latin_center.f90 ├── latin_cover.f90 ├── latin_edge.f90 ├── latin_random.f90 ├── latinize.f90 ├── sandia_sparse.f90 └── sobol.f90 └── unittests └── test1.py /.gitignore: -------------------------------------------------------------------------------- 1 | *.txt 2 | *.pyc 3 | *.html 4 | *.pickle 5 | *.inv 6 | *.js 7 | *.png 8 | *doctree* 9 | *.so 10 | *.swp 11 | src/CMakeFiles/ 12 | src/Makefile 13 | src/cmake_install.cmake 14 | build 15 | backup 16 | venv* 17 | .venv* -------------------------------------------------------------------------------- /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 | Design of Experiments in Python 2 | =============================== 3 | 4 | Description 5 | ----------- 6 | 7 | The ``py-design`` package defines the Python module ``design`` which implements 8 | several routines for the design of experiments. Basically, it serves as 9 | a wrapper the Fortran 90 codes for experimental design written by 10 | [John Burkardt](http://people.sc.fsu.edu/~jburkardt/). I have collected, 11 | probably, all of them here. 12 | 13 | 14 | Related Packages 15 | ---------------- 16 | 17 | To the best of my knowledge, there is also another Python package implementing 18 | several designs called [PyDOE](http://pythonhosted.org/pyDOE/index.html). I 19 | concentrate more on what is known as **randomized designs** used in sampling 20 | models in order to create surrogate surfaces as well as performing Monte Carlo 21 | tasks. 22 | 23 | 24 | Demos 25 | ----- 26 | 27 | Here are some demos demonstrating how to use the package: 28 | + [``demos/demo1.py``](demos/demo1.py): Centered Latin Square Design. 29 | + [``demos/demo2.py``](demos/demo2.py): Latin Edge Square Design. 30 | + [``demos/demo3.py``](demos/demo3.py): Latin Random Square Design. 31 | + [``demos/demo4.py``](demos/demo4.py): Adjust a ``D`` dimensional dataset of ``N`` points so that it forms a Latin hypercube. 32 | + [``demos/demo5.py``](demos/demo5.py): Sparse Grid: Clenshaw Curtis Closed Fully Nested rule. 33 | + [``demos/demo6.py``](demos/demo6.py): Sparse Grid: Fejer 1 Open Fully Nested rule. 34 | + [``demos/demo7.py``](demos/demo7.py): Sparse Grid: Fejer 2 Open Fully Nested rule. 35 | + [``demos/demo8.py``](demos/demo8.py): Sparse Grid: Gauss Patterson Open Fully Nested rule. 36 | + [``demos/demo9.py``](demos/demo9.py): Sparse Grid: Gauss Legendre Open Weakly Nested rule. 37 | + [``demos/demo10.py``](demos/demo10.py): Sparse Grid: Gauss Hermite Open Weakly Nested rule. 38 | + [``demos/demo11.py``](demos/demo11.py): Sparse Grid: Gauss Laguerre Open Non Nested rule. 39 | + [``demos/demo12.py``](demos/demo12.py): Generate the Faure quasirandom sequence. 40 | + [``demos/demo13.py``](demos/demo13.py): Generate the Halton quasirandom sequence. 41 | + [``demos/demo14.py``](demos/demo14.py): Generate the Hammersley quasirandom sequence. 42 | + [``demos/demo15.py``](demos/demo15.py): Generate the Sobol quasirandom sequence. 43 | + [``demos/demo16.py``](demos/demo16.py): Generate the Lambert quasirandom sequence. 44 | + [``demos/demo17.py``](demos/demo17.py): Generate the Improved Distributed Hypercube Sequence. 45 | 46 | 47 | TODO 48 | ---- 49 | + Add references to each algorithm. 50 | -------------------------------------------------------------------------------- /demos/demo1.py: -------------------------------------------------------------------------------- 1 | """ 2 | Construct a centered Latin Square design. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import matplotlib.pyplot as plt 15 | 16 | # The number of input dimensions 17 | num_dim = 2 18 | # The number of points you want 19 | num_points = 10 20 | # Create the design 21 | X = design.latin_center(num_points, num_dim) 22 | # Look at it 23 | print(X) 24 | # And plot it 25 | plt.plot(X[:, 0], X[:, 1], '.', markersize=10) 26 | plt.xlabel('$x_1$', fontsize=16) 27 | plt.ylabel('$x_2$', fontsize=16) 28 | plt.title('Centered Latin Square Design', fontsize=16) 29 | plt.show() 30 | -------------------------------------------------------------------------------- /demos/demo10.py: -------------------------------------------------------------------------------- 1 | """ 2 | Compute a sparse grid: Gauss Hermite Open Weakly Nested rule. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import numpy as np 15 | import matplotlib.pyplot as plt 16 | 17 | # The number of input dimensions 18 | num_dim = 2 19 | # The maximum level of the grid 20 | max_level = 4 21 | # Draw the design 22 | X, w = design.sparse_grid(num_dim, max_level, rule='GH') 23 | print('After:') 24 | print('Grid points:') 25 | print(X) 26 | print('Weights:') 27 | print(w) 28 | # And plot it 29 | plt.plot(X[:, 0], X[:, 1], '.', markersize=10) 30 | plt.xlabel('$x_1$', fontsize=16) 31 | plt.ylabel('$x_2$', fontsize=16) 32 | plt.title('Gauss Hermite Open Weakly Nested rule', fontsize=16) 33 | plt.show() 34 | -------------------------------------------------------------------------------- /demos/demo11.py: -------------------------------------------------------------------------------- 1 | """ 2 | Compute a sparse grid: Gauss Laguerre Open Non Nested rule. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import numpy as np 15 | import matplotlib.pyplot as plt 16 | 17 | # The number of input dimensions 18 | num_dim = 2 19 | # The maximum level of the grid 20 | max_level = 4 21 | # Draw the design 22 | X, w = design.sparse_grid(num_dim, max_level, rule='LG') 23 | print('After:') 24 | print('Grid points:') 25 | print(X) 26 | print('Weights:') 27 | print(w) 28 | # And plot it 29 | plt.plot(X[:, 0], X[:, 1], '.', markersize=10) 30 | plt.xlabel('$x_1$', fontsize=16) 31 | plt.ylabel('$x_2$', fontsize=16) 32 | plt.title('Gauss Laguerre Open Non Nested rule', fontsize=16) 33 | plt.show() 34 | -------------------------------------------------------------------------------- /demos/demo12.py: -------------------------------------------------------------------------------- 1 | """ 2 | Generate the Faure quasirandom sequence. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import numpy as np 15 | import matplotlib.pyplot as plt 16 | 17 | # The number of input dimensions 18 | num_dim = 2 19 | # The number of points 20 | num_points = 100 21 | # Draw the design 22 | X = design.faure(num_points, num_dim) 23 | print(X) 24 | # And plot it 25 | plt.plot(X[:, 0], X[:, 1], '.', markersize=10) 26 | plt.xlabel('$x_1$', fontsize=16) 27 | plt.ylabel('$x_2$', fontsize=16) 28 | plt.title('Faure Quasirandom Sequence', fontsize=16) 29 | plt.show() 30 | -------------------------------------------------------------------------------- /demos/demo13.py: -------------------------------------------------------------------------------- 1 | """ 2 | Generate the Halton quasirandom sequence. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import numpy as np 15 | import matplotlib.pyplot as plt 16 | 17 | # The number of input dimensions 18 | num_dim = 2 19 | # The number of points 20 | num_points = 100 21 | # Draw the design 22 | X = design.halton(num_points, num_dim) 23 | print(X) 24 | # And plot it 25 | plt.plot(X[:, 0], X[:, 1], '.', markersize=10) 26 | plt.xlabel('$x_1$', fontsize=16) 27 | plt.ylabel('$x_2$', fontsize=16) 28 | plt.title('Halton Quasirandom Sequence', fontsize=16) 29 | plt.show() 30 | -------------------------------------------------------------------------------- /demos/demo14.py: -------------------------------------------------------------------------------- 1 | """ 2 | Generate the Hammersley quasirandom sequence. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import numpy as np 15 | import matplotlib.pyplot as plt 16 | 17 | # The number of input dimensions 18 | num_dim = 2 19 | # The number of points 20 | num_points = 100 21 | # Draw the design 22 | X = design.hammersley(num_points, num_dim) 23 | print(X) 24 | # And plot it 25 | plt.plot(X[:, 0], X[:, 1], '.', markersize=10) 26 | plt.xlabel('$x_1$', fontsize=16) 27 | plt.ylabel('$x_2$', fontsize=16) 28 | plt.title('Hammersley Quasirandom Sequence', fontsize=16) 29 | plt.show() 30 | -------------------------------------------------------------------------------- /demos/demo15.py: -------------------------------------------------------------------------------- 1 | """ 2 | Generate the Sobol quasirandom sequence. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import numpy as np 15 | import matplotlib.pyplot as plt 16 | 17 | # The number of input dimensions 18 | num_dim = 2 19 | # The number of points 20 | num_points = 100 21 | # How many elements to skip 22 | skip = 10 23 | # Draw the design 24 | X = design.sobol(num_points, num_dim, skip=10) 25 | print(X) 26 | # And plot it 27 | plt.plot(X[:, 0], X[:, 1], '.', markersize=10) 28 | plt.xlabel('$x_1$', fontsize=16) 29 | plt.ylabel('$x_2$', fontsize=16) 30 | plt.title('Sobol Quasirandom Sequence', fontsize=16) 31 | plt.show() 32 | -------------------------------------------------------------------------------- /demos/demo16.py: -------------------------------------------------------------------------------- 1 | """ 2 | Generate the Lambert quasirandom sequence. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import numpy as np 15 | import matplotlib.pyplot as plt 16 | 17 | # The number of input dimensions 18 | num_dim = 2 19 | # The number of points 20 | num_points = 100 21 | # Draw the design 22 | X = design.lambert(num_points, num_dim) 23 | print(X) 24 | # And plot it 25 | plt.plot(X[:, 0], X[:, 1], '.', markersize=10) 26 | plt.xlabel('$x_1$', fontsize=16) 27 | plt.ylabel('$x_2$', fontsize=16) 28 | plt.title('Lambert Quasirandom Sequence', fontsize=16) 29 | plt.show() 30 | -------------------------------------------------------------------------------- /demos/demo17.py: -------------------------------------------------------------------------------- 1 | """ 2 | Construct the improved distributed hypercube sequence. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import matplotlib.pyplot as plt 15 | 16 | # The number of input dimensions 17 | num_dim = 2 18 | # The number of points you want 19 | num_points = 100 20 | # Create the design 21 | X = design.ihs(num_points, num_dim) 22 | # Look at it 23 | print(X) 24 | # And plot it 25 | plt.plot(X[:, 0], X[:, 1], '.', markersize=10) 26 | plt.xlabel('$x_1$', fontsize=16) 27 | plt.ylabel('$x_2$', fontsize=16) 28 | plt.title('Improved Distributed Hypercube Sequence', fontsize=16) 29 | plt.show() 30 | -------------------------------------------------------------------------------- /demos/demo2.py: -------------------------------------------------------------------------------- 1 | """ 2 | Construct a Latin Edge Square design. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import matplotlib.pyplot as plt 15 | 16 | # The number of input dimensions 17 | num_dim = 2 18 | # The number of points you want 19 | num_points = 10 20 | # Create the design 21 | X = design.latin_edge(num_points, num_dim) 22 | # Look at it 23 | print(X) 24 | # And plot it 25 | plt.plot(X[:, 0], X[:, 1], '.', markersize=10) 26 | plt.xlabel('$x_1$', fontsize=16) 27 | plt.ylabel('$x_2$', fontsize=16) 28 | plt.title('Latin Edge Square Design', fontsize=16) 29 | plt.show() 30 | -------------------------------------------------------------------------------- /demos/demo3.py: -------------------------------------------------------------------------------- 1 | """ 2 | Construct a Latin Random Square design. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import matplotlib.pyplot as plt 15 | 16 | # The number of input dimensions 17 | num_dim = 2 18 | # The number of points you want 19 | num_points = 10 20 | # Create the design 21 | X = design.latin_random(num_points, num_dim) 22 | # Look at it 23 | print(X) 24 | # And plot it 25 | plt.plot(X[:, 0], X[:, 1], '.', markersize=10) 26 | plt.xlabel('$x_1$', fontsize=16) 27 | plt.ylabel('$x_2$', fontsize=16) 28 | plt.title('Latin Random Square Design', fontsize=16) 29 | plt.show() 30 | -------------------------------------------------------------------------------- /demos/demo4.py: -------------------------------------------------------------------------------- 1 | """ 2 | Adjust an D dimensional dataset of N points so that it forms a Latin hypercube. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import numpy as np 15 | import matplotlib.pyplot as plt 16 | 17 | # The number of input dimensions 18 | num_dim = 2 19 | # The number of points you want 20 | num_points = 50 21 | # Draw some random points 22 | X0 = np.random.rand(num_points, num_dim) 23 | # Latinize it 24 | X = design.latinize(X0) 25 | # Look at it 26 | print('Before:') 27 | print(X0) 28 | print('After:') 29 | print(X) 30 | # And plot it 31 | plt.plot(X0[:, 0], X[:, 1], 'b.', markersize=10) 32 | plt.plot(X[:, 0], X[:, 1], 'r.', markersize=10) 33 | plt.legend(['Original', 'Latinized'], loc='best') 34 | plt.xlabel('$x_1$', fontsize=16) 35 | plt.ylabel('$x_2$', fontsize=16) 36 | plt.title('Latinize Demonstration', fontsize=16) 37 | plt.show() 38 | -------------------------------------------------------------------------------- /demos/demo5.py: -------------------------------------------------------------------------------- 1 | """ 2 | Compute a sparse grid: Clenshaw Curtis Closed Fully Nested rule. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import numpy as np 15 | import matplotlib.pyplot as plt 16 | 17 | # The number of input dimensions 18 | num_dim = 2 19 | # The maximum level of the grid 20 | max_level = 7 21 | # Draw the design 22 | X, w = design.sparse_grid(num_dim, max_level, rule='CC') 23 | print('After:') 24 | print('Grid points:') 25 | print(X) 26 | print('Weights:') 27 | print(w) 28 | # And plot it 29 | plt.plot(X[:, 0], X[:, 1], '.', markersize=10) 30 | plt.xlabel('$x_1$', fontsize=16) 31 | plt.ylabel('$x_2$', fontsize=16) 32 | plt.title('Clenshaw Curtis Closed Fully Nested rule', fontsize=16) 33 | plt.show() 34 | -------------------------------------------------------------------------------- /demos/demo6.py: -------------------------------------------------------------------------------- 1 | """ 2 | Compute a sparse grid: Fejer 1 Open Fully Nested rule. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import numpy as np 15 | import matplotlib.pyplot as plt 16 | 17 | # The number of input dimensions 18 | num_dim = 2 19 | # The maximum level of the grid 20 | max_level = 7 21 | # Draw the design 22 | X, w = design.sparse_grid(num_dim, max_level, rule='F1') 23 | print('After:') 24 | print('Grid points:') 25 | print(X) 26 | print('Weights:') 27 | print(w) 28 | # And plot it 29 | plt.plot(X[:, 0], X[:, 1], '.', markersize=10) 30 | plt.xlabel('$x_1$', fontsize=16) 31 | plt.ylabel('$x_2$', fontsize=16) 32 | plt.title('Fejer 1 Open Fully Nested rule', fontsize=16) 33 | plt.show() 34 | -------------------------------------------------------------------------------- /demos/demo7.py: -------------------------------------------------------------------------------- 1 | """ 2 | Compute a sparse grid: Fejer 2 Open Fully Nested rule. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import numpy as np 15 | import matplotlib.pyplot as plt 16 | 17 | # The number of input dimensions 18 | num_dim = 2 19 | # The maximum level of the grid 20 | max_level = 7 21 | # Draw the design 22 | X, w = design.sparse_grid(num_dim, max_level, rule='F2') 23 | print('After:') 24 | print('Grid points:') 25 | print(X) 26 | print('Weights:') 27 | print(w) 28 | # And plot it 29 | plt.plot(X[:, 0], X[:, 1], '.', markersize=10) 30 | plt.xlabel('$x_1$', fontsize=16) 31 | plt.ylabel('$x_2$', fontsize=16) 32 | plt.title('Fejer 2 Open Fully Nested rule', fontsize=16) 33 | plt.show() 34 | -------------------------------------------------------------------------------- /demos/demo8.py: -------------------------------------------------------------------------------- 1 | """ 2 | Compute a sparse grid: Gauss Patterson Open Fully Nested rule. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import numpy as np 15 | import matplotlib.pyplot as plt 16 | 17 | # The number of input dimensions 18 | num_dim = 2 19 | # The maximum level of the grid 20 | max_level = 7 21 | # Draw the design 22 | X, w = design.sparse_grid(num_dim, max_level, rule='GP') 23 | print('After:') 24 | print('Grid points:') 25 | print(X) 26 | print('Weights:') 27 | print(w) 28 | # And plot it 29 | plt.plot(X[:, 0], X[:, 1], '.', markersize=10) 30 | plt.xlabel('$x_1$', fontsize=16) 31 | plt.ylabel('$x_2$', fontsize=16) 32 | plt.title('Gauss Patterson Open Fully Nested rule', fontsize=16) 33 | plt.show() 34 | -------------------------------------------------------------------------------- /demos/demo9.py: -------------------------------------------------------------------------------- 1 | """ 2 | Compute a sparse grid: Gauss Legendre Open Weakly Nested rule. 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 3/19/2014 9 | 10 | """ 11 | 12 | 13 | import design 14 | import numpy as np 15 | import matplotlib.pyplot as plt 16 | 17 | # The number of input dimensions 18 | num_dim = 2 19 | # The maximum level of the grid 20 | max_level = 4 21 | # Draw the design 22 | X, w = design.sparse_grid(num_dim, max_level, rule='GL') 23 | print('After:') 24 | print('Grid points:') 25 | print(X) 26 | print('Weights:') 27 | print(w) 28 | # And plot it 29 | plt.plot(X[:, 0], X[:, 1], '.', markersize=10) 30 | plt.xlabel('$x_1$', fontsize=16) 31 | plt.ylabel('$x_2$', fontsize=16) 32 | plt.title('Gauss Legendre Open Weakly Nested rule', fontsize=16) 33 | plt.show() 34 | -------------------------------------------------------------------------------- /design/__init__.py: -------------------------------------------------------------------------------- 1 | """This module defines classes that are helpful in designing experiments. 2 | 3 | Author: 4 | Ilias Bilionis 5 | 6 | Date: 7 | 8/19/2013 8 | """ 9 | 10 | 11 | __all__ = ['latin_center', 'latin_edge', 'latin_random', 'latinize', 12 | 'sparse_grid', 'faure', 'halton', 'ihs'] 13 | 14 | 15 | import _designfortran as _design 16 | 17 | 18 | def _check_args(num_points, num_dim, seed): 19 | """Check if the arguments to the latin_*() functions are ok.""" 20 | if seed is None: 21 | seed = _design.get_seed() 22 | seed = int(seed) 23 | num_points = int(num_points) 24 | num_dim = int(num_dim) 25 | assert seed > 0 26 | assert num_points >= 1 27 | assert num_dim >= 1 28 | return num_points, num_dim, seed 29 | 30 | 31 | def latin_center(num_points, num_dim, seed=None): 32 | """ 33 | Construct a centered Latin Square _design. 34 | 35 | This is a wrapper of the fortran code: 36 | `latin_center() `_. 37 | 38 | Parameters 39 | ---------- 40 | num_points : int 41 | The number of design points. 42 | num_dim : int 43 | The number of dimensions 44 | seed : int 45 | A random seed. If ``None``, then it is initialized 46 | automatically. 47 | 48 | Returns 49 | ------- 50 | x : (num_points, num_dim) ndarray 51 | 52 | Examples 53 | -------- 54 | >>> x = best._design.latin_center(10, 2) 55 | >>> print x 56 | """ 57 | num_points, num_dim, seed = _check_args(num_points, num_dim, seed) 58 | return _design.latin_center(num_dim, num_points, seed).T 59 | 60 | 61 | def latin_edge(num_points, num_dim, seed=None): 62 | """ 63 | Construct a Latin Edge Square _design. 64 | 65 | This is a wrapper of the fortran code: 66 | `latin_center() `_. 67 | 68 | Parameters 69 | ---------- 70 | num_points : int 71 | The number of design points. 72 | num_dim : int 73 | The number of dimensions 74 | seed : int 75 | A random seed. If ``None``, then it is initialized 76 | automatically. 77 | 78 | Returns 79 | ------- 80 | x : (num_points, num_dim) ndarray 81 | 82 | Examples 83 | -------- 84 | >>> x = best._design.latin_edge(10, 2) 85 | >>> print x 86 | """ 87 | num_points, num_dim, seed = _check_args(num_points, num_dim, seed) 88 | return _design.latin_edge(num_dim, num_points, seed).T 89 | 90 | 91 | def latin_random(num_points, num_dim, seed=None): 92 | """ 93 | Construct a Latin Random Square _design. 94 | 95 | This is a wrapper of the fortran code: 96 | `latin_center() `_. 97 | 98 | Parameters 99 | ---------- 100 | num_points : int 101 | The number of design points. 102 | num_dim : int 103 | The number of dimensions 104 | seed : int 105 | A random seed. If ``None``, then it is initialized 106 | automatically. 107 | 108 | Returns 109 | ------- 110 | x : (num_points, num_dim) ndarray 111 | 112 | Examples 113 | -------- 114 | >>> x = best._design.latin_random(10, 2) 115 | >>> print x 116 | """ 117 | num_points, num_dim, seed = _check_args(num_points, num_dim, seed) 118 | return _design.latin_random(num_dim, num_points, seed).T 119 | 120 | 121 | def latinize(table): 122 | """ 123 | Adjust an D dimensional dataset of N points so that it forms a 124 | Latin hypercube. 125 | 126 | Parameters 127 | ---------- 128 | table : (N, D) array_like 129 | The dataset to be adjusted. A copy is made. 130 | 131 | Returns 132 | ------- 133 | table : (N, D) ndarray 134 | The adjusted dataset. 135 | 136 | Examples 137 | -------- 138 | >>> X = np.random.rand(100, 2) 139 | >>> X_adj = best._design.latinize(table) 140 | >>> plt.plot(X[:, 0], X[:, 1], '+', X_adj[:, 0], X_adj[:, 1], 'o') 141 | >>> plt.show() 142 | """ 143 | return _design.latinize(table.T.copy()).T 144 | 145 | 146 | def _sg_string_to_rule(rule_str): 147 | """ 148 | Turn a Sparse Grid rule from a string to an integer. 149 | 150 | Parameters 151 | ---------- 152 | rule_str : str 153 | The rule in str form. Choose from: 154 | 155 | 1. "CC", Clenshaw Curtis Closed Fully Nested rule. 156 | 2. "F1", Fejer 1 Open Fully Nested rule. 157 | 3. "F2", Fejer 2 Open Fully Nested rule. 158 | 4. "GP", Gauss Patterson Open Fully Nested rule. 159 | 5. "GL", Gauss Legendre Open Weakly Nested rule. 160 | 6. "GH", Gauss Hermite Open Weakly Nested rule. 161 | 7. "LG", Gauss Laguerre Open Non Nested rule. 162 | 163 | Returns 164 | ------- 165 | rule : int 166 | The rule number. 167 | """ 168 | if rule_str == 'CC': 169 | return 1 170 | elif rule_str == 'F1': 171 | return 2 172 | elif rule_str == 'F2': 173 | return 3 174 | elif rule_str == 'GP': 175 | return 4 176 | elif rule_str == 'GL': 177 | return 5 178 | elif rule_str == 'GH': 179 | return 6 180 | elif rule_str == 'LG': 181 | return 7 182 | raise ValueError('Unkown quadrature rule.') 183 | 184 | 185 | def sparse_grid(num_dim, max_level, rule='CC'): 186 | """ 187 | Compute a Sparse Grid. 188 | 189 | Parameters 190 | ---------- 191 | num_dim : int 192 | Number of dimensions. 193 | max_level : int 194 | The maximum level of the sparse grid. 195 | rule : str 196 | The quadrature rule. The default is "CC". Choose from: 197 | 198 | 1. "CC", Clenshaw Curtis Closed Fully Nested rule. 199 | 2. "F1", Fejer 1 Open Fully Nested rule. 200 | 3. "F2", Fejer 2 Open Fully Nested rule. 201 | 4. "GP", Gauss Patterson Open Fully Nested rule. 202 | 5. "GL", Gauss Legendre Open Weakly Nested rule. 203 | 6. "GH", Gauss Hermite Open Weakly Nested rule. 204 | 7. "LG", Gauss Laguerre Open Non Nested rule. 205 | 206 | Returns 207 | ------- 208 | grid_point : (num_point, num_dim) ndarray 209 | The points of the grid. 210 | grid_weight : num_point ndarray 211 | The weights of the grid points. 212 | """ 213 | rule = _sg_string_to_rule(rule) 214 | num_point = _design.levels_index_size(num_dim, max_level, rule) 215 | grid_weight, grid_point = _design.sparse_grid(num_dim, max_level, 216 | rule, num_point) 217 | return grid_point.T, grid_weight.T 218 | 219 | 220 | def faure(num_points, num_dim): 221 | """ 222 | Generate the Faure quasirandom sequence. 223 | 224 | Parameters 225 | ---------- 226 | num_points : int 227 | The number of points to be generated. 228 | num_dim : int 229 | The number of dimensions. 230 | 231 | Returns 232 | ------- 233 | points : (num_points, num_dim) ndarray 234 | The first num_points of the num_dim-dimensional. 235 | 236 | """ 237 | return _design.faure_generate(num_dim, num_points).T 238 | 239 | 240 | def halton(num_points, num_dim): 241 | """ 242 | Generate the Halton quasirandom sequence. 243 | 244 | Parameters 245 | ---------- 246 | num_points : int 247 | The number of points to be generated. 248 | num_dim : int 249 | The number of dimensions. 250 | 251 | Returns 252 | ------- 253 | points : (num_points, num_dim) ndarray 254 | The first num_points of the num_dim-dimensional. 255 | 256 | """ 257 | return _design.halton_sequence(num_dim, num_points).T 258 | 259 | 260 | def hammersley(num_points, num_dim): 261 | """ 262 | Generate the Hammersley quasirandom sequence. 263 | 264 | Parameters 265 | ---------- 266 | num_points : int 267 | The number of points to be generated. 268 | num_dim : int 269 | The number of dimensions. 270 | 271 | Returns 272 | ------- 273 | points : (num_points, num_dim) ndarray 274 | The first num_points of the num_dim-dimensional. 275 | 276 | """ 277 | return _design.hammersley_sequence(num_dim, num_points).T 278 | 279 | 280 | def ihs(num_points, num_dim, seed=None, duplication=5): 281 | """ 282 | Generate the improved distributed hypercube sequence. 283 | 284 | Parameters 285 | ---------- 286 | num_points : int 287 | The number of points to be generated. 288 | num_dim : int 289 | The number of dimensions. 290 | seed : int 291 | A seed for the random number generator. 292 | duplication : int 293 | See ihs.f90. 294 | 295 | Returns 296 | ------- 297 | points : (num_points, num_dim) ndarray 298 | The first num_points of the num_dim-dimensional. 299 | 300 | """ 301 | if seed is None: 302 | seed = _design.get_seed() 303 | return _design.ihs(num_dim, num_points, seed=seed, 304 | duplication=duplication).T 305 | 306 | 307 | def sobol(num_points, num_dim, skip=0): 308 | """ 309 | Generate the Sobol quasirandom sequence. 310 | 311 | Parameters 312 | ---------- 313 | num_points : int 314 | The number of points to be generated. 315 | num_dim : int 316 | The number of dimensions. 317 | skip : int 318 | Skip that many elements of the sequence. 319 | 320 | Returns 321 | ------- 322 | points : (num_points, num_dim) ndarray 323 | The first num_points of the num_dim-dimensional. 324 | 325 | """ 326 | return _design.i8_sobol_generate(num_dim, num_points, skip=skip).T 327 | 328 | 329 | def lambert(num_points, num_dim): 330 | """ 331 | Generate the Lambert quasirandom sequence. 332 | 333 | Parameters 334 | ---------- 335 | num_points : int 336 | The number of points to be generated. 337 | num_dim : int 338 | The number of dimensions (between 1 and 4). 339 | 340 | Returns 341 | ------- 342 | points : (num_points, num_dim) ndarray 343 | The first num_points of the num_dim-dimensional. 344 | 345 | """ 346 | assert num_dim <= 4 347 | func = 'lambert' + str(num_dim) 348 | return getattr(_design, func)(num_points).T 349 | -------------------------------------------------------------------------------- /meson.build: -------------------------------------------------------------------------------- 1 | project('design', 'c', 'fortran', 2 | meson_version: '>=0.64.0', 3 | default_options : ['warning_level=2'], 4 | ) 5 | 6 | py_mod = import('python') 7 | py = py_mod.find_installation(pure: false) 8 | py_dep = py.dependency() 9 | 10 | incdir_numpy = run_command(py, 11 | ['-c', 'import os; os.chdir(".."); import numpy; print(numpy.get_include())'], 12 | check : true 13 | ).stdout().strip() 14 | 15 | incdir_f2py = run_command(py, 16 | ['-c', 'import os; os.chdir(".."); import numpy.f2py; print(numpy.f2py.get_include())'], 17 | check : true 18 | ).stdout().strip() 19 | 20 | fortran_src_files = [ 21 | 'src/faure.f90', 22 | 'src/halton.f90', 23 | 'src/hammersley.f90', 24 | 'src/ihs.f90', 25 | 'src/lambert.f90', 26 | 'src/latin_center.f90', 27 | 'src/latin_cover.f90', 28 | 'src/latin_edge.f90', 29 | 'src/latin_random.f90', 30 | 'src/latinize.f90', 31 | 'src/sandia_sparse.f90', 32 | 'src/sobol.f90' 33 | ] 34 | 35 | designfortran_source = custom_target('_designfortranmodule.c', 36 | input : fortran_src_files, 37 | output : ['_designfortranmodule.c', '_designfortran-f2pywrappers.f'], 38 | command : [py, '-m', 'numpy.f2py', '@INPUT@', '-m', '_designfortran', '--lower'] 39 | ) 40 | 41 | inc_np = include_directories(incdir_numpy, incdir_f2py) 42 | 43 | py.extension_module('_designfortran', 44 | fortran_src_files, 45 | designfortran_source, 46 | incdir_f2py / 'fortranobject.c', 47 | include_directories: inc_np, 48 | dependencies : py_dep, 49 | install : true 50 | ) 51 | 52 | py.install_sources( 53 | 'design/__init__.py', 54 | subdir: 'design' 55 | ) -------------------------------------------------------------------------------- /pyproject.toml: -------------------------------------------------------------------------------- 1 | [build-system] 2 | requires = ["meson-python", "numpy"] 3 | build-backend = "mesonpy" 4 | 5 | [project] 6 | name = "py-design" 7 | version = "2.1" 8 | description = "Design points for random experiments" 9 | readme = "README.md" 10 | authors = [ 11 | {name = "Ilias Bilionis", email = "ibilion@purdue.edu"} 12 | ] 13 | urls = {Homepage = "https://github.com/ebilionis/py-design"} 14 | keywords = [ 15 | "design", "random experiment", "latin hypercube", 16 | "sparse grid", "computer experiments" 17 | ] 18 | classifiers = [ 19 | "Programming Language :: Python :: 3", 20 | "Programming Language :: Fortran", 21 | "License :: OSI Approved :: MIT License", 22 | "Topic :: Scientific/Engineering" 23 | ] 24 | dependencies = [ 25 | "numpy" 26 | ] 27 | license = { file = "LICENSE.txt" } -------------------------------------------------------------------------------- /src/faure.f90: -------------------------------------------------------------------------------- 1 | subroutine binomial_table ( qs, m, n, coef ) 2 | 3 | !*****************************************************************************80 4 | ! 5 | !! BINOMIAL_TABLE computes a table of bionomial coefficients MOD QS. 6 | ! 7 | ! Discussion: 8 | ! 9 | ! Thanks to Michael Baudin for pointing out an error in a previous 10 | ! version of this function, 07 December 2009. 11 | ! 12 | ! Licensing: 13 | ! 14 | ! This code is distributed under the GNU LGPL license. 15 | ! 16 | ! Modified: 17 | ! 18 | ! 07 December 2009 19 | ! 20 | ! Author: 21 | ! 22 | ! John Burkardt 23 | ! 24 | ! Parameters: 25 | ! 26 | ! Input, integer ( kind = 4 ) QS, the base for the MOD operation. 27 | ! 28 | ! Input, integer ( kind = 4 ) M, N, the limits of the binomial table. 29 | ! 30 | ! Output, integer ( kind = 4 ) COEF(0:M,0:N), the table of binomial 31 | ! coefficients modulo QS. 32 | ! 33 | implicit none 34 | 35 | integer ( kind = 4 ) m 36 | integer ( kind = 4 ) n 37 | 38 | integer ( kind = 4 ) coef(0:m,0:n) 39 | integer ( kind = 4 ) i 40 | integer ( kind = 4 ) j 41 | integer ( kind = 4 ) qs 42 | 43 | coef(0:m,0:n) = 0 44 | 45 | coef(0:m,0) = 1 46 | 47 | do j = 1, min ( m, n ) 48 | coef(j,j) = 1 49 | end do 50 | 51 | do j = 1, n 52 | do i = j + 1, m 53 | coef(i,j) = mod ( coef(i-1,j) + coef(i-1,j-1), qs ) 54 | end do 55 | end do 56 | 57 | return 58 | end 59 | subroutine faure ( dim_num, seed, quasi ) 60 | 61 | !*****************************************************************************80 62 | ! 63 | !! FAURE generates a new quasirandom Faure vector with each call. 64 | ! 65 | ! Discussion: 66 | ! 67 | ! This routine implements Faure's method of computing 68 | ! quasirandom numbers. It is a merging and adaptation of 69 | ! Bennett Fox's routines INFAUR and GOFAUR from ACM TOMS 70 | ! Algorithm 647. 71 | ! 72 | ! Licensing: 73 | ! 74 | ! This code is distributed under the GNU LGPL license. 75 | ! 76 | ! Modified: 77 | ! 78 | ! 16 September 2005 79 | ! 80 | ! Author: 81 | ! 82 | ! John Burkardt 83 | ! 84 | ! Reference: 85 | ! 86 | ! Henri Faure, 87 | ! Discrepance de suites associees a un systeme de numeration 88 | ! (en dimension s), 89 | ! Acta Arithmetica, 90 | ! Volume 41, 1982, pages 337-351, especially page 342. 91 | ! 92 | ! Bennett Fox, 93 | ! Algorithm 647: 94 | ! Implementation and Relative Efficiency of Quasirandom 95 | ! Sequence Generators, 96 | ! ACM Transactions on Mathematical Software, 97 | ! Volume 12, Number 4, pages 362-376, 1986. 98 | ! 99 | ! Parameters: 100 | ! 101 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension, which should be 102 | ! at least 2. 103 | ! 104 | ! Input/output, integer ( kind = 4 ) SEED, the seed, which can be used to 105 | ! index the values. On first call, set the input value of SEED to be 0 106 | ! or negative. The routine will automatically initialize data, 107 | ! and set SEED to a new value. Thereafter, to compute successive 108 | ! entries of the sequence, simply call again without changing 109 | ! SEED. On the first call, if SEED is negative, it will be set 110 | ! to a positive value that "skips over" an early part of the sequence 111 | ! (This is recommended for better results). 112 | ! 113 | ! Output, real ( kind = 8 ) QUASI(DIM_NUM), the next quasirandom vector. 114 | ! 115 | implicit none 116 | 117 | integer ( kind = 4 ) dim_num 118 | 119 | integer ( kind = 4 ), save, allocatable, dimension ( :, : ) :: coef 120 | integer ( kind = 4 ) hisum 121 | integer ( kind = 4 ), save :: hisum_save = -1 122 | integer ( kind = 4 ) i 123 | integer ( kind = 4 ) i4_log_i4 124 | integer ( kind = 4 ) j 125 | integer ( kind = 4 ) k 126 | integer ( kind = 4 ) ktemp 127 | integer ( kind = 4 ) ltemp 128 | integer ( kind = 4 ) mtemp 129 | integer ( kind = 4 ) prime_ge 130 | integer ( kind = 4 ), save :: qs = -1 131 | real ( kind = 8 ) quasi(dim_num) 132 | real ( kind = 8 ) r 133 | integer ( kind = 4 ) seed 134 | integer ( kind = 4 ), save, allocatable, dimension ( : ) :: ytemp 135 | integer ( kind = 4 ) ztemp 136 | ! 137 | ! Initialization required or requested? 138 | ! 139 | if ( qs <= 0 .or. seed <= 0 ) then 140 | 141 | qs = prime_ge ( dim_num ) 142 | 143 | if ( qs < 1 ) then 144 | write ( *, '(a)' ) ' ' 145 | write ( *, '(a)' ) 'FAURE - Fatal error!' 146 | write ( *, '(a)' ) ' PRIME_GE failed.' 147 | stop 148 | end if 149 | 150 | hisum_save = -1 151 | 152 | end if 153 | ! 154 | ! If SEED < 0, reset for recommended initial skip. 155 | ! 156 | if ( seed < 0 ) then 157 | 158 | hisum = 3 159 | seed = qs**( hisum + 1 ) - 1 160 | 161 | elseif ( seed == 0 ) then 162 | 163 | hisum = 0 164 | 165 | else 166 | 167 | hisum = i4_log_i4 ( seed, qs ) 168 | 169 | end if 170 | ! 171 | ! Is it necessary to recompute the coefficient table? 172 | ! 173 | if ( hisum_save < hisum ) then 174 | 175 | if ( allocated ( coef ) ) then 176 | deallocate ( coef ) 177 | end if 178 | 179 | if ( allocated ( ytemp ) ) then 180 | deallocate ( ytemp ) 181 | end if 182 | 183 | hisum_save = hisum 184 | 185 | allocate ( coef(0:hisum,0:hisum) ) 186 | allocate ( ytemp(0:hisum) ) 187 | 188 | call binomial_table ( qs, hisum, hisum, coef ) 189 | 190 | end if 191 | ! 192 | ! Find QUASI(1) using the method of Faure. 193 | ! 194 | ! SEED has a representation in base QS of the form: 195 | ! 196 | ! Sum ( 0 <= J <= HISUM ) YTEMP(J) * QS**J 197 | ! 198 | ! We now compute the YTEMP(J)'s. 199 | ! 200 | ktemp = qs**( hisum + 1 ) 201 | ltemp = seed 202 | do i = hisum, 0, -1 203 | ktemp = ktemp / qs 204 | mtemp = mod ( ltemp, ktemp ) 205 | ytemp(i) = ( ltemp - mtemp ) / ktemp 206 | ltemp = mtemp 207 | end do 208 | ! 209 | ! QUASI(K) has the form 210 | ! 211 | ! Sum ( 0 <= J <= HISUM ) YTEMP(J) / QS**(J+1) 212 | ! 213 | ! Compute QUASI(1) using nested multiplication. 214 | ! 215 | r = real ( ytemp(hisum), kind = 8 ) 216 | do i = hisum - 1, 0, -1 217 | r = real ( ytemp(i), kind = 8 ) + r / real ( qs, kind = 8 ) 218 | end do 219 | 220 | quasi(1) = r / real ( qs, kind = 8 ) 221 | ! 222 | ! Find components QUASI(2:DIM_NUM) using the Faure method. 223 | ! 224 | do k = 2, dim_num 225 | 226 | quasi(k) = 0.0D+00 227 | r = 1.0D+00 / real ( qs, kind = 8 ) 228 | 229 | do j = 0, hisum 230 | 231 | ztemp = dot_product ( ytemp(j:hisum), coef(j:hisum,j) ) 232 | ! 233 | ! New YTEMP(J) is: 234 | ! 235 | ! Sum ( J <= I <= HISUM ) ( old ytemp(i) * binom(i,j) ) mod QS. 236 | ! 237 | ytemp(j) = mod ( ztemp, qs ) 238 | quasi(k) = quasi(k) + real ( ytemp(j), kind = 8 ) * r 239 | r = r / real ( qs, kind = 8 ) 240 | 241 | end do 242 | 243 | end do 244 | ! 245 | ! Update SEED. 246 | ! 247 | seed = seed + 1 248 | 249 | return 250 | end 251 | subroutine faure_generate ( dim_num, n, skip, base, r ) 252 | 253 | !*****************************************************************************80 254 | ! 255 | !! FAURE_GENERATE generates a Faure dataset. 256 | ! 257 | ! Licensing: 258 | ! 259 | ! This code is distributed under the GNU LGPL license. 260 | ! 261 | ! Modified: 262 | ! 263 | ! 19 March 2003 264 | ! 265 | ! Author: 266 | ! 267 | ! John Burkardt 268 | ! 269 | ! Parameters: 270 | ! 271 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 272 | ! 273 | ! Input, integer ( kind = 4 ) N, the number of points to generate. 274 | ! 275 | ! Input, integer ( kind = 4 ) SKIP, the number of initial points to skip. 276 | ! 277 | ! Output, integer ( kind = 4 ) BASE, the base used for the sequence. 278 | ! 279 | ! Output, real ( kind = 8 ) R(DIM_NUM,N), the points. 280 | ! 281 | implicit none 282 | 283 | integer ( kind = 4 ) dim_num 284 | integer ( kind = 4 ) n 285 | 286 | integer ( kind = 4 ) base 287 | integer ( kind = 4 ) j 288 | integer ( kind = 4 ) prime_ge 289 | real ( kind = 8 ) r(dim_num,n) 290 | integer ( kind = 4 ) seed 291 | integer ( kind = 4 ) skip 292 | !f2py integer intent(in) :: dim_num 293 | !f2py integer intent(in) :: n 294 | !f2py integer optional,intent(in) :: skip=3141 295 | !f2py integer intent(hide) :: base 296 | !f2py real*8 intent(out),depend(dim_num,n),dimension(dim_num,n) :: r 297 | base = prime_ge ( dim_num ) 298 | 299 | do j = 1, n 300 | seed = skip + j - 1 301 | call faure ( dim_num, seed, r(1:dim_num,j) ) 302 | end do 303 | 304 | return 305 | end 306 | 307 | function i4_log_i4 ( i4, j4 ) 308 | 309 | !*****************************************************************************80 310 | ! 311 | !! I4_LOG_I4 returns the logarithm of an I4 to an I4 base. 312 | ! 313 | ! Discussion: 314 | ! 315 | ! Only the integer part of the logarithm is returned. 316 | ! 317 | ! If 318 | ! 319 | ! K4 = I4_LOG_J4 ( I4, J4 ), 320 | ! 321 | ! then we ordinarily have 322 | ! 323 | ! J4^(K4-1) < I4 <= J4^K4. 324 | ! 325 | ! The base J4 should be positive, and at least 2. If J4 is negative, 326 | ! a computation is made using the absolute value of J4. If J4 is 327 | ! -1, 0, or 1, the logarithm is returned as 0. 328 | ! 329 | ! The number I4 should be positive and at least 2. If I4 is negative, 330 | ! a computation is made using the absolute value of I4. If I4 is 331 | ! -1, 0, or 1, then the logarithm is returned as 0. 332 | ! 333 | ! An I4 is an integer ( kind = 4 ) value. 334 | ! 335 | ! Example: 336 | ! 337 | ! I4 J4 K4 338 | ! 339 | ! 0 3 0 340 | ! 1 3 0 341 | ! 2 3 0 342 | ! 3 3 1 343 | ! 4 3 1 344 | ! 8 3 1 345 | ! 9 3 2 346 | ! 10 3 2 347 | ! 348 | ! Licensing: 349 | ! 350 | ! This code is distributed under the GNU LGPL license. 351 | ! 352 | ! Modified: 353 | ! 354 | ! 09 June 2007 355 | ! 356 | ! Author: 357 | ! 358 | ! John Burkardt 359 | ! 360 | ! Parameters: 361 | ! 362 | ! Input, integer ( kind = 4 ) I4, the number whose logarithm is desired. 363 | ! 364 | ! Input, integer ( kind = 4 ) J4, the base of the logarithms. 365 | ! 366 | ! Output, integer ( kind = 4 ) I4_LOG_I4, the integer part of the logarithm 367 | ! base abs(J4) of abs(I4). 368 | ! 369 | implicit none 370 | 371 | integer ( kind = 4 ) i4 372 | integer ( kind = 4 ) i4_abs 373 | integer ( kind = 4 ) i4_log_i4 374 | integer ( kind = 4 ) j4 375 | integer ( kind = 4 ) j4_abs 376 | integer ( kind = 4 ) value 377 | 378 | value = 0 379 | 380 | i4_abs = abs ( i4 ) 381 | 382 | if ( 2 <= i4_abs ) then 383 | 384 | j4_abs = abs ( j4 ) 385 | 386 | if ( 2 <= j4_abs ) then 387 | 388 | do while ( j4_abs <= i4_abs ) 389 | i4_abs = i4_abs / j4_abs 390 | value = value + 1 391 | end do 392 | 393 | end if 394 | 395 | end if 396 | 397 | i4_log_i4 = value 398 | 399 | return 400 | end 401 | function prime_ge ( n ) 402 | 403 | !*****************************************************************************80 404 | ! 405 | !! PRIME_GE returns the smallest prime greater than or equal to N. 406 | ! 407 | ! Example: 408 | ! 409 | ! N PRIME_GE 410 | ! 411 | ! -10 2 412 | ! 1 2 413 | ! 2 2 414 | ! 3 3 415 | ! 4 5 416 | ! 5 5 417 | ! 6 7 418 | ! 7 7 419 | ! 8 11 420 | ! 9 11 421 | ! 10 11 422 | ! 423 | ! Licensing: 424 | ! 425 | ! This code is distributed under the GNU LGPL license. 426 | ! 427 | ! Modified: 428 | ! 429 | ! 09 March 2003 430 | ! 431 | ! Author: 432 | ! 433 | ! John Burkardt 434 | ! 435 | ! Parameters: 436 | ! 437 | ! Input, integer ( kind = 4 ) N, the number to be bounded. 438 | ! 439 | ! Output, integer ( kind = 4 ) PRIME_GE, the smallest prime number that is 440 | ! greater than or equal to N. However, if N is larger than 12,553, (the 441 | ! largest prime stored), then PRIME_GE is returned as -1. 442 | ! 443 | implicit none 444 | 445 | integer ( kind = 4 ) i_hi 446 | integer ( kind = 4 ) i_lo 447 | integer ( kind = 4 ) i_mid 448 | integer ( kind = 4 ) n 449 | integer ( kind = 4 ) p_hi 450 | integer ( kind = 4 ) p_lo 451 | integer ( kind = 4 ) p_mid 452 | integer ( kind = 4 ) prime 453 | integer ( kind = 4 ) prime_ge 454 | 455 | if ( n <= 2 ) then 456 | prime_ge = 2 457 | return 458 | end if 459 | 460 | i_lo = 1 461 | p_lo = prime(i_lo) 462 | i_hi = prime(-1) 463 | p_hi = prime(i_hi) 464 | 465 | if ( p_hi < n ) then 466 | prime_ge = -p_hi 467 | return 468 | end if 469 | 470 | do 471 | 472 | if ( i_lo + 1 == i_hi ) then 473 | prime_ge = p_hi 474 | return 475 | end if 476 | 477 | i_mid = ( i_lo + i_hi ) / 2 478 | p_mid = prime(i_mid) 479 | 480 | if ( p_mid < n ) then 481 | i_lo = i_mid 482 | p_lo = p_mid 483 | else if ( n <= p_mid ) then 484 | i_hi = i_mid 485 | p_hi = p_mid 486 | end if 487 | 488 | end do 489 | 490 | return 491 | end 492 | function prime ( n ) 493 | 494 | !*****************************************************************************80 495 | ! 496 | !! PRIME returns any of the first PRIME_MAX prime numbers. 497 | ! 498 | ! Discussion: 499 | ! 500 | ! PRIME_MAX is 1600, and the largest prime stored is 13499. 501 | ! 502 | ! Thanks to Bart Vandewoestyne for pointing out a typo, 18 February 2005. 503 | ! 504 | ! Licensing: 505 | ! 506 | ! This code is distributed under the GNU LGPL license. 507 | ! 508 | ! Modified: 509 | ! 510 | ! 18 February 2005 511 | ! 512 | ! Author: 513 | ! 514 | ! John Burkardt 515 | ! 516 | ! Reference: 517 | ! 518 | ! Milton Abramowitz and Irene Stegun, 519 | ! Handbook of Mathematical Functions, 520 | ! US Department of Commerce, 1964, pages 870-873. 521 | ! 522 | ! Daniel Zwillinger, 523 | ! CRC Standard Mathematical Tables and Formulae, 524 | ! 30th Edition, 525 | ! CRC Press, 1996, pages 95-98. 526 | ! 527 | ! Parameters: 528 | ! 529 | ! Input, integer ( kind = 4 ) N, the index of the desired prime number. 530 | ! In general, is should be true that 0 <= N <= PRIME_MAX. 531 | ! N = -1 returns PRIME_MAX, the index of the largest prime available. 532 | ! N = 0 is legal, returning PRIME = 1. 533 | ! 534 | ! Output, integer ( kind = 4 ) PRIME, the N-th prime. If N is out of range, 535 | ! PRIME is returned as -1. 536 | ! 537 | implicit none 538 | 539 | integer ( kind = 4 ), parameter :: prime_max = 1600 540 | 541 | integer ( kind = 4 ), save :: icall = 0 542 | integer ( kind = 4 ) n 543 | integer ( kind = 4 ), save, dimension ( prime_max ) :: npvec 544 | integer ( kind = 4 ) prime 545 | 546 | if ( icall == 0 ) then 547 | 548 | icall = 1 549 | 550 | npvec(1:100) = (/ & 551 | 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, & 552 | 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, & 553 | 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, & 554 | 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, & 555 | 179, 181, 191, 193, 197, 199, 211, 223, 227, 229, & 556 | 233, 239, 241, 251, 257, 263, 269, 271, 277, 281, & 557 | 283, 293, 307, 311, 313, 317, 331, 337, 347, 349, & 558 | 353, 359, 367, 373, 379, 383, 389, 397, 401, 409, & 559 | 419, 421, 431, 433, 439, 443, 449, 457, 461, 463, & 560 | 467, 479, 487, 491, 499, 503, 509, 521, 523, 541 /) 561 | 562 | npvec(101:200) = (/ & 563 | 547, 557, 563, 569, 571, 577, 587, 593, 599, 601, & 564 | 607, 613, 617, 619, 631, 641, 643, 647, 653, 659, & 565 | 661, 673, 677, 683, 691, 701, 709, 719, 727, 733, & 566 | 739, 743, 751, 757, 761, 769, 773, 787, 797, 809, & 567 | 811, 821, 823, 827, 829, 839, 853, 857, 859, 863, & 568 | 877, 881, 883, 887, 907, 911, 919, 929, 937, 941, & 569 | 947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013, & 570 | 1019, 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069, & 571 | 1087, 1091, 1093, 1097, 1103, 1109, 1117, 1123, 1129, 1151, & 572 | 1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213, 1217, 1223 /) 573 | 574 | npvec(201:300) = (/ & 575 | 1229, 1231, 1237, 1249, 1259, 1277, 1279, 1283, 1289, 1291, & 576 | 1297, 1301, 1303, 1307, 1319, 1321, 1327, 1361, 1367, 1373, & 577 | 1381, 1399, 1409, 1423, 1427, 1429, 1433, 1439, 1447, 1451, & 578 | 1453, 1459, 1471, 1481, 1483, 1487, 1489, 1493, 1499, 1511, & 579 | 1523, 1531, 1543, 1549, 1553, 1559, 1567, 1571, 1579, 1583, & 580 | 1597, 1601, 1607, 1609, 1613, 1619, 1621, 1627, 1637, 1657, & 581 | 1663, 1667, 1669, 1693, 1697, 1699, 1709, 1721, 1723, 1733, & 582 | 1741, 1747, 1753, 1759, 1777, 1783, 1787, 1789, 1801, 1811, & 583 | 1823, 1831, 1847, 1861, 1867, 1871, 1873, 1877, 1879, 1889, & 584 | 1901, 1907, 1913, 1931, 1933, 1949, 1951, 1973, 1979, 1987 /) 585 | 586 | npvec(301:400) = (/ & 587 | 1993, 1997, 1999, 2003, 2011, 2017, 2027, 2029, 2039, 2053, & 588 | 2063, 2069, 2081, 2083, 2087, 2089, 2099, 2111, 2113, 2129, & 589 | 2131, 2137, 2141, 2143, 2153, 2161, 2179, 2203, 2207, 2213, & 590 | 2221, 2237, 2239, 2243, 2251, 2267, 2269, 2273, 2281, 2287, & 591 | 2293, 2297, 2309, 2311, 2333, 2339, 2341, 2347, 2351, 2357, & 592 | 2371, 2377, 2381, 2383, 2389, 2393, 2399, 2411, 2417, 2423, & 593 | 2437, 2441, 2447, 2459, 2467, 2473, 2477, 2503, 2521, 2531, & 594 | 2539, 2543, 2549, 2551, 2557, 2579, 2591, 2593, 2609, 2617, & 595 | 2621, 2633, 2647, 2657, 2659, 2663, 2671, 2677, 2683, 2687, & 596 | 2689, 2693, 2699, 2707, 2711, 2713, 2719, 2729, 2731, 2741 /) 597 | 598 | npvec(401:500) = (/ & 599 | 2749, 2753, 2767, 2777, 2789, 2791, 2797, 2801, 2803, 2819, & 600 | 2833, 2837, 2843, 2851, 2857, 2861, 2879, 2887, 2897, 2903, & 601 | 2909, 2917, 2927, 2939, 2953, 2957, 2963, 2969, 2971, 2999, & 602 | 3001, 3011, 3019, 3023, 3037, 3041, 3049, 3061, 3067, 3079, & 603 | 3083, 3089, 3109, 3119, 3121, 3137, 3163, 3167, 3169, 3181, & 604 | 3187, 3191, 3203, 3209, 3217, 3221, 3229, 3251, 3253, 3257, & 605 | 3259, 3271, 3299, 3301, 3307, 3313, 3319, 3323, 3329, 3331, & 606 | 3343, 3347, 3359, 3361, 3371, 3373, 3389, 3391, 3407, 3413, & 607 | 3433, 3449, 3457, 3461, 3463, 3467, 3469, 3491, 3499, 3511, & 608 | 3517, 3527, 3529, 3533, 3539, 3541, 3547, 3557, 3559, 3571 /) 609 | 610 | npvec(501:600) = (/ & 611 | 3581, 3583, 3593, 3607, 3613, 3617, 3623, 3631, 3637, 3643, & 612 | 3659, 3671, 3673, 3677, 3691, 3697, 3701, 3709, 3719, 3727, & 613 | 3733, 3739, 3761, 3767, 3769, 3779, 3793, 3797, 3803, 3821, & 614 | 3823, 3833, 3847, 3851, 3853, 3863, 3877, 3881, 3889, 3907, & 615 | 3911, 3917, 3919, 3923, 3929, 3931, 3943, 3947, 3967, 3989, & 616 | 4001, 4003, 4007, 4013, 4019, 4021, 4027, 4049, 4051, 4057, & 617 | 4073, 4079, 4091, 4093, 4099, 4111, 4127, 4129, 4133, 4139, & 618 | 4153, 4157, 4159, 4177, 4201, 4211, 4217, 4219, 4229, 4231, & 619 | 4241, 4243, 4253, 4259, 4261, 4271, 4273, 4283, 4289, 4297, & 620 | 4327, 4337, 4339, 4349, 4357, 4363, 4373, 4391, 4397, 4409 /) 621 | 622 | npvec(601:700) = (/ & 623 | 4421, 4423, 4441, 4447, 4451, 4457, 4463, 4481, 4483, 4493, & 624 | 4507, 4513, 4517, 4519, 4523, 4547, 4549, 4561, 4567, 4583, & 625 | 4591, 4597, 4603, 4621, 4637, 4639, 4643, 4649, 4651, 4657, & 626 | 4663, 4673, 4679, 4691, 4703, 4721, 4723, 4729, 4733, 4751, & 627 | 4759, 4783, 4787, 4789, 4793, 4799, 4801, 4813, 4817, 4831, & 628 | 4861, 4871, 4877, 4889, 4903, 4909, 4919, 4931, 4933, 4937, & 629 | 4943, 4951, 4957, 4967, 4969, 4973, 4987, 4993, 4999, 5003, & 630 | 5009, 5011, 5021, 5023, 5039, 5051, 5059, 5077, 5081, 5087, & 631 | 5099, 5101, 5107, 5113, 5119, 5147, 5153, 5167, 5171, 5179, & 632 | 5189, 5197, 5209, 5227, 5231, 5233, 5237, 5261, 5273, 5279 /) 633 | 634 | npvec(701:800) = (/ & 635 | 5281, 5297, 5303, 5309, 5323, 5333, 5347, 5351, 5381, 5387, & 636 | 5393, 5399, 5407, 5413, 5417, 5419, 5431, 5437, 5441, 5443, & 637 | 5449, 5471, 5477, 5479, 5483, 5501, 5503, 5507, 5519, 5521, & 638 | 5527, 5531, 5557, 5563, 5569, 5573, 5581, 5591, 5623, 5639, & 639 | 5641, 5647, 5651, 5653, 5657, 5659, 5669, 5683, 5689, 5693, & 640 | 5701, 5711, 5717, 5737, 5741, 5743, 5749, 5779, 5783, 5791, & 641 | 5801, 5807, 5813, 5821, 5827, 5839, 5843, 5849, 5851, 5857, & 642 | 5861, 5867, 5869, 5879, 5881, 5897, 5903, 5923, 5927, 5939, & 643 | 5953, 5981, 5987, 6007, 6011, 6029, 6037, 6043, 6047, 6053, & 644 | 6067, 6073, 6079, 6089, 6091, 6101, 6113, 6121, 6131, 6133 /) 645 | 646 | npvec(801:900) = (/ & 647 | 6143, 6151, 6163, 6173, 6197, 6199, 6203, 6211, 6217, 6221, & 648 | 6229, 6247, 6257, 6263, 6269, 6271, 6277, 6287, 6299, 6301, & 649 | 6311, 6317, 6323, 6329, 6337, 6343, 6353, 6359, 6361, 6367, & 650 | 6373, 6379, 6389, 6397, 6421, 6427, 6449, 6451, 6469, 6473, & 651 | 6481, 6491, 6521, 6529, 6547, 6551, 6553, 6563, 6569, 6571, & 652 | 6577, 6581, 6599, 6607, 6619, 6637, 6653, 6659, 6661, 6673, & 653 | 6679, 6689, 6691, 6701, 6703, 6709, 6719, 6733, 6737, 6761, & 654 | 6763, 6779, 6781, 6791, 6793, 6803, 6823, 6827, 6829, 6833, & 655 | 6841, 6857, 6863, 6869, 6871, 6883, 6899, 6907, 6911, 6917, & 656 | 6947, 6949, 6959, 6961, 6967, 6971, 6977, 6983, 6991, 6997 /) 657 | 658 | npvec(901:1000) = (/ & 659 | 7001, 7013, 7019, 7027, 7039, 7043, 7057, 7069, 7079, 7103, & 660 | 7109, 7121, 7127, 7129, 7151, 7159, 7177, 7187, 7193, 7207, & 661 | 7211, 7213, 7219, 7229, 7237, 7243, 7247, 7253, 7283, 7297, & 662 | 7307, 7309, 7321, 7331, 7333, 7349, 7351, 7369, 7393, 7411, & 663 | 7417, 7433, 7451, 7457, 7459, 7477, 7481, 7487, 7489, 7499, & 664 | 7507, 7517, 7523, 7529, 7537, 7541, 7547, 7549, 7559, 7561, & 665 | 7573, 7577, 7583, 7589, 7591, 7603, 7607, 7621, 7639, 7643, & 666 | 7649, 7669, 7673, 7681, 7687, 7691, 7699, 7703, 7717, 7723, & 667 | 7727, 7741, 7753, 7757, 7759, 7789, 7793, 7817, 7823, 7829, & 668 | 7841, 7853, 7867, 7873, 7877, 7879, 7883, 7901, 7907, 7919 /) 669 | 670 | npvec(1001:1100) = (/ & 671 | 7927, 7933, 7937, 7949, 7951, 7963, 7993, 8009, 8011, 8017, & 672 | 8039, 8053, 8059, 8069, 8081, 8087, 8089, 8093, 8101, 8111, & 673 | 8117, 8123, 8147, 8161, 8167, 8171, 8179, 8191, 8209, 8219, & 674 | 8221, 8231, 8233, 8237, 8243, 8263, 8269, 8273, 8287, 8291, & 675 | 8293, 8297, 8311, 8317, 8329, 8353, 8363, 8369, 8377, 8387, & 676 | 8389, 8419, 8423, 8429, 8431, 8443, 8447, 8461, 8467, 8501, & 677 | 8513, 8521, 8527, 8537, 8539, 8543, 8563, 8573, 8581, 8597, & 678 | 8599, 8609, 8623, 8627, 8629, 8641, 8647, 8663, 8669, 8677, & 679 | 8681, 8689, 8693, 8699, 8707, 8713, 8719, 8731, 8737, 8741, & 680 | 8747, 8753, 8761, 8779, 8783, 8803, 8807, 8819, 8821, 8831 /) 681 | 682 | npvec(1101:1200) = (/ & 683 | 8837, 8839, 8849, 8861, 8863, 8867, 8887, 8893, 8923, 8929, & 684 | 8933, 8941, 8951, 8963, 8969, 8971, 8999, 9001, 9007, 9011, & 685 | 9013, 9029, 9041, 9043, 9049, 9059, 9067, 9091, 9103, 9109, & 686 | 9127, 9133, 9137, 9151, 9157, 9161, 9173, 9181, 9187, 9199, & 687 | 9203, 9209, 9221, 9227, 9239, 9241, 9257, 9277, 9281, 9283, & 688 | 9293, 9311, 9319, 9323, 9337, 9341, 9343, 9349, 9371, 9377, & 689 | 9391, 9397, 9403, 9413, 9419, 9421, 9431, 9433, 9437, 9439, & 690 | 9461, 9463, 9467, 9473, 9479, 9491, 9497, 9511, 9521, 9533, & 691 | 9539, 9547, 9551, 9587, 9601, 9613, 9619, 9623, 9629, 9631, & 692 | 9643, 9649, 9661, 9677, 9679, 9689, 9697, 9719, 9721, 9733 /) 693 | 694 | npvec(1201:1300) = (/ & 695 | 9739, 9743, 9749, 9767, 9769, 9781, 9787, 9791, 9803, 9811, & 696 | 9817, 9829, 9833, 9839, 9851, 9857, 9859, 9871, 9883, 9887, & 697 | 9901, 9907, 9923, 9929, 9931, 9941, 9949, 9967, 9973,10007, & 698 | 10009,10037,10039,10061,10067,10069,10079,10091,10093,10099, & 699 | 10103,10111,10133,10139,10141,10151,10159,10163,10169,10177, & 700 | 10181,10193,10211,10223,10243,10247,10253,10259,10267,10271, & 701 | 10273,10289,10301,10303,10313,10321,10331,10333,10337,10343, & 702 | 10357,10369,10391,10399,10427,10429,10433,10453,10457,10459, & 703 | 10463,10477,10487,10499,10501,10513,10529,10531,10559,10567, & 704 | 10589,10597,10601,10607,10613,10627,10631,10639,10651,10657 /) 705 | 706 | npvec(1301:1400) = (/ & 707 | 10663,10667,10687,10691,10709,10711,10723,10729,10733,10739, & 708 | 10753,10771,10781,10789,10799,10831,10837,10847,10853,10859, & 709 | 10861,10867,10883,10889,10891,10903,10909,10937,10939,10949, & 710 | 10957,10973,10979,10987,10993,11003,11027,11047,11057,11059, & 711 | 11069,11071,11083,11087,11093,11113,11117,11119,11131,11149, & 712 | 11159,11161,11171,11173,11177,11197,11213,11239,11243,11251, & 713 | 11257,11261,11273,11279,11287,11299,11311,11317,11321,11329, & 714 | 11351,11353,11369,11383,11393,11399,11411,11423,11437,11443, & 715 | 11447,11467,11471,11483,11489,11491,11497,11503,11519,11527, & 716 | 11549,11551,11579,11587,11593,11597,11617,11621,11633,11657 /) 717 | 718 | npvec(1401:1500) = (/ & 719 | 11677,11681,11689,11699,11701,11717,11719,11731,11743,11777, & 720 | 11779,11783,11789,11801,11807,11813,11821,11827,11831,11833, & 721 | 11839,11863,11867,11887,11897,11903,11909,11923,11927,11933, & 722 | 11939,11941,11953,11959,11969,11971,11981,11987,12007,12011, & 723 | 12037,12041,12043,12049,12071,12073,12097,12101,12107,12109, & 724 | 12113,12119,12143,12149,12157,12161,12163,12197,12203,12211, & 725 | 12227,12239,12241,12251,12253,12263,12269,12277,12281,12289, & 726 | 12301,12323,12329,12343,12347,12373,12377,12379,12391,12401, & 727 | 12409,12413,12421,12433,12437,12451,12457,12473,12479,12487, & 728 | 12491,12497,12503,12511,12517,12527,12539,12541,12547,12553 /) 729 | 730 | npvec(1501:1600) = (/ & 731 | 12569,12577,12583,12589,12601,12611,12613,12619,12637,12641, & 732 | 12647,12653,12659,12671,12689,12697,12703,12713,12721,12739, & 733 | 12743,12757,12763,12781,12791,12799,12809,12821,12823,12829, & 734 | 12841,12853,12889,12893,12899,12907,12911,12917,12919,12923, & 735 | 12941,12953,12959,12967,12973,12979,12983,13001,13003,13007, & 736 | 13009,13033,13037,13043,13049,13063,13093,13099,13103,13109, & 737 | 13121,13127,13147,13151,13159,13163,13171,13177,13183,13187, & 738 | 13217,13219,13229,13241,13249,13259,13267,13291,13297,13309, & 739 | 13313,13327,13331,13337,13339,13367,13381,13397,13399,13411, & 740 | 13417,13421,13441,13451,13457,13463,13469,13477,13487,13499 /) 741 | 742 | end if 743 | 744 | if ( n == -1 ) then 745 | prime = prime_max 746 | else if ( n == 0 ) then 747 | prime = 1 748 | else if ( n <= prime_max ) then 749 | prime = npvec(n) 750 | else 751 | prime = -1 752 | write ( *, '(a)' ) ' ' 753 | write ( *, '(a)' ) 'PRIME - Fatal error!' 754 | write ( *, '(a,i6)' ) ' Illegal prime index N = ', n 755 | write ( *, '(a,i6)' ) ' N should be between 1 and PRIME_MAX =', prime_max 756 | stop 757 | end if 758 | 759 | return 760 | end 761 | -------------------------------------------------------------------------------- /src/halton.f90: -------------------------------------------------------------------------------- 1 | function arc_cosine ( c ) 2 | 3 | !*****************************************************************************80 4 | ! 5 | !! ARC_COSINE computes the arc cosine function, with argument truncation. 6 | ! 7 | ! Discussion: 8 | ! 9 | ! If you call your system ACOS routine with an input argument that is 10 | ! outside the range [-1.0, 1.0 ], you may get an unpleasant surprise. 11 | ! This routine truncates arguments outside the range. 12 | ! 13 | ! Licensing: 14 | ! 15 | ! This code is distributed under the GNU LGPL license. 16 | ! 17 | ! Modified: 18 | ! 19 | ! 02 December 2000 20 | ! 21 | ! Author: 22 | ! 23 | ! John Burkardt 24 | ! 25 | ! Parameters: 26 | ! 27 | ! Input, real ( kind = 8 ) C, the argument. 28 | ! 29 | ! Output, real ( kind = 8 ) ARC_COSINE, an angle whose cosine is C. 30 | ! 31 | implicit none 32 | 33 | real ( kind = 8 ) arc_cosine 34 | real ( kind = 8 ) c 35 | real ( kind = 8 ) c2 36 | 37 | c2 = c 38 | c2 = max ( c2, real ( -1.0D+00, kind = 8 ) ) 39 | c2 = min ( c2, real ( 1.0D+00, kind = 8 ) ) 40 | 41 | arc_cosine = acos ( c2 ) 42 | 43 | return 44 | end 45 | function atan4 ( y, x ) 46 | 47 | !*****************************************************************************80 48 | ! 49 | !! ATAN4 computes the inverse tangent of the ratio Y / X. 50 | ! 51 | ! Discussion: 52 | ! 53 | ! ATAN4 returns an angle whose tangent is ( Y / X ), a job which 54 | ! the built in functions ATAN and ATAN2 already do. 55 | ! 56 | ! However: 57 | ! 58 | ! * ATAN4 always returns a positive angle, between 0 and 2 PI, 59 | ! while ATAN and ATAN2 return angles in the interval [-PI/2,+PI/2] 60 | ! and [-PI,+PI] respectively; 61 | ! 62 | ! * ATAN4 accounts for the signs of X and Y, (as does ATAN2). The ATAN 63 | ! function by contrast always returns an angle in the first or fourth 64 | ! quadrants. 65 | ! 66 | ! Licensing: 67 | ! 68 | ! This code is distributed under the GNU LGPL license. 69 | ! 70 | ! Modified: 71 | ! 72 | ! 14 April 1999 73 | ! 74 | ! Author: 75 | ! 76 | ! John Burkardt 77 | ! 78 | ! Parameters: 79 | ! 80 | ! Input, real ( kind = 8 ) Y, X, two quantities which represent the 81 | ! tangent of an angle. If Y is not zero, then the tangent is (Y/X). 82 | ! 83 | ! Output, real ( kind = 8 ) ATAN4, an angle between 0 and 2 * PI, 84 | ! whose tangent is (Y/X), and which lies in the appropriate quadrant 85 | ! so that the signs of its cosine and sine match those of X and Y. 86 | ! 87 | implicit none 88 | 89 | real ( kind = 8 ) abs_x 90 | real ( kind = 8 ) abs_y 91 | real ( kind = 8 ) atan4 92 | real ( kind = 8 ), parameter :: pi = 3.141592653589793D+00 93 | real ( kind = 8 ) theta 94 | real ( kind = 8 ) theta_0 95 | real ( kind = 8 ) x 96 | real ( kind = 8 ) y 97 | ! 98 | ! Special cases: 99 | ! 100 | if ( x == 0.0D+00 ) then 101 | 102 | if ( 0.0D+00 < y ) then 103 | theta = pi / real ( 2.0D+00, kind = 8 ) 104 | else if ( y < 0.0D+00 ) then 105 | theta = real ( 3.0D+00, kind = 8 ) * pi / real ( 2.0D+00, kind = 8 ) 106 | else if ( y == 0.0D+00 ) then 107 | theta = 0.0D+00 108 | end if 109 | 110 | else if ( y == 0.0D+00 ) then 111 | 112 | if ( 0.0D+00 < x ) then 113 | theta = 0.0D+00 114 | else if ( x < 0.0D+00 ) then 115 | theta = pi 116 | end if 117 | ! 118 | ! We assume that ATAN2 is correct when both arguments are positive. 119 | ! 120 | else 121 | 122 | abs_y = abs ( y ) 123 | abs_x = abs ( x ) 124 | 125 | theta_0 = atan2 ( abs_y, abs_x ) 126 | 127 | if ( 0.0D+00 < x .and. 0.0D+00 < y ) then 128 | theta = theta_0 129 | else if ( x < 0.0D+00 .and. 0.0D+00 < y ) then 130 | theta = pi - theta_0 131 | else if ( x < 0.0D+00 .and. y < 0.0D+00 ) then 132 | theta = pi + theta_0 133 | else if ( 0.0D+00 < x .and. y < 0.0D+00 ) then 134 | theta = real ( 2.0D+00, kind = 8 ) * pi - theta_0 135 | end if 136 | 137 | end if 138 | 139 | atan4 = theta 140 | 141 | return 142 | end 143 | function halham_leap_check ( dim_num, leap ) 144 | 145 | !*****************************************************************************80 146 | ! 147 | !! HALHAM_LEAP_CHECK checks LEAP for a Halton or Hammersley sequence. 148 | ! 149 | ! Licensing: 150 | ! 151 | ! This code is distributed under the GNU LGPL license. 152 | ! 153 | ! Modified: 154 | ! 155 | ! 16 July 2004 156 | ! 157 | ! Author: 158 | ! 159 | ! John Burkardt 160 | ! 161 | ! Parameters: 162 | ! 163 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 164 | ! 165 | ! Input, integer ( kind = 4 ) LEAP(DIM_NUM), the leap vector. 166 | ! 167 | ! Output, logical, HALHAM_LEAP_CHECK, is true if LEAP is legal. 168 | ! 169 | implicit none 170 | 171 | integer ( kind = 4 ) dim_num 172 | 173 | logical halham_leap_check 174 | integer ( kind = 4 ) leap(dim_num) 175 | 176 | if ( any ( leap(1:dim_num) < 1 ) ) then 177 | write ( *, '(a)' ) ' ' 178 | write ( *, '(a)' ) 'HALHAM_LEAP_CHECK - Fatal error!' 179 | write ( *, '(a)' ) ' Some entry of LEAP < 1!' 180 | write ( *, '(a)' ) ' ' 181 | call i4vec_transpose_print ( dim_num, leap, 'LEAP: ' ) 182 | halham_leap_check = .false. 183 | else 184 | halham_leap_check = .true. 185 | end if 186 | 187 | return 188 | end 189 | function halham_n_check ( n ) 190 | 191 | !*****************************************************************************80 192 | ! 193 | !! HALHAM_N_CHECK checks N for a Halton or Hammersley sequence. 194 | ! 195 | ! Licensing: 196 | ! 197 | ! This code is distributed under the GNU LGPL license. 198 | ! 199 | ! Modified: 200 | ! 201 | ! 16 July 2004 202 | ! 203 | ! Author: 204 | ! 205 | ! John Burkardt 206 | ! 207 | ! Parameters: 208 | ! 209 | ! Input, integer ( kind = 4 ) N, the spatial dimension. 210 | ! 211 | ! Output, logical HALHAM_N_CHECK, is true if N is legal. 212 | ! 213 | implicit none 214 | 215 | logical halham_n_check 216 | integer ( kind = 4 ) n 217 | 218 | if ( n < 1 ) then 219 | write ( *, '(a)' ) ' ' 220 | write ( *, '(a)' ) 'HALHAM_N_CHECK - Fatal error!' 221 | write ( *, '(a)' ) ' N < 1.' 222 | write ( *, '(a,i12)' ) ' N = ', n 223 | halham_n_check = .false. 224 | else 225 | halham_n_check = .true. 226 | end if 227 | 228 | return 229 | end 230 | function halham_dim_num_check ( dim_num ) 231 | 232 | !*****************************************************************************80 233 | ! 234 | !! HALHAM_DIM_NUM_CHECK checks DIM_NUM for a Halton or Hammersley sequence. 235 | ! 236 | ! Licensing: 237 | ! 238 | ! This code is distributed under the GNU LGPL license. 239 | ! 240 | ! Modified: 241 | ! 242 | ! 16 July 2004 243 | ! 244 | ! Author: 245 | ! 246 | ! John Burkardt 247 | ! 248 | ! Parameters: 249 | ! 250 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 251 | ! 252 | ! Output, logical HALHAM_DIM_NUM_CHECK, is true if DIM_NUM is legal. 253 | ! 254 | implicit none 255 | 256 | integer ( kind = 4 ) dim_num 257 | logical halham_dim_num_check 258 | 259 | if ( dim_num < 1 ) then 260 | write ( *, '(a)' ) ' ' 261 | write ( *, '(a)' ) 'HALHAM_DIM_NUM_CHECK - Fatal error!' 262 | write ( *, '(a)' ) ' DIM_NUM < 1.' 263 | write ( *, '(a,i12)' ) ' DIM_NUM = ', dim_num 264 | halham_dim_num_check = .false. 265 | else 266 | halham_dim_num_check = .true. 267 | end if 268 | 269 | return 270 | end 271 | function halham_seed_check ( dim_num, seed ) 272 | 273 | !*****************************************************************************80 274 | ! 275 | !! HALHAM_SEED_CHECK checks SEED for a Halton or Hammersley sequence. 276 | ! 277 | ! Licensing: 278 | ! 279 | ! This code is distributed under the GNU LGPL license. 280 | ! 281 | ! Modified: 282 | ! 283 | ! 16 July 2004 284 | ! 285 | ! Author: 286 | ! 287 | ! John Burkardt 288 | ! 289 | ! Parameters: 290 | ! 291 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 292 | ! 293 | ! Input, integer ( kind = 4 ) SEED(DIM_NUM), the seed vector. 294 | ! 295 | ! Output, logical, HALHAM_SEED_CHECK, is true if SEED is legal. 296 | ! 297 | implicit none 298 | 299 | integer ( kind = 4 ) dim_num 300 | 301 | logical halham_seed_check 302 | integer ( kind = 4 ) seed(dim_num) 303 | 304 | if ( any ( seed(1:dim_num) < 0 ) ) then 305 | write ( *, '(a)' ) ' ' 306 | write ( *, '(a)' ) 'HALHAM_SEED_CHECK - Fatal error!' 307 | write ( *, '(a)' ) ' Some entry of SEED < 0!' 308 | write ( *, '(a)' ) ' ' 309 | call i4vec_transpose_print ( dim_num, seed, 'SEED: ' ) 310 | halham_seed_check = .false. 311 | else 312 | halham_seed_check = .true. 313 | end if 314 | 315 | return 316 | end 317 | function halham_step_check ( step ) 318 | 319 | !*****************************************************************************80 320 | ! 321 | !! HALHAM_STEP_CHECK checks STEP for a Halton or Hammersley sequence. 322 | ! 323 | ! Licensing: 324 | ! 325 | ! This code is distributed under the GNU LGPL license. 326 | ! 327 | ! Modified: 328 | ! 329 | ! 16 July 2004 330 | ! 331 | ! Author: 332 | ! 333 | ! John Burkardt 334 | ! 335 | ! Parameters: 336 | ! 337 | ! Input, integer ( kind = 4 ) STEP, the index of the subsequence element. 338 | ! 339 | ! Output, logical HALHAM_STEP_CHECK, is true if STEP is legal. 340 | ! 341 | implicit none 342 | 343 | logical halham_step_check 344 | integer ( kind = 4 ) step 345 | 346 | if ( step < 0 ) then 347 | write ( *, '(a)' ) ' ' 348 | write ( *, '(a)' ) 'HALHAM_STEP_CHECK - Fatal error!' 349 | write ( *, '(a)' ) ' STEP < 0.' 350 | write ( *, '(a,i12)' ) ' STEP = ', step 351 | halham_step_check = .false. 352 | else 353 | halham_step_check = .true. 354 | end if 355 | 356 | return 357 | end 358 | subroutine halham_write ( dim_num, n, step, seed, leap, base, r, file_out_name ) 359 | 360 | !*****************************************************************************80 361 | ! 362 | !! HALHAM_WRITE writes a Halton or Hammersley subsequence to a file. 363 | ! 364 | ! Discussion: 365 | ! 366 | ! The initial lines of the file are comments, which begin with a 367 | ! '#' character. 368 | ! 369 | ! Thereafter, each line of the file contains the DIM_NUM-dimensional 370 | ! components of the next entry of the dataset. 371 | ! 372 | ! Licensing: 373 | ! 374 | ! This code is distributed under the GNU LGPL license. 375 | ! 376 | ! Modified: 377 | ! 378 | ! 01 August 2007 379 | ! 380 | ! Author: 381 | ! 382 | ! John Burkardt 383 | ! 384 | ! Parameters: 385 | ! 386 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 387 | ! 388 | ! Input, integer ( kind = 4 ) N, the number of elements in the subsequence. 389 | ! 390 | ! Input, integer ( kind = 4 ) STEP, the index of the subsequence element. 391 | ! 0 <= STEP is required. 392 | ! 393 | ! Input, integer ( kind = 4 ) SEED(DIM_NUM), the sequence index for STEP = 0. 394 | ! 395 | ! Input, integer ( kind = 4 ) LEAP(DIM_NUM), the successive jumps in 396 | ! the sequence. 397 | ! 398 | ! Input, integer ( kind = 4 ) BASE(DIM_NUM), the bases. 399 | ! 400 | ! Input, real ( kind = 8 ) R(DIM_NUM,N), the points. 401 | ! 402 | ! Input, character ( len = * ) FILE_OUT_NAME, the output file name. 403 | ! 404 | implicit none 405 | 406 | integer ( kind = 4 ) dim_num 407 | integer ( kind = 4 ) n 408 | 409 | integer ( kind = 4 ) base(dim_num) 410 | logical, parameter :: comment = .false. 411 | character ( len = * ) file_out_name 412 | integer ( kind = 4 ) file_out_unit 413 | integer ( kind = 4 ) ios 414 | integer ( kind = 4 ) j 415 | integer ( kind = 4 ) leap(dim_num) 416 | integer ( kind = 4 ) mhi 417 | integer ( kind = 4 ) mlo 418 | real ( kind = 8 ) r(dim_num,n) 419 | integer ( kind = 4 ) seed(dim_num) 420 | integer ( kind = 4 ) step 421 | character ( len = 40 ) string 422 | 423 | call get_unit ( file_out_unit ) 424 | 425 | open ( unit = file_out_unit, file = file_out_name, status = 'replace', & 426 | iostat = ios ) 427 | 428 | if ( ios /= 0 ) then 429 | write ( *, '(a)' ) ' ' 430 | write ( *, '(a)' ) 'HALHAM_WRITE - Fatal error!' 431 | write ( *, '(a)' ) ' Could not open the output file:' 432 | write ( *, '(a)' ) ' "' // trim ( file_out_name ) // '".' 433 | stop 434 | end if 435 | 436 | if ( comment ) then 437 | 438 | write ( file_out_unit, '(a)' ) '# ' // trim ( file_out_name ) 439 | write ( file_out_unit, '(a)' ) '# created by HALHAM_WRITE.F90' 440 | write ( file_out_unit, '(a)' ) '#' 441 | write ( file_out_unit, '(a)' ) '#' 442 | write ( file_out_unit, '(a,i12)' ) '# DIM_NUM = ', dim_num 443 | write ( file_out_unit, '(a,i12)' ) '# N = ', n 444 | write ( file_out_unit, '(a,i12)' ) '# STEP = ', step 445 | 446 | do mlo = 1, dim_num, 5 447 | mhi = min ( mlo + 5 - 1, dim_num ) 448 | if ( mlo == 1 ) then 449 | write ( file_out_unit, '(a,5i12)' ) '# SEED = ', seed(mlo:mhi) 450 | else 451 | write ( file_out_unit, '(a,5i12)' ) '# ', seed(mlo:mhi) 452 | end if 453 | end do 454 | do mlo = 1, dim_num, 5 455 | mhi = min ( mlo + 5 - 1, dim_num ) 456 | if ( mlo == 1 ) then 457 | write ( file_out_unit, '(a,5i12)' ) '# LEAP = ', leap(mlo:mhi) 458 | else 459 | write ( file_out_unit, '(a,5i12)' ) '# ', leap(mlo:mhi) 460 | end if 461 | end do 462 | do mlo = 1, dim_num, 5 463 | mhi = min ( mlo + 5 - 1, dim_num ) 464 | if ( mlo == 1 ) then 465 | write ( file_out_unit, '(a,5i12)' ) '# BASE = ', base(mlo:mhi) 466 | else 467 | write ( file_out_unit, '(a,5i12)' ) '# ', base(mlo:mhi) 468 | end if 469 | end do 470 | write ( file_out_unit, '(a,g14.6)' ) '# EPSILON (unit roundoff ) = ', & 471 | epsilon ( r(1,1) ) 472 | write ( file_out_unit, '(a)' ) '#' 473 | 474 | end if 475 | 476 | write ( string, '(a,i3,a)' ) '(', dim_num, '(2x,f10.6))' 477 | 478 | do j = 1, n 479 | write ( file_out_unit, string ) r(1:dim_num,j) 480 | end do 481 | 482 | close ( unit = file_out_unit ) 483 | 484 | return 485 | end 486 | subroutine halton ( dim_num, r ) 487 | 488 | !*****************************************************************************80 489 | ! 490 | !! HALTON computes the next element in a leaped Halton subsequence. 491 | ! 492 | ! Discussion: 493 | ! 494 | ! The DIM_NUM-dimensional Halton sequence is really DIM_NUM separate 495 | ! sequences, each generated by a particular base. 496 | ! 497 | ! This routine selects elements of a "leaped" subsequence of the 498 | ! Halton sequence. The subsequence elements are indexed by a 499 | ! quantity called STEP, which starts at 0. The STEP-th subsequence 500 | ! element is simply element 501 | ! 502 | ! SEED(1:DIM_NUM) + STEP * LEAP(1:DIM_NUM) 503 | ! 504 | ! of the original Halton sequence. 505 | ! 506 | ! 507 | ! This routine "hides" a number of input arguments. To specify these 508 | ! arguments explicitly, use I4_TO_HALTON instead. 509 | ! 510 | ! All the arguments have default values. However, if you want to 511 | ! examine or change them, you may call the appropriate routine first. 512 | ! 513 | ! * DIM_NUM, the spatial dimension, 514 | ! Default: DIM_NUM = 1; 515 | ! Required: 1 <= DIM_NUM is required. 516 | ! 517 | ! * STEP, the subsequence index. 518 | ! Default: STEP = 0. 519 | ! Required: 0 <= STEP. 520 | ! 521 | ! * SEED(1:DIM_NUM), the Halton sequence element corresponding to STEP = 0. 522 | ! Default SEED = (0, 0, ... 0). 523 | ! Required: 0 <= SEED(1:DIM_NUM). 524 | ! 525 | ! * LEAP(1:DIM_NUM), the succesive jumps in the Halton sequence. 526 | ! Default: LEAP = (1, 1, ..., 1). 527 | ! Required: 1 <= LEAP(1:DIM_NUM). 528 | ! 529 | ! * BASE(1:DIM_NUM), the Halton bases. 530 | ! Default: BASE = (2, 3, 5, 7, 11, ... ). 531 | ! Required: 1 < BASE(1:DIM_NUM). 532 | ! 533 | ! Licensing: 534 | ! 535 | ! This code is distributed under the GNU LGPL license. 536 | ! 537 | ! Modified: 538 | ! 539 | ! 04 July 2004 540 | ! 541 | ! Author: 542 | ! 543 | ! John Burkardt 544 | ! 545 | ! Reference: 546 | ! 547 | ! John Halton, 548 | ! On the efficiency of certain quasi-random sequences of points 549 | ! in evaluating multi-dimensional integrals, 550 | ! Numerische Mathematik, 551 | ! Volume 2, 1960, pages 84-90. 552 | ! 553 | ! John Halton and G B Smith, 554 | ! Algorithm 247: Radical-Inverse Quasi-Random Point Sequence, 555 | ! Communications of the ACM, 556 | ! Volume 7, 1964, pages 701-702. 557 | ! 558 | ! Ladislav Kocis and William Whiten, 559 | ! Computational Investigations of Low-Discrepancy Sequences, 560 | ! ACM Transactions on Mathematical Software, 561 | ! Volume 23, Number 2, 1997, pages 266-294. 562 | ! 563 | ! Parameters: 564 | ! 565 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 566 | ! 567 | ! Output, real ( kind = 8 ) R(DIM_NUM), the next element of the 568 | ! leaped Halton subsequence. 569 | ! 570 | implicit none 571 | 572 | integer ( kind = 4 ) dim_num 573 | 574 | integer ( kind = 4 ) base(dim_num) 575 | integer ( kind = 4 ) leap(dim_num) 576 | real ( kind = 8 ) r(dim_num) 577 | integer ( kind = 4 ) seed(dim_num) 578 | integer ( kind = 4 ) step 579 | integer ( kind = 4 ) value(1) 580 | 581 | value(1) = dim_num 582 | call halton_memory ( 'SET', 'DIM_NUM', 1, value ) 583 | call halton_memory ( 'GET', 'STEP', 1, value ) 584 | step = value(1) 585 | call halton_memory ( 'GET', 'SEED', dim_num, seed ) 586 | call halton_memory ( 'GET', 'LEAP', dim_num, leap ) 587 | call halton_memory ( 'GET', 'BASE', dim_num, base ) 588 | 589 | call i4_to_halton ( dim_num, step, seed, leap, base, r ) 590 | 591 | value(1) = 1 592 | call halton_memory ( 'INC', 'STEP', 1, value ) 593 | 594 | return 595 | end 596 | subroutine halton_base_get ( base ) 597 | 598 | !*****************************************************************************80 599 | ! 600 | !! HALTON_BASE_GET gets the base vector for a leaped Halton subsequence. 601 | ! 602 | ! Licensing: 603 | ! 604 | ! This code is distributed under the GNU LGPL license. 605 | ! 606 | ! Modified: 607 | ! 608 | ! 16 July 2004 609 | ! 610 | ! Author: 611 | ! 612 | ! John Burkardt 613 | ! 614 | ! Parameters: 615 | ! 616 | ! Output, integer ( kind = 4 ) BASE(DIM_NUM), the Halton bases. 617 | ! 618 | implicit none 619 | 620 | integer ( kind = 4 ) dim_num 621 | integer ( kind = 4 ) base(*) 622 | integer ( kind = 4 ) value(1) 623 | 624 | call halton_memory ( 'GET', 'DIM_NUM', 1, value ) 625 | dim_num = value(1) 626 | 627 | call halton_memory ( 'GET', 'BASE', dim_num, base ) 628 | 629 | return 630 | end 631 | function halton_base_check ( dim_num, base ) 632 | 633 | !*****************************************************************************80 634 | ! 635 | !! HALTON_BASE_CHECK checks BASE for a Halton sequence. 636 | ! 637 | ! Licensing: 638 | ! 639 | ! This code is distributed under the GNU LGPL license. 640 | ! 641 | ! Modified: 642 | ! 643 | ! 16 July 2004 644 | ! 645 | ! Author: 646 | ! 647 | ! John Burkardt 648 | ! 649 | ! Parameters: 650 | ! 651 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 652 | ! 653 | ! Input, integer ( kind = 4 ) BASE(DIM_NUM), the bases. 654 | ! 655 | ! Output, logical, HALTON_BASE_CHECK, is true if BASE is legal. 656 | ! 657 | implicit none 658 | 659 | integer ( kind = 4 ) dim_num 660 | 661 | integer ( kind = 4 ) base(dim_num) 662 | logical halton_base_check 663 | 664 | if ( any ( base(1:dim_num) <= 1 ) ) then 665 | write ( *, '(a)' ) ' ' 666 | write ( *, '(a)' ) 'HALTON_BASE_CHECK - Fatal error!' 667 | write ( *, '(a)' ) ' Some entry of BASE is <= 1!' 668 | write ( *, '(a)' ) ' ' 669 | call i4vec_transpose_print ( dim_num, base, 'BASE: ' ) 670 | halton_base_check = .false. 671 | else 672 | halton_base_check = .true. 673 | end if 674 | 675 | return 676 | end 677 | subroutine halton_base_set ( base ) 678 | 679 | !*****************************************************************************80 680 | ! 681 | !! HALTON_BASE_SET sets the base vector for a leaped Halton subsequence. 682 | ! 683 | ! Licensing: 684 | ! 685 | ! This code is distributed under the GNU LGPL license. 686 | ! 687 | ! Modified: 688 | ! 689 | ! 20 October 2004 690 | ! 691 | ! Author: 692 | ! 693 | ! John Burkardt 694 | ! 695 | ! Parameters: 696 | ! 697 | ! Input, integer ( kind = 4 ) BASE(DIM_NUM), the Halton bases. 698 | ! 699 | implicit none 700 | 701 | integer ( kind = 4 ) base(*) 702 | logical halton_base_check 703 | integer ( kind = 4 ) dim_num 704 | integer ( kind = 4 ) value(1) 705 | 706 | call halton_memory ( 'GET', 'DIM_NUM', 1, value ) 707 | dim_num = value(1) 708 | 709 | if ( .not. halton_base_check ( dim_num, base ) ) then 710 | stop 711 | end if 712 | 713 | call halton_memory ( 'SET', 'BASE', dim_num, base ) 714 | 715 | return 716 | end 717 | subroutine halton_leap_get ( leap ) 718 | 719 | !*****************************************************************************80 720 | ! 721 | !! HALTON_LEAP_GET gets the leap vector for a leaped Halton subsequence. 722 | ! 723 | ! Licensing: 724 | ! 725 | ! This code is distributed under the GNU LGPL license. 726 | ! 727 | ! Modified: 728 | ! 729 | ! 16 July 2004 730 | ! 731 | ! Author: 732 | ! 733 | ! John Burkardt 734 | ! 735 | ! Parameters: 736 | ! 737 | ! Output, integer ( kind = 4 ) LEAP(DIM_NUM), the successive jumps in 738 | ! the Halton sequence. 739 | ! 740 | implicit none 741 | 742 | integer ( kind = 4 ) dim_num 743 | integer ( kind = 4 ) leap(*) 744 | integer ( kind = 4 ) value(1) 745 | 746 | call halton_memory ( 'GET', 'DIM_NUM', 1, value ) 747 | dim_num = value(1) 748 | 749 | call halton_memory ( 'GET', 'LEAP', dim_num, leap ) 750 | 751 | return 752 | end 753 | subroutine halton_leap_set ( leap ) 754 | 755 | !*****************************************************************************80 756 | ! 757 | !! HALTON_LEAP_SET sets the leap vector for a leaped Halton subsequence. 758 | ! 759 | ! Licensing: 760 | ! 761 | ! This code is distributed under the GNU LGPL license. 762 | ! 763 | ! Modified: 764 | ! 765 | ! 16 July 2004 766 | ! 767 | ! Author: 768 | ! 769 | ! John Burkardt 770 | ! 771 | ! Parameters: 772 | ! 773 | ! Input, integer ( kind = 4 ) LEAP(DIM_NUM), the successive jumps in 774 | ! the Halton sequence. 775 | ! 776 | implicit none 777 | 778 | integer ( kind = 4 ) dim_num 779 | logical halham_leap_check 780 | integer ( kind = 4 ) leap(*) 781 | integer ( kind = 4 ) value(1) 782 | 783 | call halton_memory ( 'GET', 'DIM_NUM', 1, value ) 784 | dim_num = value(1) 785 | 786 | if ( .not. halham_leap_check ( dim_num, leap ) ) then 787 | stop 788 | end if 789 | 790 | call halton_memory ( 'SET', 'LEAP', dim_num, leap ) 791 | 792 | return 793 | end 794 | subroutine halton_memory ( action, name, dim_num, value ) 795 | 796 | !*****************************************************************************80 797 | ! 798 | !! HALTON_MEMORY holds data associated with a leaped Halton subsequence. 799 | ! 800 | ! Discussion: 801 | ! 802 | ! If you're going to define a new problem, it's important that 803 | ! you set the value of DIM_NUM before setting the values of BASE, 804 | ! LEAP or SEED. 805 | ! 806 | ! Licensing: 807 | ! 808 | ! This code is distributed under the GNU LGPL license. 809 | ! 810 | ! Modified: 811 | ! 812 | ! 04 July 2004 813 | ! 814 | ! Author: 815 | ! 816 | ! John Burkardt 817 | ! 818 | ! Parameters: 819 | ! 820 | ! Input, character ( len = * ) ACTION, the desired action. 821 | ! 'GET' means get the value of a particular quantity. 822 | ! 'SET' means set the value of a particular quantity. 823 | ! 'INC' means increment the value of a particular quantity. 824 | ! (Only SEED and STEP can be incremented.) 825 | ! 826 | ! Input, character ( len = * ) NAME, the name of the quantity. 827 | ! 'BASE' means the Halton base vector. 828 | ! 'LEAP' means the Halton leap vector. 829 | ! 'DIM_NUM' means the spatial dimension. 830 | ! 'SEED' means the Halton seed vector. 831 | ! 'STEP' means the Halton step. 832 | ! 833 | ! Input/output, integer ( kind = 4 ) DIM_NUM, the dimension of the quantity. 834 | ! If ACTION is 'SET' and NAME is 'BASE', then DIM_NUM is input, and 835 | ! is the number of entries in VALUE to be put into BASE. 836 | ! 837 | ! Input/output, integer ( kind = 4 ) VALUE(DIM_NUM), contains a value. 838 | ! If ACTION is 'SET', then on input, VALUE contains values to be assigned 839 | ! to the internal variable. 840 | ! If ACTION is 'GET', then on output, VALUE contains the values of 841 | ! the specified internal variable. 842 | ! If ACTION is 'INC', then on input, VALUE contains the increment to 843 | ! be added to the specified internal variable. 844 | ! 845 | implicit none 846 | 847 | character ( len = * ) action 848 | integer ( kind = 4 ), allocatable, save, dimension ( : ) :: base 849 | logical, save :: first_call = .true. 850 | integer ( kind = 4 ) i 851 | integer ( kind = 4 ), allocatable, save, dimension ( : ) :: leap 852 | character ( len = * ) name 853 | integer ( kind = 4 ) dim_num 854 | integer ( kind = 4 ), save :: dim_num_save = 0 855 | integer ( kind = 4 ) prime 856 | integer ( kind = 4 ), allocatable, save, dimension ( : ) :: seed 857 | integer ( kind = 4 ), save :: step = 0 858 | integer ( kind = 4 ) value(*) 859 | 860 | if ( first_call ) then 861 | dim_num_save = 1 862 | allocate ( base(dim_num_save) ) 863 | allocate ( leap(dim_num_save) ) 864 | allocate ( seed(dim_num_save) ) 865 | base(1) = 2 866 | leap(1) = 1 867 | seed(1) = 0 868 | step = 0 869 | first_call = .false. 870 | end if 871 | ! 872 | ! If this is a SET DIM_NUM call, and the input value of DIM_NUM 873 | ! differs from the internal value, discard all old information. 874 | ! 875 | if ( action(1:1) == 'S' .or. action(1:1) == 's') then 876 | if ( name == 'DIM_NUM' .or. name == 'dim_num' ) then 877 | if ( dim_num_save /= value(1) ) then 878 | deallocate ( base ) 879 | deallocate ( leap ) 880 | deallocate ( seed ) 881 | dim_num_save = value(1) 882 | allocate ( base(dim_num_save) ) 883 | allocate ( leap(dim_num_save) ) 884 | allocate ( seed(dim_num_save) ) 885 | do i = 1, dim_num_save 886 | base(i) = prime ( i ) 887 | end do 888 | leap(1:dim_num_save) = 1 889 | seed(1:dim_num_save) = 0 890 | end if 891 | end if 892 | end if 893 | ! 894 | ! Set 895 | ! 896 | if ( action(1:1) == 'S' .or. action(1:1) == 's' ) then 897 | 898 | if ( name == 'BASE' .or. name == 'base' ) then 899 | 900 | if ( dim_num_save /= dim_num ) then 901 | write ( *, '(a)' ) ' ' 902 | write ( *, '(a)' ) 'HALTON_MEMORY - Fatal error!' 903 | write ( *, '(a)' ) ' Internal and input values of DIM_NUM disagree' 904 | write ( *, '(a)' ) ' while setting BASE.' 905 | stop 906 | end if 907 | 908 | base(1:dim_num) = value(1:dim_num) 909 | 910 | else if ( name == 'LEAP' .or. name == 'leap' ) then 911 | 912 | if ( dim_num_save /= dim_num ) then 913 | write ( *, '(a)' ) ' ' 914 | write ( *, '(a)' ) 'HALTON_MEMORY - Fatal error!' 915 | write ( *, '(a)' ) ' Internal and input values of DIM_NUM disagree' 916 | write ( *, '(a)' ) ' while setting LEAP.' 917 | stop 918 | end if 919 | 920 | leap(1:dim_num) = value(1:dim_num) 921 | 922 | else if ( name == 'DIM_NUM' .or. name == 'dim_num' ) then 923 | 924 | dim_num_save = value(1) 925 | 926 | else if ( name == 'SEED' .or. name == 'seed' ) then 927 | 928 | if ( dim_num_save /= dim_num ) then 929 | write ( *, '(a)' ) ' ' 930 | write ( *, '(a)' ) 'HALTON_MEMORY - Fatal error!' 931 | write ( *, '(a)' ) ' Internal and input values of DIM_NUM disagree' 932 | write ( *, '(a)' ) ' while setting SEED.' 933 | stop 934 | end if 935 | 936 | seed(1:dim_num) = value(1:dim_num) 937 | 938 | else if ( name == 'STEP' .or. name == 'step' ) then 939 | 940 | if ( value(1) < 0 ) then 941 | write ( *, '(a)' ) ' ' 942 | write ( *, '(a)' ) 'HALTON_MEMORY - Fatal error!' 943 | write ( *, '(a)' ) ' Input value of STEP < 0.' 944 | stop 945 | end if 946 | 947 | step = value(1) 948 | 949 | end if 950 | ! 951 | ! Get 952 | ! 953 | else if ( action(1:1) == 'G' .or. action(1:1) == 'g' ) then 954 | 955 | if ( name == 'BASE' .or. name == 'base' ) then 956 | 957 | value(1:dim_num_save) = base(1:dim_num_save) 958 | 959 | else if ( name == 'LEAP' .or. name == 'leap' ) then 960 | 961 | value(1:dim_num_save) = leap(1:dim_num_save) 962 | 963 | else if ( name == 'DIM_NUM' .or. name == 'dim_num' ) then 964 | 965 | value(1) = dim_num_save 966 | 967 | else if ( name == 'SEED' .or. name == 'seed' ) then 968 | 969 | value(1:dim_num_save) = seed(1:dim_num_save) 970 | 971 | else if ( name == 'STEP' .or. name == 'step' ) then 972 | 973 | value(1) = step 974 | 975 | end if 976 | ! 977 | ! Increment 978 | ! 979 | else if ( action(1:1) == 'I' .or. action(1:1) == 'i' ) then 980 | 981 | if ( name == 'SEED' .or. name == 'seed' ) then 982 | if ( dim_num == 1 ) then 983 | seed(1:dim_num_save) = seed(1:dim_num_save) + value(1) 984 | else 985 | seed(1:dim_num_save) = seed(1:dim_num_save) + value(1:dim_num_save) 986 | end if 987 | else if ( name == 'STEP' .or. name == 'step' ) then 988 | step = step + value(1) 989 | end if 990 | 991 | end if 992 | 993 | return 994 | end 995 | subroutine halton_dim_num_get ( dim_num ) 996 | 997 | !*****************************************************************************80 998 | ! 999 | !! HALTON_DIM_NUM_GET: spatial dimension for a leaped Halton subsequence. 1000 | ! 1001 | ! Licensing: 1002 | ! 1003 | ! This code is distributed under the GNU LGPL license. 1004 | ! 1005 | ! Modified: 1006 | ! 1007 | ! 28 August 2002 1008 | ! 1009 | ! Author: 1010 | ! 1011 | ! John Burkardt 1012 | ! 1013 | ! Parameters: 1014 | ! 1015 | ! Output, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 1016 | ! 1017 | implicit none 1018 | 1019 | integer ( kind = 4 ) dim_num 1020 | integer ( kind = 4 ) value(1) 1021 | 1022 | call halton_memory ( 'GET', 'DIM_NUM', 1, value ) 1023 | dim_num = value(1) 1024 | 1025 | return 1026 | end 1027 | subroutine halton_dim_num_set ( dim_num ) 1028 | 1029 | !*****************************************************************************80 1030 | ! 1031 | !! HALTON_DIM_NUM_SET sets the spatial dimension for leaped Halton subsequence. 1032 | ! 1033 | ! Licensing: 1034 | ! 1035 | ! This code is distributed under the GNU LGPL license. 1036 | ! 1037 | ! Modified: 1038 | ! 1039 | ! 26 February 2001 1040 | ! 1041 | ! Author: 1042 | ! 1043 | ! John Burkardt 1044 | ! 1045 | ! Parameters: 1046 | ! 1047 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 1048 | ! 1 <= DIM_NUM is required. 1049 | ! 1050 | implicit none 1051 | 1052 | integer ( kind = 4 ) dim_num 1053 | logical halham_dim_num_check 1054 | integer ( kind = 4 ) value(1) 1055 | 1056 | if ( .not. halham_dim_num_check ( dim_num ) ) then 1057 | stop 1058 | end if 1059 | 1060 | value(1) = dim_num 1061 | call halton_memory ( 'SET', 'DIM_NUM', 1, value ) 1062 | 1063 | return 1064 | end 1065 | subroutine halton_seed_get ( seed ) 1066 | 1067 | !*****************************************************************************80 1068 | ! 1069 | !! HALTON_SEED_GET gets the seed vector for a leaped Halton subsequence. 1070 | ! 1071 | ! Licensing: 1072 | ! 1073 | ! This code is distributed under the GNU LGPL license. 1074 | ! 1075 | ! Modified: 1076 | ! 1077 | ! 16 July 2004 1078 | ! 1079 | ! Author: 1080 | ! 1081 | ! John Burkardt 1082 | ! 1083 | ! Parameters: 1084 | ! 1085 | ! Output, integer ( kind = 4 ) SEED(DIM_NUM), the Halton sequence index 1086 | ! corresponding to STEP = 0. 1087 | ! 1088 | implicit none 1089 | 1090 | integer ( kind = 4 ) dim_num 1091 | integer ( kind = 4 ) seed(*) 1092 | integer ( kind = 4 ) value(1) 1093 | 1094 | call halton_memory ( 'GET', 'DIM_NUM', 1, value ) 1095 | dim_num = value(1) 1096 | 1097 | call halton_memory ( 'GET', 'SEED', dim_num, seed ) 1098 | 1099 | return 1100 | end 1101 | subroutine halton_seed_set ( seed ) 1102 | 1103 | !*****************************************************************************80 1104 | ! 1105 | !! HALTON_SEED_SET sets the seed vector for a leaped Halton subsequence. 1106 | ! 1107 | ! Licensing: 1108 | ! 1109 | ! This code is distributed under the GNU LGPL license. 1110 | ! 1111 | ! Modified: 1112 | ! 1113 | ! 16 July 2004 1114 | ! 1115 | ! Author: 1116 | ! 1117 | ! John Burkardt 1118 | ! 1119 | ! Parameters: 1120 | ! 1121 | ! Input, integer ( kind = 4 ) SEED(DIM_NUM), the Halton sequence index 1122 | ! corresponding to STEP = 0. 1123 | ! 1124 | implicit none 1125 | 1126 | logical halham_seed_check 1127 | integer ( kind = 4 ) dim_num 1128 | integer ( kind = 4 ) seed(*) 1129 | integer ( kind = 4 ) value(1) 1130 | 1131 | call halton_memory ( 'GET', 'DIM_NUM', 1, value ) 1132 | dim_num = value(1) 1133 | 1134 | if ( .not. halham_seed_check ( dim_num, seed ) ) then 1135 | stop 1136 | end if 1137 | 1138 | call halton_memory ( 'SET', 'SEED', dim_num, seed ) 1139 | 1140 | return 1141 | end 1142 | subroutine halton_sequence ( dim_num, n, r ) 1143 | 1144 | !*****************************************************************************80 1145 | ! 1146 | !! HALTON_SEQUENCE computes N elements of a leaped Halton subsequence. 1147 | ! 1148 | ! Discussion: 1149 | ! 1150 | ! The DIM_NUM-dimensional Halton sequence is really DIM_NUM separate 1151 | ! sequences, each generated by a particular base. 1152 | ! 1153 | ! This routine selects elements of a "leaped" subsequence of the 1154 | ! Halton sequence. The subsequence elements are indexed by a 1155 | ! quantity called STEP, which starts at 0. The STEP-th subsequence 1156 | ! element is simply element 1157 | ! 1158 | ! SEED(1:DIM_NUM) + STEP * LEAP(1:DIM_NUM) 1159 | ! 1160 | ! of the original Halton sequence. 1161 | ! 1162 | ! 1163 | ! This routine "hides" a number of input arguments. To specify these 1164 | ! arguments explicitly, use I4_TO_HALTON_SEQUENCE instead. 1165 | ! 1166 | ! All the arguments have default values. However, if you want to 1167 | ! examine or change them, you may call the appropriate routine first. 1168 | ! 1169 | ! The arguments that the user may set include: 1170 | ! 1171 | ! * DIM_NUM, the spatial dimension, 1172 | ! Default: DIM_NUM = 1; 1173 | ! Required: 1 <= DIM_NUM is required. 1174 | ! 1175 | ! * STEP, the subsequence index. 1176 | ! Default: STEP = 0. 1177 | ! Required: 0 <= STEP. 1178 | ! 1179 | ! * SEED(1:DIM_NUM), the Halton sequence element corresponding to STEP = 0. 1180 | ! Default SEED = (0, 0, ... 0). 1181 | ! Required: 0 <= SEED(1:DIM_NUM). 1182 | ! 1183 | ! * LEAP(1:DIM_NUM), the succesive jumps in the Halton sequence. 1184 | ! Default: LEAP = (1, 1, ..., 1). 1185 | ! Required: 1 <= LEAP(1:DIM_NUM). 1186 | ! 1187 | ! * BASE(1:DIM_NUM), the Halton bases. 1188 | ! Default: BASE = (2, 3, 5, 7, 11, ... ). 1189 | ! Required: 1 < BASE(1:DIM_NUM). 1190 | ! 1191 | ! Licensing: 1192 | ! 1193 | ! This code is distributed under the GNU LGPL license. 1194 | ! 1195 | ! Modified: 1196 | ! 1197 | ! 04 July 2004 1198 | ! 1199 | ! Author: 1200 | ! 1201 | ! John Burkardt 1202 | ! 1203 | ! Reference: 1204 | ! 1205 | ! John Halton, 1206 | ! On the efficiency of certain quasi-random sequences of points 1207 | ! in evaluating multi-dimensional integrals, 1208 | ! Numerische Mathematik, 1209 | ! Volume 2, 1960, pages 84-90. 1210 | ! 1211 | ! John Halton and G B Smith, 1212 | ! Algorithm 247: Radical-Inverse Quasi-Random Point Sequence, 1213 | ! Communications of the ACM, 1214 | ! Volume 7, 1964, pages 701-702. 1215 | ! 1216 | ! Ladislav Kocis and William Whiten, 1217 | ! Computational Investigations of Low-Discrepancy Sequences, 1218 | ! ACM Transactions on Mathematical Software, 1219 | ! Volume 23, Number 2, 1997, pages 266-294. 1220 | ! 1221 | ! Parameters: 1222 | ! 1223 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 1224 | ! 1225 | ! Input, integer ( kind = 4 ) N, the number of elements desired. 1226 | ! 1227 | ! Output, real ( kind = 8 ) R(DIM_NUM,N), the next N elements of the 1228 | ! leaped Halton subsequence. 1229 | ! 1230 | implicit none 1231 | 1232 | integer ( kind = 4 ) dim_num 1233 | integer ( kind = 4 ) n 1234 | 1235 | integer ( kind = 4 ) base(dim_num) 1236 | integer ( kind = 4 ) leap(dim_num) 1237 | real ( kind = 8 ) r(dim_num,n) 1238 | !f2py integer intent(in) :: dim_num 1239 | !f2py integer intent(in) :: n 1240 | !f2py real*8 intent(out),depend(dim_num,n),dimension(dim_num,n) :: r 1241 | integer ( kind = 4 ) seed(dim_num) 1242 | integer ( kind = 4 ) step 1243 | integer ( kind = 4 ) value(1) 1244 | 1245 | value(1) = dim_num 1246 | call halton_memory ( 'SET', 'DIM_NUM', 1, value ) 1247 | call halton_memory ( 'GET', 'STEP', 1, value ) 1248 | step = value(1) 1249 | call halton_memory ( 'GET', 'SEED', dim_num, seed ) 1250 | call halton_memory ( 'GET', 'LEAP', dim_num, leap ) 1251 | call halton_memory ( 'GET', 'BASE', dim_num, base ) 1252 | 1253 | call i4_to_halton_sequence ( dim_num, n, step, seed, leap, base, r ) 1254 | 1255 | value(1) = n 1256 | call halton_memory ( 'INC', 'STEP', 1, value ) 1257 | 1258 | return 1259 | end 1260 | subroutine halton_step_get ( step ) 1261 | 1262 | !*****************************************************************************80 1263 | ! 1264 | !! HALTON_STEP_GET gets the "step" for a leaped Halton subsequence. 1265 | ! 1266 | ! Licensing: 1267 | ! 1268 | ! This code is distributed under the GNU LGPL license. 1269 | ! 1270 | ! Modified: 1271 | ! 1272 | ! 04 July 2004 1273 | ! 1274 | ! Author: 1275 | ! 1276 | ! John Burkardt 1277 | ! 1278 | ! Parameters: 1279 | ! 1280 | ! Output, integer ( kind = 4 ) STEP, the index of the subsequence element. 1281 | ! 1282 | implicit none 1283 | 1284 | integer ( kind = 4 ) step 1285 | integer ( kind = 4 ) value(1) 1286 | 1287 | call halton_memory ( 'GET', 'STEP', 1, value ) 1288 | step = value(1) 1289 | 1290 | return 1291 | end 1292 | subroutine halton_step_set ( step ) 1293 | 1294 | !*****************************************************************************80 1295 | ! 1296 | !! HALTON_STEP_SET sets the "step" for a leaped Halton subsequence. 1297 | ! 1298 | ! Licensing: 1299 | ! 1300 | ! This code is distributed under the GNU LGPL license. 1301 | ! 1302 | ! Modified: 1303 | ! 1304 | ! 04 July 2004 1305 | ! 1306 | ! Author: 1307 | ! 1308 | ! John Burkardt 1309 | ! 1310 | ! Parameters: 1311 | ! 1312 | ! Input, integer ( kind = 4 ) STEP, the index of the subsequence element. 1313 | ! 0 <= STEP is required. 1314 | ! 1315 | implicit none 1316 | 1317 | logical halham_step_check 1318 | integer ( kind = 4 ) step 1319 | integer ( kind = 4 ) value(1) 1320 | 1321 | if ( .not. halham_step_check ( step ) ) then 1322 | stop 1323 | end if 1324 | 1325 | value(1) = step 1326 | call halton_memory ( 'SET', 'STEP', 1, value ) 1327 | 1328 | return 1329 | end 1330 | subroutine i4_to_halton ( dim_num, step, seed, leap, base, r ) 1331 | 1332 | !*****************************************************************************80 1333 | ! 1334 | !! I4_TO_HALTON computes one element of a leaped Halton subsequence. 1335 | ! 1336 | ! Discussion: 1337 | ! 1338 | ! The DIM_NUM-dimensional Halton sequence is really DIM_NUM separate 1339 | ! sequences, each generated by a particular base. 1340 | ! 1341 | ! This routine selects elements of a "leaped" subsequence of the 1342 | ! Halton sequence. The subsequence elements are indexed by a 1343 | ! quantity called STEP, which starts at 0. The STEP-th subsequence 1344 | ! element is simply element 1345 | ! 1346 | ! SEED(1:DIM_NUM) + STEP * LEAP(1:DIM_NUM) 1347 | ! 1348 | ! of the original Halton sequence. 1349 | ! 1350 | ! Licensing: 1351 | ! 1352 | ! This code is distributed under the GNU LGPL license. 1353 | ! 1354 | ! Modified: 1355 | ! 1356 | ! 04 July 2004 1357 | ! 1358 | ! Author: 1359 | ! 1360 | ! John Burkardt 1361 | ! 1362 | ! Reference: 1363 | ! 1364 | ! John Halton, 1365 | ! On the efficiency of certain quasi-random sequences of points 1366 | ! in evaluating multi-dimensional integrals, 1367 | ! Numerische Mathematik, 1368 | ! Volume 2, 1960, pages 84-90. 1369 | ! 1370 | ! John Halton and G B Smith, 1371 | ! Algorithm 247: Radical-Inverse Quasi-Random Point Sequence, 1372 | ! Communications of the ACM, 1373 | ! Volume 7, 1964, pages 701-702. 1374 | ! 1375 | ! Ladislav Kocis and William Whiten, 1376 | ! Computational Investigations of Low-Discrepancy Sequences, 1377 | ! ACM Transactions on Mathematical Software, 1378 | ! Volume 23, Number 2, 1997, pages 266-294. 1379 | ! 1380 | ! Parameters: 1381 | ! 1382 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 1383 | ! 1 <= DIM_NUM is required. 1384 | ! 1385 | ! Input, integer ( kind = 4 ) STEP, the index of the subsequence element. 1386 | ! 0 <= STEP is required. 1387 | ! 1388 | ! Input, integer ( kind = 4 ) SEED(DIM_NUM), the Halton sequence index 1389 | ! corresponding to STEP = 0. 1390 | ! 0 <= SEED(1:DIM_NUM) is required. 1391 | ! 1392 | ! Input, integer ( kind = 4 ) LEAP(DIM_NUM), the successive jumps in 1393 | ! the Halton sequence. 1394 | ! 1 <= LEAP(1:DIM_NUM) is required. 1395 | ! 1396 | ! Input, integer ( kind = 4 ) BASE(DIM_NUM), the Halton bases. 1397 | ! 1 < BASE(1:DIM_NUM) is required. 1398 | ! 1399 | ! Output, real ( kind = 8 ) R(DIM_NUM), the STEP-th element of the leaped 1400 | ! Halton subsequence. 1401 | ! 1402 | implicit none 1403 | 1404 | integer ( kind = 4 ) dim_num 1405 | 1406 | integer ( kind = 4 ) base(dim_num) 1407 | real ( kind = 8 ) base_inv 1408 | integer ( kind = 4 ) digit 1409 | logical halham_leap_check 1410 | logical halham_dim_num_check 1411 | logical halham_seed_check 1412 | logical halham_step_check 1413 | logical halton_base_check 1414 | integer ( kind = 4 ) i 1415 | integer ( kind = 4 ) leap(dim_num) 1416 | real ( kind = 8 ) r(dim_num) 1417 | integer ( kind = 4 ) seed(dim_num) 1418 | integer ( kind = 4 ) seed2 1419 | integer ( kind = 4 ) step 1420 | ! 1421 | ! Check the input. 1422 | ! 1423 | if ( .not. halham_dim_num_check ( dim_num ) ) then 1424 | stop 1425 | end if 1426 | 1427 | if ( .not. halham_step_check ( step ) ) then 1428 | stop 1429 | end if 1430 | 1431 | if ( .not. halham_seed_check ( dim_num, seed ) ) then 1432 | stop 1433 | end if 1434 | 1435 | if ( .not. halham_leap_check ( dim_num, leap ) ) then 1436 | stop 1437 | end if 1438 | 1439 | if ( .not. halton_base_check ( dim_num, base ) ) then 1440 | stop 1441 | end if 1442 | ! 1443 | ! Calculate the data. 1444 | ! 1445 | do i = 1, dim_num 1446 | 1447 | seed2 = seed(i) + step * leap(i) 1448 | 1449 | r(i) = 0.0D+00 1450 | 1451 | base_inv = real ( 1.0D+00, kind = 8 ) / real ( base(i), kind = 8 ) 1452 | 1453 | do while ( seed2 /= 0 ) 1454 | digit = mod ( seed2, base(i) ) 1455 | r(i) = r(i) + real ( digit, kind = 8 ) * base_inv 1456 | base_inv = base_inv / real ( base(i), kind = 8 ) 1457 | seed2 = seed2 / base(i) 1458 | end do 1459 | 1460 | end do 1461 | 1462 | return 1463 | end 1464 | subroutine i4_to_halton_sequence ( dim_num, n, step, seed, leap, base, r ) 1465 | 1466 | !*****************************************************************************80 1467 | ! 1468 | !! I4_TO_HALTON_SEQUENCE computes N elements of a leaped Halton subsequence. 1469 | ! 1470 | ! Discussion: 1471 | ! 1472 | ! The DIM_NUM-dimensional Halton sequence is really DIM_NUM separate 1473 | ! sequences, each generated by a particular base. 1474 | ! 1475 | ! This routine selects elements of a "leaped" subsequence of the 1476 | ! Halton sequence. The subsequence elements are indexed by a 1477 | ! quantity called STEP, which starts at 0. The STEP-th subsequence 1478 | ! element is simply element 1479 | ! 1480 | ! SEED(1:DIM_NUM) + STEP * LEAP(1:DIM_NUM) 1481 | ! 1482 | ! of the original Halton sequence. 1483 | ! 1484 | ! Licensing: 1485 | ! 1486 | ! This code is distributed under the GNU LGPL license. 1487 | ! 1488 | ! Modified: 1489 | ! 1490 | ! 06 July 2004 1491 | ! 1492 | ! Author: 1493 | ! 1494 | ! John Burkardt 1495 | ! 1496 | ! Reference: 1497 | ! 1498 | ! John Halton, 1499 | ! On the efficiency of certain quasi-random sequences of points 1500 | ! in evaluating multi-dimensional integrals, 1501 | ! Numerische Mathematik, 1502 | ! Volume 2, 1960, pages 84-90. 1503 | ! 1504 | ! John Halton and G B Smith, 1505 | ! Algorithm 247: Radical-Inverse Quasi-Random Point Sequence, 1506 | ! Communications of the ACM, 1507 | ! Volume 7, 1964, pages 701-702. 1508 | ! 1509 | ! Ladislav Kocis and William Whiten, 1510 | ! Computational Investigations of Low-Discrepancy Sequences, 1511 | ! ACM Transactions on Mathematical Software, 1512 | ! Volume 23, Number 2, 1997, pages 266-294. 1513 | ! 1514 | ! Parameters: 1515 | ! 1516 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 1517 | ! 1 <= DIM_NUM is required. 1518 | ! 1519 | ! Input, integer ( kind = 4 ) N, the number of elements of the sequence. 1520 | ! 1521 | ! Input, integer ( kind = 4 ) STEP, the index of the subsequence element. 1522 | ! 0 <= STEP is required. 1523 | ! 1524 | ! Input, integer ( kind = 4 ) SEED(DIM_NUM), the Halton sequence index 1525 | ! corresponding to STEP = 0. 1526 | ! 1527 | ! Input, integer ( kind = 4 ) LEAP(DIM_NUM), the succesive jumps in the 1528 | ! Halton sequence. 1529 | ! 1530 | ! Input, integer ( kind = 4 ) BASE(DIM_NUM), the Halton bases. 1531 | ! 1532 | ! Output, real ( kind = 8 ) R(DIM_NUM,N), the next N elements of the 1533 | ! leaped Halton subsequence, beginning with element STEP. 1534 | ! 1535 | implicit none 1536 | 1537 | integer ( kind = 4 ) dim_num 1538 | integer ( kind = 4 ) n 1539 | 1540 | integer ( kind = 4 ) base(dim_num) 1541 | real ( kind = 8 ) base_inv 1542 | integer ( kind = 4 ) digit(n) 1543 | logical halham_leap_check 1544 | logical halham_n_check 1545 | logical halham_dim_num_check 1546 | logical halham_seed_check 1547 | logical halham_step_check 1548 | logical halton_base_check 1549 | integer ( kind = 4 ) i 1550 | integer ( kind = 4 ) j 1551 | integer ( kind = 4 ) leap(dim_num) 1552 | real ( kind = 8 ) r(dim_num,n) 1553 | integer ( kind = 4 ) seed(dim_num) 1554 | integer ( kind = 4 ) seed2(n) 1555 | integer ( kind = 4 ) step 1556 | ! 1557 | ! Check the input. 1558 | ! 1559 | if ( .not. halham_dim_num_check ( dim_num ) ) then 1560 | stop 1561 | end if 1562 | 1563 | if ( .not. halham_n_check ( n ) ) then 1564 | stop 1565 | end if 1566 | 1567 | if ( .not. halham_step_check ( step ) ) then 1568 | stop 1569 | end if 1570 | 1571 | if ( .not. halham_seed_check ( dim_num, seed ) ) then 1572 | stop 1573 | end if 1574 | 1575 | if ( .not. halham_leap_check ( dim_num, leap ) ) then 1576 | stop 1577 | end if 1578 | 1579 | if ( .not. halton_base_check ( dim_num, base ) ) then 1580 | stop 1581 | end if 1582 | ! 1583 | ! Calculate the data. 1584 | ! 1585 | r(1:dim_num,1:n) = 0.0D+00 1586 | 1587 | do i = 1, dim_num 1588 | 1589 | do j = 1, n 1590 | seed2(j) = seed(i) + ( step + j - 1 ) * leap(i) 1591 | end do 1592 | 1593 | base_inv = real ( 1.0D+00, kind = 8 ) / real ( base(i), kind = 8 ) 1594 | 1595 | do while ( any ( seed2(1:n) /= 0 ) ) 1596 | digit(1:n) = mod ( seed2(1:n), base(i) ) 1597 | r(i,1:n) = r(i,1:n) + real ( digit(1:n), kind = 8 ) * base_inv 1598 | base_inv = base_inv / real ( base(i), kind = 8 ) 1599 | seed2(1:n) = seed2(1:n) / base(i) 1600 | end do 1601 | 1602 | end do 1603 | 1604 | return 1605 | end 1606 | subroutine i4vec_transpose_print ( n, a, title ) 1607 | 1608 | !*****************************************************************************80 1609 | ! 1610 | !! I4VEC_TRANSPOSE_PRINT prints an I4VEC "transposed". 1611 | ! 1612 | ! Example: 1613 | ! 1614 | ! A = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11 /) 1615 | ! TITLE = 'My vector: ' 1616 | ! 1617 | ! My vector: 1 2 3 4 5 1618 | ! 6 7 8 9 10 1619 | ! 11 1620 | ! 1621 | ! Licensing: 1622 | ! 1623 | ! This code is distributed under the GNU LGPL license. 1624 | ! 1625 | ! Modified: 1626 | ! 1627 | ! 04 July 2004 1628 | ! 1629 | ! Author: 1630 | ! 1631 | ! John Burkardt 1632 | ! 1633 | ! Parameters: 1634 | ! 1635 | ! Input, integer ( kind = 4 ) N, the number of components of the vector. 1636 | ! 1637 | ! Input, integer ( kind = 4 ) A(N), the vector to be printed. 1638 | ! 1639 | ! Input, character ( len = * ) TITLE, a title to be printed first. 1640 | ! TITLE may be blank. 1641 | ! 1642 | implicit none 1643 | 1644 | integer ( kind = 4 ) n 1645 | 1646 | integer ( kind = 4 ) a(n) 1647 | integer ( kind = 4 ) ihi 1648 | integer ( kind = 4 ) ilo 1649 | character ( len = 11 ) string 1650 | character ( len = * ) title 1651 | integer ( kind = 4 ) title_len 1652 | 1653 | if ( 0 < len ( title ) ) then 1654 | 1655 | title_len = len ( title ) 1656 | 1657 | write ( string, '(a,i3,a)' ) '(', title_len, 'x,5i12)' 1658 | 1659 | do ilo = 1, n, 5 1660 | ihi = min ( ilo + 5 - 1, n ) 1661 | if ( ilo == 1 ) then 1662 | write ( *, '(a, 5i12)' ) title, a(ilo:ihi) 1663 | else 1664 | write ( *, string ) a(ilo:ihi) 1665 | end if 1666 | end do 1667 | 1668 | else 1669 | 1670 | do ilo = 1, n, 5 1671 | ihi = min ( ilo + 5 - 1, n ) 1672 | write ( *, '(5i12)' ) a(ilo:ihi) 1673 | end do 1674 | 1675 | end if 1676 | 1677 | return 1678 | end 1679 | subroutine u1_to_sphere_unit_2d ( u, x ) 1680 | 1681 | !*****************************************************************************80 1682 | ! 1683 | !! U1_TO_SPHERE_UNIT_2D maps a point in the unit interval to the unit circle. 1684 | ! 1685 | ! Licensing: 1686 | ! 1687 | ! This code is distributed under the GNU LGPL license. 1688 | ! 1689 | ! Modified: 1690 | ! 1691 | ! 04 July 2004 1692 | ! 1693 | ! Author: 1694 | ! 1695 | ! John Burkardt 1696 | ! 1697 | ! Parameters: 1698 | ! 1699 | ! Input, real ( kind = 8 ) U, a point in the unit interval. 1700 | ! 1701 | ! Output, real ( kind = 8 ) X(2), the corresponding point on the circle. 1702 | ! 1703 | implicit none 1704 | 1705 | real ( kind = 8 ) angle 1706 | real ( kind = 8 ), parameter :: pi = 3.141592653589793D+00 1707 | real ( kind = 8 ) u 1708 | real ( kind = 8 ) x(2) 1709 | 1710 | angle = real ( 2.0D+00, kind = 8 ) * pi * u 1711 | 1712 | x(1) = cos ( angle ) 1713 | x(2) = sin ( angle ) 1714 | 1715 | return 1716 | end 1717 | subroutine u2_to_ball_unit_2d ( u, x ) 1718 | 1719 | !*****************************************************************************80 1720 | ! 1721 | !! U2_TO_BALL_UNIT_2D maps points from the unit box to the unit ball in 2D. 1722 | ! 1723 | ! Licensing: 1724 | ! 1725 | ! This code is distributed under the GNU LGPL license. 1726 | ! 1727 | ! Modified: 1728 | ! 1729 | ! 18 June 2002 1730 | ! 1731 | ! Author: 1732 | ! 1733 | ! John Burkardt 1734 | ! 1735 | ! Parameters: 1736 | ! 1737 | ! Input, real ( kind = 8 ) U(2), a point in the unit square. 1738 | ! 1739 | ! Output, real ( kind = 8 ) X(2), the corresponding point in the 1740 | ! unit ball. 1741 | ! 1742 | implicit none 1743 | 1744 | real ( kind = 8 ), parameter :: pi = 3.141592653589793D+00 1745 | real ( kind = 8 ) r 1746 | real ( kind = 8 ) theta 1747 | real ( kind = 8 ) u(2) 1748 | real ( kind = 8 ) x(2) 1749 | 1750 | r = sqrt ( u(1) ) 1751 | theta = real ( 2.0D+00, kind = 8 ) * pi * u(2) 1752 | 1753 | x(1) = r * cos ( theta ) 1754 | x(2) = r * sin ( theta ) 1755 | 1756 | return 1757 | end 1758 | subroutine u2_to_sphere_unit_3d ( u, x ) 1759 | 1760 | !*****************************************************************************80 1761 | ! 1762 | !! U2_TO_SPHERE_UNIT_3D maps a point in the unit box onto the unit sphere in 3D. 1763 | ! 1764 | ! Licensing: 1765 | ! 1766 | ! This code is distributed under the GNU LGPL license. 1767 | ! 1768 | ! Modified: 1769 | ! 1770 | ! 03 June 2002 1771 | ! 1772 | ! Author: 1773 | ! 1774 | ! John Burkardt 1775 | ! 1776 | ! Parameters: 1777 | ! 1778 | ! Input, real ( kind = 8 ) U(2), the point in the unit box. 1779 | ! 1780 | ! Output, real ( kind = 8 ) X(3), the corresponding point on the unit sphere. 1781 | ! 1782 | implicit none 1783 | 1784 | real ( kind = 8 ) arc_cosine 1785 | real ( kind = 8 ) phi 1786 | real ( kind = 8 ), parameter :: pi = 3.141592653589793D+00 1787 | real ( kind = 8 ) theta 1788 | real ( kind = 8 ) u(2) 1789 | real ( kind = 8 ) vdot 1790 | real ( kind = 8 ) x(3) 1791 | ! 1792 | ! Pick a uniformly random VDOT, which must be between -1 and 1. 1793 | ! This represents the dot product of the random vector with the Z unit vector. 1794 | ! 1795 | ! Note: this works because the surface area of the sphere between 1796 | ! Z and Z + dZ is independent of Z. So choosing Z uniformly chooses 1797 | ! a patch of area uniformly. 1798 | ! 1799 | vdot = real ( 2.0D+00, kind = 8 ) * u(1) - real ( 1.0D+00, kind = 8 ) 1800 | 1801 | phi = arc_cosine ( vdot ) 1802 | ! 1803 | ! Pick a uniformly random rotation between 0 and 2 Pi around the 1804 | ! axis of the Z vector. 1805 | ! 1806 | theta = real ( 2.0D+00, kind = 8 ) * pi * u(2) 1807 | 1808 | x(1) = cos ( theta ) * sin ( phi ) 1809 | x(2) = sin ( theta ) * sin ( phi ) 1810 | x(3) = cos ( phi ) 1811 | 1812 | return 1813 | end 1814 | subroutine u3_to_ball_unit_3d ( u, x ) 1815 | 1816 | !*****************************************************************************80 1817 | ! 1818 | !! U3_TO_BALL_UNIT_3D maps points from the unit box to the unit ball in 3D. 1819 | ! 1820 | ! Licensing: 1821 | ! 1822 | ! This code is distributed under the GNU LGPL license. 1823 | ! 1824 | ! Modified: 1825 | ! 1826 | ! 04 July 2004 1827 | ! 1828 | ! Author: 1829 | ! 1830 | ! John Burkardt 1831 | ! 1832 | ! Parameters: 1833 | ! 1834 | ! Input, real ( kind = 8 ) U(3), a point in the unit box in 3D. 1835 | ! 1836 | ! Output, real ( kind = 8 ) X(3), the corresponding point in the 1837 | ! unit ball in 3D. 1838 | ! 1839 | implicit none 1840 | 1841 | real ( kind = 8 ) arc_cosine 1842 | real ( kind = 8 ) phi 1843 | real ( kind = 8 ) r 1844 | real ( kind = 8 ), parameter :: pi = 3.141592653589793D+00 1845 | real ( kind = 8 ) theta 1846 | real ( kind = 8 ) u(3) 1847 | real ( kind = 8 ) vdot 1848 | real ( kind = 8 ) x(3) 1849 | ! 1850 | ! Pick a uniformly random VDOT, which must be between -1 and 1. 1851 | ! This represents the dot product of the random vector with the Z unit vector. 1852 | ! 1853 | ! Note: this works because the surface area of the sphere between 1854 | ! Z and Z + dZ is independent of Z. So choosing Z uniformly chooses 1855 | ! a patch of area uniformly. 1856 | ! 1857 | vdot = real ( 2.0D+00, kind = 8 ) * u(1) - real ( 1.0D+00, kind = 8 ) 1858 | 1859 | phi = arc_cosine ( vdot ) 1860 | ! 1861 | ! Pick a uniformly random rotation between 0 and 2 Pi around the 1862 | ! axis of the Z vector. 1863 | ! 1864 | theta = real ( 2.0D+00, kind = 8 ) * pi * u(2) 1865 | ! 1866 | ! Pick a random radius R. 1867 | ! 1868 | r = u(3)**( real ( 1.0D+00, kind = 8 ) / real ( 3.0D+00, kind = 8 ) ) 1869 | 1870 | x(1) = r * cos ( theta ) * sin ( phi ) 1871 | x(2) = r * sin ( theta ) * sin ( phi ) 1872 | x(3) = r * cos ( phi ) 1873 | 1874 | return 1875 | end 1876 | 1877 | subroutine get_unit ( iunit ) 1878 | 1879 | !*****************************************************************************80 1880 | ! 1881 | !! GET_UNIT returns a free FORTRAN unit number. 1882 | ! 1883 | ! Discussion: 1884 | ! 1885 | ! A "free" FORTRAN unit number is a value between 1 and 99 which 1886 | ! is not currently associated with an I/O device. A free FORTRAN unit 1887 | ! number is needed in order to open a file with the OPEN command. 1888 | ! 1889 | ! If IUNIT = 0, then no free FORTRAN unit could be found, although 1890 | ! all 99 units were checked (except for units 5, 6 and 9, which 1891 | ! are commonly reserved for console I/O). 1892 | ! 1893 | ! Otherwise, IUNIT is a value between 1 and 99, representing a 1894 | ! free FORTRAN unit. Note that GET_UNIT assumes that units 5 and 6 1895 | ! are special, and will never return those values. 1896 | ! 1897 | ! Licensing: 1898 | ! 1899 | ! This code is distributed under the GNU LGPL license. 1900 | ! 1901 | ! Modified: 1902 | ! 1903 | ! 18 September 2005 1904 | ! 1905 | ! Author: 1906 | ! 1907 | ! John Burkardt 1908 | ! 1909 | ! Parameters: 1910 | ! 1911 | ! Output, integer ( kind = 4 ) IUNIT, the free unit number. 1912 | ! 1913 | implicit none 1914 | 1915 | integer ( kind = 4 ) i 1916 | integer ( kind = 4 ) ios 1917 | integer ( kind = 4 ) iunit 1918 | logical lopen 1919 | 1920 | iunit = 0 1921 | 1922 | do i = 1, 99 1923 | 1924 | if ( i /= 5 .and. i /= 6 .and. i /= 9 ) then 1925 | 1926 | inquire ( unit = i, opened = lopen, iostat = ios ) 1927 | 1928 | if ( ios == 0 ) then 1929 | if ( .not. lopen ) then 1930 | iunit = i 1931 | return 1932 | end if 1933 | end if 1934 | 1935 | end if 1936 | 1937 | end do 1938 | 1939 | return 1940 | end 1941 | -------------------------------------------------------------------------------- /src/hammersley.f90: -------------------------------------------------------------------------------- 1 | subroutine hammersley ( dim_num, r ) 2 | 3 | !*****************************************************************************80 4 | ! 5 | !! HAMMERSLEY computes the next element in a leaped Hammersley subsequence. 6 | ! 7 | ! Discussion: 8 | ! 9 | ! The DIM_NUM-dimensional Hammersley sequence is really DIM_NUM separate 10 | ! sequences, each generated by a particular base. If the base is 11 | ! greater than 1, a standard 1-dimensional 12 | ! van der Corput sequence is generated. But if the base is 13 | ! negative, this is a signal that the much simpler sequence J/(-BASE) 14 | ! is to be generated. For the standard Hammersley sequence, the 15 | ! first spatial coordinate uses a base of (-N), and subsequent 16 | ! coordinates use bases of successive primes (2, 3, 5, 7, 11, ...). 17 | ! This program allows the user to specify any combination of bases, 18 | ! included nonprimes and repeated values. 19 | ! 20 | ! This routine selects elements of a "leaped" subsequence of the 21 | ! Hammersley sequence. The subsequence elements are indexed by a 22 | ! quantity called STEP, which starts at 0. The STEP-th subsequence 23 | ! element is simply element 24 | ! 25 | ! SEED(1:DIM_NUM) + STEP * LEAP(1:DIM_NUM) 26 | ! 27 | ! of the original Hammersley sequence. 28 | ! 29 | ! 30 | ! This routine "hides" a number of input arguments. To specify these 31 | ! arguments explicitly, use I4_TO_HAMMERSLEY instead. 32 | ! 33 | ! All the arguments have default values. However, if you want to 34 | ! examine or change them, you may call the appropriate routine first. 35 | ! 36 | ! * DIM_NUM, the spatial dimension, 37 | ! Default: DIM_NUM = 1; 38 | ! Required: 1 <= DIM_NUM is required. 39 | ! 40 | ! * STEP, the subsequence index. 41 | ! Default: STEP = 0. 42 | ! Required: 0 <= STEP. 43 | ! 44 | ! * SEED(1:DIM_NUM), the Hammersley sequence element for STEP = 0. 45 | ! Default SEED = (0, 0, ... 0). 46 | ! Required: 0 <= SEED(1:DIM_NUM). 47 | ! 48 | ! * LEAP(1:DIM_NUM), the succesive jumps in the sequence. 49 | ! Default: LEAP = (1, 1, ..., 1). 50 | ! Required: 1 <= LEAP(1:DIM_NUM). 51 | ! 52 | ! * BASE(1:DIM_NUM), the bases. 53 | ! Default: BASE = (2, 3, 5, 7, 11, ... ) or ( -N, 2, 3, 5, 7, 11,...) 54 | ! if N is known. 55 | ! Required: 0, 1 /= BASE(1:DIM_NUM). 56 | ! 57 | ! Licensing: 58 | ! 59 | ! This code is distributed under the GNU LGPL license. 60 | ! 61 | ! Modified: 62 | ! 63 | ! 04 July 2004 64 | ! 65 | ! Author: 66 | ! 67 | ! John Burkardt 68 | ! 69 | ! Reference: 70 | ! 71 | ! J M Hammersley, 72 | ! Monte Carlo methods for solving multivariable problems, 73 | ! Proceedings of the New York Academy of Science, 74 | ! Volume 86, 1960, pages 844-874. 75 | ! 76 | ! Ladislav Kocis and William Whiten, 77 | ! Computational Investigations of Low-Discrepancy Sequences, 78 | ! ACM Transactions on Mathematical Software, 79 | ! Volume 23, Number 2, 1997, pages 266-294. 80 | ! 81 | ! Parameters: 82 | ! 83 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 84 | ! 85 | ! Output, real ( kind = 8 ) R(DIM_NUM), the next element of the 86 | ! leaped Hammersley subsequence. 87 | ! 88 | implicit none 89 | 90 | integer ( kind = 4 ) dim_num 91 | 92 | integer ( kind = 4 ) base(dim_num) 93 | integer ( kind = 4 ) leap(dim_num) 94 | real ( kind = 8 ) r(dim_num) 95 | integer ( kind = 4 ) seed(dim_num) 96 | integer ( kind = 4 ) step 97 | integer ( kind = 4 ) value(1) 98 | 99 | value(1) = dim_num 100 | call hammersley_memory ( 'SET', 'DIM_NUM', 1, value ) 101 | call hammersley_memory ( 'GET', 'STEP', 1, value ) 102 | step = value(1) 103 | call hammersley_memory ( 'GET', 'SEED', dim_num, seed ) 104 | call hammersley_memory ( 'GET', 'LEAP', dim_num, leap ) 105 | call hammersley_memory ( 'GET', 'BASE', dim_num, base ) 106 | 107 | call i4_to_hammersley ( dim_num, step, seed, leap, base, r ) 108 | 109 | value(1) = 1 110 | call hammersley_memory ( 'INC', 'STEP', 1, value ) 111 | 112 | return 113 | end 114 | function hammersley_base_check ( dim_num, base ) 115 | 116 | !*****************************************************************************80 117 | ! 118 | !! HAMMERSLEY_BASE_CHECK checks BASE for a Hammersley sequence. 119 | ! 120 | ! Licensing: 121 | ! 122 | ! This code is distributed under the GNU LGPL license. 123 | ! 124 | ! Modified: 125 | ! 126 | ! 16 July 2004 127 | ! 128 | ! Author: 129 | ! 130 | ! John Burkardt 131 | ! 132 | ! Parameters: 133 | ! 134 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 135 | ! 136 | ! Input, integer ( kind = 4 ) BASE(DIM_NUM), the bases. 137 | ! 138 | ! Output, logical, HAMMERSLEY_BASE_CHECK, is true if BASE is legal. 139 | ! 140 | implicit none 141 | 142 | integer ( kind = 4 ) dim_num 143 | 144 | integer ( kind = 4 ) base(dim_num) 145 | logical hammersley_base_check 146 | 147 | if ( any ( base(1:dim_num) == 0 ) .or. any ( base(1:dim_num) == 1 ) ) then 148 | write ( *, '(a)' ) ' ' 149 | write ( *, '(a)' ) 'HAMMERSLEY_BASE_CHECK - Fatal error!' 150 | write ( *, '(a)' ) ' Some entry of BASE is 0 or 1!' 151 | write ( *, '(a)' ) ' ' 152 | call i4vec_transpose_print ( dim_num, base, 'BASE: ' ) 153 | hammersley_base_check = .false. 154 | else 155 | hammersley_base_check = .true. 156 | end if 157 | 158 | return 159 | end 160 | subroutine hammersley_base_get ( base ) 161 | 162 | !*****************************************************************************80 163 | ! 164 | !! HAMMERSLEY_BASE_GET gets the base vector for a leaped Hammersley subsequence. 165 | ! 166 | ! Licensing: 167 | ! 168 | ! This code is distributed under the GNU LGPL license. 169 | ! 170 | ! Modified: 171 | ! 172 | ! 16 July 2004 173 | ! 174 | ! Author: 175 | ! 176 | ! John Burkardt 177 | ! 178 | ! Parameters: 179 | ! 180 | ! Output, integer ( kind = 4 ) BASE(DIM_NUM), the bases. 181 | ! 182 | implicit none 183 | 184 | integer ( kind = 4 ) dim_num 185 | integer ( kind = 4 ) base(*) 186 | integer ( kind = 4 ) value(1) 187 | 188 | call hammersley_memory ( 'GET', 'DIM_NUM', 1, value ) 189 | dim_num = value(1) 190 | 191 | call hammersley_memory ( 'GET', 'BASE', dim_num, base ) 192 | 193 | return 194 | end 195 | subroutine hammersley_base_set ( base ) 196 | 197 | !*****************************************************************************80 198 | ! 199 | !! HAMMERSLEY_BASE_SET sets the base vector for a leaped Hammersley subsequence. 200 | ! 201 | ! Licensing: 202 | ! 203 | ! This code is distributed under the GNU LGPL license. 204 | ! 205 | ! Modified: 206 | ! 207 | ! 16 July 2004 208 | ! 209 | ! Author: 210 | ! 211 | ! John Burkardt 212 | ! 213 | ! Parameters: 214 | ! 215 | ! Input, integer ( kind = 4 ) BASE(DIM_NUM), the bases. 216 | ! 217 | implicit none 218 | 219 | integer ( kind = 4 ) base(*) 220 | logical hammersley_base_check 221 | integer ( kind = 4 ) dim_num 222 | integer ( kind = 4 ) value(1) 223 | 224 | call hammersley_memory ( 'GET', 'DIM_NUM', 1, value ) 225 | dim_num = value(1) 226 | 227 | if ( .not. hammersley_base_check ( dim_num, base ) ) then 228 | stop 229 | end if 230 | 231 | call hammersley_memory ( 'SET', 'BASE', dim_num, base ) 232 | 233 | return 234 | end 235 | subroutine hammersley_leap_get ( leap ) 236 | 237 | !*****************************************************************************80 238 | ! 239 | !! HAMMERSLEY_LEAP_GET gets the leap vector for a leaped Hammersley subsequence. 240 | ! 241 | ! Licensing: 242 | ! 243 | ! This code is distributed under the GNU LGPL license. 244 | ! 245 | ! Modified: 246 | ! 247 | ! 16 July 2004 248 | ! 249 | ! Author: 250 | ! 251 | ! John Burkardt 252 | ! 253 | ! Parameters: 254 | ! 255 | ! Output, integer ( kind = 4 ) LEAP(DIM_NUM), the successive jumps in 256 | ! the sequence. 257 | ! 258 | implicit none 259 | 260 | integer ( kind = 4 ) dim_num 261 | integer ( kind = 4 ) leap(*) 262 | integer ( kind = 4 ) value(1) 263 | 264 | call hammersley_memory ( 'GET', 'DIM_NUM', 1, value ) 265 | dim_num = value(1) 266 | 267 | call hammersley_memory ( 'GET', 'LEAP', dim_num, leap ) 268 | 269 | return 270 | end 271 | subroutine hammersley_leap_set ( leap ) 272 | 273 | !*****************************************************************************80 274 | ! 275 | !! HAMMERSLEY_LEAP_SET sets the leap vector for a leaped Hammersley subsequence. 276 | ! 277 | ! Licensing: 278 | ! 279 | ! This code is distributed under the GNU LGPL license. 280 | ! 281 | ! Modified: 282 | ! 283 | ! 16 July 2004 284 | ! 285 | ! Author: 286 | ! 287 | ! John Burkardt 288 | ! 289 | ! Parameters: 290 | ! 291 | ! Input, integer ( kind = 4 ) LEAP(DIM_NUM), the successive jumps in 292 | ! the sequence. 293 | ! 294 | implicit none 295 | 296 | logical halham_leap_check 297 | integer ( kind = 4 ) leap(*) 298 | integer ( kind = 4 ) dim_num 299 | integer ( kind = 4 ) value(1) 300 | 301 | call hammersley_memory ( 'GET', 'DIM_NUM', 1, value ) 302 | dim_num = value(1) 303 | 304 | if ( .not. halham_leap_check ( dim_num, leap ) ) then 305 | stop 306 | end if 307 | 308 | call hammersley_memory ( 'SET', 'LEAP', dim_num, leap ) 309 | 310 | return 311 | end 312 | subroutine hammersley_memory ( action, name, dim_num, value ) 313 | 314 | !*****************************************************************************80 315 | ! 316 | !! HAMMERSLEY_MEMORY holds data associated with a leaped Hammersley subsequence. 317 | ! 318 | ! Discussion: 319 | ! 320 | ! If you're going to define a new problem, it's important that 321 | ! you set the value of DIM_NUM before setting the values of BASE, 322 | ! LEAP or SEED. 323 | ! 324 | ! Licensing: 325 | ! 326 | ! This code is distributed under the GNU LGPL license. 327 | ! 328 | ! Modified: 329 | ! 330 | ! 04 July 2004 331 | ! 332 | ! Author: 333 | ! 334 | ! John Burkardt 335 | ! 336 | ! Parameters: 337 | ! 338 | ! Input, character ( len = * ) ACTION, the desired action. 339 | ! 'GET' means get the value of a particular quantity. 340 | ! 'SET' means set the value of a particular quantity. 341 | ! 'INC' means increment the value of a particular quantity. 342 | ! (Only SEED and STEP can be incremented.) 343 | ! 344 | ! Input, character ( len = * ) NAME, the name of the quantity. 345 | ! 'BASE' means the base vector. 346 | ! 'LEAP' means the leap vector. 347 | ! 'DIM_NUM' means the spatial dimension. 348 | ! 'SEED' means the seed vector. 349 | ! 'STEP' means the step. 350 | ! 351 | ! Input/output, integer ( kind = 4 ) DIM_NUM, the dimension of the quantity. 352 | ! If ACTION is 'SET' and NAME is 'BASE', then DIM_NUM is input, and 353 | ! is the number of entries in VALUE to be put into BASE. 354 | ! 355 | ! Input/output, integer ( kind = 4 ) VALUE(DIM_NUM), contains a value. 356 | ! If ACTION is 'SET', then on input, VALUE contains values to be assigned 357 | ! to the internal variable. 358 | ! If ACTION is 'GET', then on output, VALUE contains the values of 359 | ! the specified internal variable. 360 | ! If ACTION is 'INC', then on input, VALUE contains the increment to 361 | ! be added to the specified internal variable. 362 | ! 363 | implicit none 364 | 365 | character ( len = * ) action 366 | integer ( kind = 4 ), allocatable, save, dimension ( : ) :: base 367 | logical, save :: first_call = .true. 368 | integer ( kind = 4 ) i 369 | integer ( kind = 4 ), allocatable, save, dimension ( : ) :: leap 370 | character ( len = * ) name 371 | integer ( kind = 4 ) dim_num 372 | integer ( kind = 4 ), save :: dim_num_save = 0 373 | integer ( kind = 4 ) prime 374 | integer ( kind = 4 ), allocatable, save, dimension ( : ) :: seed 375 | integer ( kind = 4 ), save :: step = 0 376 | integer ( kind = 4 ) value(*) 377 | 378 | if ( first_call ) then 379 | dim_num_save = 1 380 | allocate ( base(dim_num_save) ) 381 | allocate ( leap(dim_num_save) ) 382 | allocate ( seed(dim_num_save) ) 383 | base(1) = 2 384 | leap(1) = 1 385 | seed(1) = 0 386 | step = 0 387 | first_call = .false. 388 | end if 389 | ! 390 | ! If this is a SET DIM_NUM call, and the input value of DIM_NUM 391 | ! differs from the internal value, discard all old information. 392 | ! 393 | if ( action(1:1) == 'S' .or. action(1:1) == 's') then 394 | if ( name == 'DIM_NUM' .or. name == 'dim_num' ) then 395 | if ( dim_num_save /= value(1) ) then 396 | deallocate ( base ) 397 | deallocate ( leap ) 398 | deallocate ( seed ) 399 | dim_num_save = value(1) 400 | allocate ( base(dim_num_save) ) 401 | allocate ( leap(dim_num_save) ) 402 | allocate ( seed(dim_num_save) ) 403 | do i = 1, dim_num_save 404 | base(i) = prime ( i ) 405 | end do 406 | leap(1:dim_num_save) = 1 407 | seed(1:dim_num_save) = 0 408 | end if 409 | end if 410 | end if 411 | ! 412 | ! Set 413 | ! 414 | if ( action(1:1) == 'S' .or. action(1:1) == 's' ) then 415 | 416 | if ( name == 'BASE' .or. name == 'base' ) then 417 | 418 | if ( dim_num_save /= dim_num ) then 419 | write ( *, '(a)' ) ' ' 420 | write ( *, '(a)' ) 'HAMMERSLEY_MEMORY - Fatal error!' 421 | write ( *, '(a)' ) ' Internal and input values of DIM_NUM disagree' 422 | write ( *, '(a)' ) ' while setting BASE.' 423 | stop 424 | end if 425 | 426 | base(1:dim_num) = value(1:dim_num) 427 | 428 | else if ( name == 'LEAP' .or. name == 'leap' ) then 429 | 430 | if ( dim_num_save /= dim_num ) then 431 | write ( *, '(a)' ) ' ' 432 | write ( *, '(a)' ) 'HAMMERSLEY_MEMORY - Fatal error!' 433 | write ( *, '(a)' ) ' Internal and input values of DIM_NUM disagree' 434 | write ( *, '(a)' ) ' while setting LEAP.' 435 | stop 436 | end if 437 | 438 | leap(1:dim_num) = value(1:dim_num) 439 | 440 | else if ( name == 'DIM_NUM' .or. name == 'dim_num' ) then 441 | 442 | dim_num_save = value(1) 443 | 444 | else if ( name == 'SEED' .or. name == 'seed' ) then 445 | 446 | if ( dim_num_save /= dim_num ) then 447 | write ( *, '(a)' ) ' ' 448 | write ( *, '(a)' ) 'HAMMERSLEY_MEMORY - Fatal error!' 449 | write ( *, '(a)' ) ' Internal and input values of DIM_NUM disagree' 450 | write ( *, '(a)' ) ' while setting SEED.' 451 | stop 452 | end if 453 | 454 | seed(1:dim_num) = value(1:dim_num) 455 | 456 | else if ( name == 'STEP' .or. name == 'step' ) then 457 | 458 | if ( value(1) < 0 ) then 459 | write ( *, '(a)' ) ' ' 460 | write ( *, '(a)' ) 'HAMMERSLEY_MEMORY - Fatal error!' 461 | write ( *, '(a)' ) ' Input value of STEP < 0.' 462 | stop 463 | end if 464 | 465 | step = value(1) 466 | 467 | end if 468 | ! 469 | ! Get 470 | ! 471 | else if ( action(1:1) == 'G' .or. action(1:1) == 'g' ) then 472 | 473 | if ( name == 'BASE' .or. name == 'base' ) then 474 | 475 | value(1:dim_num_save) = base(1:dim_num_save) 476 | 477 | else if ( name == 'LEAP' .or. name == 'leap' ) then 478 | 479 | value(1:dim_num_save) = leap(1:dim_num_save) 480 | 481 | else if ( name == 'DIM_NUM' .or. name == 'dim_num' ) then 482 | 483 | value(1) = dim_num_save 484 | 485 | else if ( name == 'SEED' .or. name == 'seed' ) then 486 | 487 | value(1:dim_num_save) = seed(1:dim_num_save) 488 | 489 | else if ( name == 'STEP' .or. name == 'step' ) then 490 | 491 | value(1) = step 492 | 493 | end if 494 | ! 495 | ! Increment 496 | ! 497 | else if ( action(1:1) == 'I' .or. action(1:1) == 'i' ) then 498 | 499 | if ( name == 'SEED' .or. name == 'seed' ) then 500 | if ( dim_num == 1 ) then 501 | seed(1:dim_num_save) = seed(1:dim_num_save) + value(1) 502 | else 503 | seed(1:dim_num_save) = seed(1:dim_num_save) + value(1:dim_num_save) 504 | end if 505 | else if ( name == 'STEP' .or. name == 'step' ) then 506 | step = step + value(1) 507 | end if 508 | 509 | end if 510 | 511 | return 512 | end 513 | subroutine hammersley_dim_num_get ( dim_num ) 514 | 515 | !*****************************************************************************80 516 | ! 517 | !! HAMMERSLEY_DIM_NUM_GET: spatial dimension, leaped Hammersley subsequence. 518 | ! 519 | ! Licensing: 520 | ! 521 | ! This code is distributed under the GNU LGPL license. 522 | ! 523 | ! Modified: 524 | ! 525 | ! 28 August 2002 526 | ! 527 | ! Author: 528 | ! 529 | ! John Burkardt 530 | ! 531 | ! Parameters: 532 | ! 533 | ! Output, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 534 | ! 535 | implicit none 536 | 537 | integer ( kind = 4 ) dim_num 538 | integer ( kind = 4 ) value(1) 539 | 540 | call hammersley_memory ( 'GET', 'DIM_NUM', 1, value ) 541 | dim_num = value(1) 542 | 543 | return 544 | end 545 | subroutine hammersley_dim_num_set ( dim_num ) 546 | 547 | !*****************************************************************************80 548 | ! 549 | !! HAMMERSLEY_DIM_NUM_SET sets spatial dimension, leaped Hammersley subsequence. 550 | ! 551 | ! Licensing: 552 | ! 553 | ! This code is distributed under the GNU LGPL license. 554 | ! 555 | ! Modified: 556 | ! 557 | ! 26 February 2001 558 | ! 559 | ! Author: 560 | ! 561 | ! John Burkardt 562 | ! 563 | ! Parameters: 564 | ! 565 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 566 | ! 1 <= DIM_NUM is required. 567 | ! 568 | implicit none 569 | 570 | logical halham_dim_num_check 571 | integer ( kind = 4 ) dim_num 572 | integer ( kind = 4 ) value(1) 573 | 574 | if ( .not. halham_dim_num_check ( dim_num ) ) then 575 | stop 576 | end if 577 | 578 | value(1) = dim_num 579 | call hammersley_memory ( 'SET', 'DIM_NUM', 1, value ) 580 | 581 | return 582 | end 583 | subroutine hammersley_seed_get ( seed ) 584 | 585 | !*****************************************************************************80 586 | ! 587 | !! HAMMERSLEY_SEED_GET gets the seed vector for a leaped Hammersley subsequence. 588 | ! 589 | ! Licensing: 590 | ! 591 | ! This code is distributed under the GNU LGPL license. 592 | ! 593 | ! Modified: 594 | ! 595 | ! 20 October 2004 596 | ! 597 | ! Author: 598 | ! 599 | ! John Burkardt 600 | ! 601 | ! Parameters: 602 | ! 603 | ! Output, integer ( kind = 4 ) SEED(DIM_NUM), the Hammersley sequence 604 | ! index corresponding to STEP = 0. 605 | ! 606 | implicit none 607 | 608 | integer ( kind = 4 ) dim_num 609 | integer ( kind = 4 ) seed(*) 610 | integer ( kind = 4 ) value(1) 611 | 612 | call hammersley_memory ( 'GET', 'DIM_NUM', 1, value ) 613 | dim_num = value(1) 614 | call hammersley_memory ( 'GET', 'SEED', dim_num, seed ) 615 | 616 | return 617 | end 618 | subroutine hammersley_seed_set ( seed ) 619 | 620 | !*****************************************************************************80 621 | ! 622 | !! HAMMERSLEY_SEED_SET sets the seed vector for a leaped Hammersley subsequence. 623 | ! 624 | ! Licensing: 625 | ! 626 | ! This code is distributed under the GNU LGPL license. 627 | ! 628 | ! Modified: 629 | ! 630 | ! 20 October 2004 631 | ! 632 | ! Author: 633 | ! 634 | ! John Burkardt 635 | ! 636 | ! Parameters: 637 | ! 638 | ! Input, integer ( kind = 4 ) SEED(DIM_NUM), the Hammersley sequence index 639 | ! corresponding to STEP = 0. 640 | ! 641 | implicit none 642 | 643 | logical halham_seed_check 644 | integer ( kind = 4 ) dim_num 645 | integer ( kind = 4 ) seed(*) 646 | integer ( kind = 4 ) value(1) 647 | 648 | call hammersley_memory ( 'GET', 'DIM_NUM', 1, value ) 649 | dim_num = value(1) 650 | 651 | if ( .not. halham_seed_check ( dim_num, seed ) ) then 652 | stop 653 | end if 654 | 655 | call hammersley_memory ( 'SET', 'SEED', dim_num, seed ) 656 | 657 | return 658 | end 659 | subroutine hammersley_sequence ( dim_num, n, r ) 660 | 661 | !*****************************************************************************80 662 | ! 663 | !! HAMMERSLEY_SEQUENCE computes N elements of a leaped Hammersley subsequence. 664 | ! 665 | ! Discussion: 666 | ! 667 | ! The DIM_NUM-dimensional Hammersley sequence is really DIM_NUM separate 668 | ! sequences, each generated by a particular base. If the base is 669 | ! greater than 1, a standard 1-dimensional 670 | ! van der Corput sequence is generated. But if the base is 671 | ! negative, this is a signal that the much simpler sequence J/(-BASE) 672 | ! is to be generated. For the standard Hammersley sequence, the 673 | ! first spatial coordinate uses a base of (-N), and subsequent 674 | ! coordinates use bases of successive primes (2, 3, 5, 7, 11, ...). 675 | ! This program allows the user to specify any combination of bases, 676 | ! included nonprimes and repeated values. 677 | ! 678 | ! This routine selects elements of a "leaped" subsequence of the 679 | ! Hammersley sequence. The subsequence elements are indexed by a 680 | ! quantity called STEP, which starts at 0. The STEP-th subsequence 681 | ! element is simply element 682 | ! 683 | ! SEED(1:DIM_NUM) + STEP * LEAP(1:DIM_NUM) 684 | ! 685 | ! of the original Hammersley sequence. 686 | ! 687 | ! 688 | ! This routine "hides" a number of input arguments. To specify these 689 | ! arguments explicitly, use I4_TO_HAMMERSLEY_SEQUENCE instead. 690 | ! 691 | ! All the arguments have default values. However, if you want to 692 | ! examine or change them, you may call the appropriate routine first. 693 | ! 694 | ! The arguments that the user may set include: 695 | ! 696 | ! * DIM_NUM, the spatial dimension, 697 | ! Default: DIM_NUM = 1; 698 | ! Required: 1 <= DIM_NUM is required. 699 | ! 700 | ! * STEP, the subsequence index. 701 | ! Default: STEP = 0. 702 | ! Required: 0 <= STEP. 703 | ! 704 | ! * SEED(1:DIM_NUM), the sequence element corresponding to STEP = 0. 705 | ! Default SEED = (0, 0, ... 0). 706 | ! Required: 0 <= SEED(1:DIM_NUM). 707 | ! 708 | ! * LEAP(1:DIM_NUM), the succesive jumps in the sequence. 709 | ! Default: LEAP = (1, 1, ..., 1). 710 | ! Required: 1 <= LEAP(1:DIM_NUM). 711 | ! 712 | ! * BASE(1:DIM_NUM), the bases. 713 | ! Default: BASE = (2, 3, 5, 7, 11, ... ) or ( -N, 2, 3, 5, 7, 11,...) 714 | ! if N is known. 715 | ! Required: 0, 1 /= BASE(1:DIM_NUM). 716 | ! 717 | ! Licensing: 718 | ! 719 | ! This code is distributed under the GNU LGPL license. 720 | ! 721 | ! Modified: 722 | ! 723 | ! 04 July 2004 724 | ! 725 | ! Author: 726 | ! 727 | ! John Burkardt 728 | ! 729 | ! Reference: 730 | ! 731 | ! J M Hammersley, 732 | ! Monte Carlo methods for solving multivariable problems, 733 | ! Proceedings of the New York Academy of Science, 734 | ! Volume 86, 1960, pages 844-874. 735 | ! 736 | ! Ladislav Kocis and William Whiten, 737 | ! Computational Investigations of Low-Discrepancy Sequences, 738 | ! ACM Transactions on Mathematical Software, 739 | ! Volume 23, Number 2, 1997, pages 266-294. 740 | ! 741 | ! Parameters: 742 | ! 743 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 744 | ! 745 | ! Input, integer ( kind = 4 ) N, the number of elements desired. 746 | ! 747 | ! Output, real ( kind = 8 ) R(DIM_NUM,N), the next N elements of the 748 | ! leaped Hammersley subsequence. 749 | ! 750 | implicit none 751 | 752 | integer ( kind = 4 ) dim_num 753 | integer ( kind = 4 ) n 754 | 755 | integer ( kind = 4 ) base(dim_num) 756 | integer ( kind = 4 ) leap(dim_num) 757 | real ( kind = 8 ) r(dim_num,n) 758 | integer ( kind = 4 ) seed(dim_num) 759 | integer ( kind = 4 ) step 760 | integer ( kind = 4 ) value(1) 761 | !f2py integer intent(in) :: dim_num 762 | !f2py integer intent(in) :: n 763 | !f2py real*8 intent(out),depend(dim_num,n),dimension(dim_num,n) :: r 764 | 765 | value(1) = dim_num 766 | call hammersley_memory ( 'SET', 'DIM_NUM', 1, value ) 767 | call hammersley_memory ( 'GET', 'STEP', 1, value ) 768 | step = value(1) 769 | call hammersley_memory ( 'GET', 'SEED', dim_num, seed ) 770 | call hammersley_memory ( 'GET', 'LEAP', dim_num, leap ) 771 | call hammersley_memory ( 'GET', 'BASE', dim_num, base ) 772 | 773 | call i4_to_hammersley_sequence ( dim_num, n, step, seed, leap, base, r ) 774 | 775 | value(1) = n 776 | call hammersley_memory ( 'INC', 'STEP', 1, value ) 777 | 778 | return 779 | end 780 | subroutine hammersley_step_get ( step ) 781 | 782 | !*****************************************************************************80 783 | ! 784 | !! HAMMERSLEY_STEP_GET gets the "step" for a leaped Hammersley subsequence. 785 | ! 786 | ! Licensing: 787 | ! 788 | ! This code is distributed under the GNU LGPL license. 789 | ! 790 | ! Modified: 791 | ! 792 | ! 04 July 2004 793 | ! 794 | ! Author: 795 | ! 796 | ! John Burkardt 797 | ! 798 | ! Parameters: 799 | ! 800 | ! Output, integer ( kind = 4 ) STEP, the index of the subsequence element. 801 | ! 802 | implicit none 803 | 804 | integer ( kind = 4 ) step 805 | integer ( kind = 4 ) value(1) 806 | 807 | call hammersley_memory ( 'GET', 'STEP', 1, value ) 808 | step = value(1) 809 | 810 | return 811 | end 812 | subroutine hammersley_step_set ( step ) 813 | 814 | !*****************************************************************************80 815 | ! 816 | !! HAMMERSLEY_STEP_SET sets the "step" for a leaped Hammersley subsequence. 817 | ! 818 | ! Licensing: 819 | ! 820 | ! This code is distributed under the GNU LGPL license. 821 | ! 822 | ! Modified: 823 | ! 824 | ! 04 July 2004 825 | ! 826 | ! Author: 827 | ! 828 | ! John Burkardt 829 | ! 830 | ! Parameters: 831 | ! 832 | ! Input, integer ( kind = 4 ) STEP, the index of the subsequence element. 833 | ! 0 <= STEP is required. 834 | ! 835 | implicit none 836 | 837 | logical halham_step_check 838 | integer ( kind = 4 ) step 839 | integer ( kind = 4 ) value(1) 840 | 841 | if ( .not. halham_step_check ( step ) ) then 842 | stop 843 | end if 844 | 845 | value(1) = step 846 | call hammersley_memory ( 'SET', 'STEP', 1, value ) 847 | 848 | return 849 | end 850 | subroutine i4_to_hammersley ( dim_num, step, seed, leap, base, r ) 851 | 852 | !*****************************************************************************80 853 | ! 854 | !! I4_TO_HAMMERSLEY computes one element of a leaped Hammersley subsequence. 855 | ! 856 | ! Discussion: 857 | ! 858 | ! The DIM_NUM-dimensional Hammersley sequence is really DIM_NUM separate 859 | ! sequences, each generated by a particular base. If the base is 860 | ! greater than 1, a standard 1-dimensional 861 | ! van der Corput sequence is generated. But if the base is 862 | ! negative, this is a signal that the much simpler sequence J/(-BASE) 863 | ! is to be generated. For the standard Hammersley sequence, the 864 | ! first spatial coordinate uses a base of (-N), and subsequent 865 | ! coordinates use bases of successive primes (2, 3, 5, 7, 11, ...). 866 | ! This program allows the user to specify any combination of bases, 867 | ! included nonprimes and repeated values. 868 | ! 869 | ! This routine selects elements of a "leaped" subsequence of the 870 | ! Hammersley sequence. The subsequence elements are indexed by a 871 | ! quantity called STEP, which starts at 0. The STEP-th subsequence 872 | ! element is simply element 873 | ! 874 | ! SEED(1:DIM_NUM) + STEP * LEAP(1:DIM_NUM) 875 | ! 876 | ! of the original Hammersley sequence. 877 | ! 878 | ! Licensing: 879 | ! 880 | ! This code is distributed under the GNU LGPL license. 881 | ! 882 | ! Modified: 883 | ! 884 | ! 20 October 2004 885 | ! 886 | ! Author: 887 | ! 888 | ! John Burkardt 889 | ! 890 | ! Reference: 891 | ! 892 | ! J M Hammersley, 893 | ! Monte Carlo methods for solving multivariable problems, 894 | ! Proceedings of the New York Academy of Science, 895 | ! Volume 86, 1960, pages 844-874. 896 | ! 897 | ! Ladislav Kocis and William Whiten, 898 | ! Computational Investigations of Low-Discrepancy Sequences, 899 | ! ACM Transactions on Mathematical Software, 900 | ! Volume 23, Number 2, 1997, pages 266-294. 901 | ! 902 | ! Parameters: 903 | ! 904 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 905 | ! 1 <= DIM_NUM is required. 906 | ! 907 | ! Input, integer ( kind = 4 ) STEP, the index of the subsequence element. 908 | ! 0 <= STEP is required. 909 | ! 910 | ! Input, integer ( kind = 4 ) SEED(DIM_NUM), the sequence index corresponding 911 | ! to STEP = 0. 912 | ! 0 <= SEED(1:DIM_NUM) is required. 913 | ! 914 | ! Input, integer ( kind = 4 ) LEAP(DIM_NUM), the successive jumps in 915 | ! the sequence. 916 | ! 1 <= LEAP(1:DIM_NUM) is required. 917 | ! 918 | ! Input, integer ( kind = 4 ) BASE(DIM_NUM), the bases. 919 | ! 920 | ! Output, real ( kind = 8 ) R(DIM_NUM), the STEP-th element of the leaped 921 | ! Hammersley subsequence. 922 | ! 923 | implicit none 924 | 925 | integer ( kind = 4 ) dim_num 926 | 927 | integer ( kind = 4 ) base(dim_num) 928 | real ( kind = 8 ) base_inv 929 | integer ( kind = 4 ) digit 930 | real ( kind = 8 ) :: fiddle = 1.0D+00 931 | logical halham_leap_check 932 | logical halham_dim_num_check 933 | logical halham_seed_check 934 | logical halham_step_check 935 | logical hammersley_base_check 936 | integer ( kind = 4 ) i 937 | integer ( kind = 4 ) leap(dim_num) 938 | real ( kind = 8 ) r(dim_num) 939 | integer ( kind = 4 ) seed(dim_num) 940 | integer ( kind = 4 ) seed2 941 | integer ( kind = 4 ) step 942 | ! 943 | ! Check the input. 944 | ! 945 | if ( .not. halham_dim_num_check ( dim_num ) ) then 946 | stop 947 | end if 948 | 949 | if ( .not. halham_step_check ( step ) ) then 950 | stop 951 | end if 952 | 953 | if ( .not. halham_seed_check ( dim_num, seed ) ) then 954 | stop 955 | end if 956 | 957 | if ( .not. halham_leap_check ( dim_num, leap ) ) then 958 | stop 959 | end if 960 | 961 | if ( .not. hammersley_base_check ( dim_num, base ) ) then 962 | stop 963 | end if 964 | ! 965 | ! Calculate the data. 966 | ! 967 | do i = 1, dim_num 968 | 969 | if ( 1 < base(i) ) then 970 | 971 | seed2 = seed(i) + step * leap(i) 972 | 973 | r(i) = 0.0D+00 974 | 975 | base_inv = real ( 1.0D+00, kind = 8 ) / real ( base(i), kind = 8 ) 976 | 977 | do while ( seed2 /= 0 ) 978 | digit = mod ( seed2, base(i) ) 979 | r(i) = r(i) + real ( digit, kind = 8 ) * base_inv 980 | base_inv = base_inv / real ( base(i), kind = 8 ) 981 | seed2 = seed2 / base(i) 982 | end do 983 | ! 984 | ! In the following computation, the value of FIDDLE can be: 985 | ! 986 | ! 0, for the sequence 0/N, 1/N, ..., N-1/N 987 | ! 1, for the sequence 1/N, 2/N, ..., N/N 988 | ! 1/2, for the sequence 1/(2N), 3/(2N), ..., (2*N-1)/(2N) 989 | ! 990 | else if ( base(i) <= -1 ) then 991 | 992 | seed2 = seed(i) + step * leap(i) 993 | 994 | seed2 = mod ( seed2, abs ( base(i) ) ) 995 | 996 | r(i) = ( real ( seed2, kind = 8 ) + fiddle ) & 997 | / real ( -base(i), kind = 8 ) 998 | 999 | end if 1000 | 1001 | end do 1002 | 1003 | return 1004 | end 1005 | subroutine i4_to_hammersley_sequence ( dim_num, n, step, seed, leap, base, r ) 1006 | 1007 | !*****************************************************************************80 1008 | ! 1009 | !! I4_TO_HAMMERSLEY_SEQUENCE: N elements of a leaped Hammersley subsequence. 1010 | ! 1011 | ! Discussion: 1012 | ! 1013 | ! The DIM_NUM-dimensional Hammersley sequence is really DIM_NUM separate 1014 | ! sequences, each generated by a particular base. If the base is 1015 | ! greater than 1, a standard 1-dimensional 1016 | ! van der Corput sequence is generated. But if the base is 1017 | ! negative, this is a signal that the much simpler sequence J/(-BASE) 1018 | ! is to be generated. For the standard Hammersley sequence, the 1019 | ! first spatial coordinate uses a base of (-N), and subsequent 1020 | ! coordinates use bases of successive primes (2, 3, 5, 7, 11, ...). 1021 | ! This program allows the user to specify any combination of bases, 1022 | ! included nonprimes and repeated values. 1023 | ! 1024 | ! This routine selects elements of a "leaped" subsequence of the 1025 | ! Hammersley sequence. The subsequence elements are indexed by a 1026 | ! quantity called STEP, which starts at 0. The STEP-th subsequence 1027 | ! element is simply element 1028 | ! 1029 | ! SEED(1:DIM_NUM) + STEP * LEAP(1:DIM_NUM) 1030 | ! 1031 | ! of the original Hammersley sequence. 1032 | ! 1033 | ! Licensing: 1034 | ! 1035 | ! This code is distributed under the GNU LGPL license. 1036 | ! 1037 | ! Modified: 1038 | ! 1039 | ! 20 October 2004 1040 | ! 1041 | ! Author: 1042 | ! 1043 | ! John Burkardt 1044 | ! 1045 | ! Reference: 1046 | ! 1047 | ! J M Hammersley, 1048 | ! Monte Carlo methods for solving multivariable problems, 1049 | ! Proceedings of the New York Academy of Science, 1050 | ! Volume 86, 1960, pages 844-874. 1051 | ! 1052 | ! Ladislav Kocis and William Whiten, 1053 | ! Computational Investigations of Low-Discrepancy Sequences, 1054 | ! ACM Transactions on Mathematical Software, 1055 | ! Volume 23, Number 2, 1997, pages 266-294. 1056 | ! 1057 | ! Parameters: 1058 | ! 1059 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 1060 | ! 1 <= DIM_NUM is required. 1061 | ! 1062 | ! Input, integer ( kind = 4 ) N, the number of elements of the sequence. 1063 | ! 1064 | ! Input, integer ( kind = 4 ) STEP, the index of the subsequence element. 1065 | ! 0 <= STEP is required. 1066 | ! 1067 | ! Input, integer ( kind = 4 ) SEED(DIM_NUM), the sequence index corresponding 1068 | ! to STEP = 0. 1069 | ! 1070 | ! Input, integer ( kind = 4 ) LEAP(DIM_NUM), the succesive jumps in 1071 | ! the sequence. 1072 | ! 1073 | ! Input, integer ( kind = 4 ) BASE(DIM_NUM), the bases. 1074 | ! 1075 | ! Output, real ( kind = 8 ) R(DIM_NUM,N), the next N elements of the 1076 | ! leaped Hammersley subsequence, beginning with element STEP. 1077 | ! 1078 | implicit none 1079 | 1080 | integer ( kind = 4 ) n 1081 | integer ( kind = 4 ) dim_num 1082 | 1083 | integer ( kind = 4 ) base(dim_num) 1084 | real ( kind = 8 ) base_inv 1085 | integer ( kind = 4 ) digit(n) 1086 | real ( kind = 8 ) :: fiddle = 1.0D+00 1087 | logical halham_leap_check 1088 | logical halham_dim_num_check 1089 | logical halham_seed_check 1090 | logical halham_step_check 1091 | logical hammersley_base_check 1092 | integer ( kind = 4 ) i 1093 | integer ( kind = 4 ) j 1094 | integer ( kind = 4 ) leap(dim_num) 1095 | real ( kind = 8 ) r(dim_num,n) 1096 | integer ( kind = 4 ) seed(dim_num) 1097 | integer ( kind = 4 ) seed2(n) 1098 | integer ( kind = 4 ) step 1099 | ! 1100 | ! Check the input. 1101 | ! 1102 | if ( .not. halham_dim_num_check ( dim_num ) ) then 1103 | stop 1104 | end if 1105 | 1106 | if ( .not. halham_step_check ( step ) ) then 1107 | stop 1108 | end if 1109 | 1110 | if ( .not. halham_seed_check ( dim_num, seed ) ) then 1111 | stop 1112 | end if 1113 | 1114 | if ( .not. halham_leap_check ( dim_num, leap ) ) then 1115 | stop 1116 | end if 1117 | 1118 | if ( .not. hammersley_base_check ( dim_num, base ) ) then 1119 | stop 1120 | end if 1121 | ! 1122 | ! Calculate the data. 1123 | ! 1124 | do i = 1, dim_num 1125 | 1126 | if ( 1 < base(i) ) then 1127 | 1128 | do j = 1, n 1129 | seed2(j) = seed(i) + ( step + j - 1 ) * leap(i) 1130 | end do 1131 | 1132 | r(i,1:n) = 0.0D+00 1133 | 1134 | base_inv = real ( 1.0D+00, kind = 8 ) / real ( base(i), kind = 8 ) 1135 | 1136 | do while ( any ( seed2(1:n) /= 0 ) ) 1137 | digit(1:n) = mod ( seed2(1:n), base(i) ) 1138 | r(i,1:n) = r(i,1:n) + real ( digit(1:n), kind = 8 ) * base_inv 1139 | base_inv = base_inv / real ( base(i), kind = 8 ) 1140 | seed2(1:n) = seed2(1:n) / base(i) 1141 | end do 1142 | ! 1143 | ! In the following computation, the value of FIDDLE can be: 1144 | ! 1145 | ! 0, for the sequence 0/N, 1/N, ..., N-1/N 1146 | ! 1, for the sequence 1/N, 2/N, ..., N/N 1147 | ! 1/2, for the sequence 1/(2N), 3/(2N), ..., (2*N-1)/(2N) 1148 | ! 1149 | else if ( base(i) <= -1 ) then 1150 | 1151 | do j = 1, n 1152 | seed2(j) = seed(i) + ( step + j - 1 ) * leap(i) 1153 | end do 1154 | 1155 | seed2(1:n) = mod ( seed2(1:n), abs ( base(i) ) ) 1156 | 1157 | r(i,1:n) = ( real ( seed2(1:n), kind = 8 ) + fiddle ) & 1158 | / real ( -base(i), kind = 8 ) 1159 | 1160 | end if 1161 | 1162 | end do 1163 | 1164 | return 1165 | end 1166 | -------------------------------------------------------------------------------- /src/ihs.f90: -------------------------------------------------------------------------------- 1 | subroutine covariance ( dim_num, n, x, average, std, covc ) 2 | 3 | !*****************************************************************************80 4 | ! 5 | !! COVARIANCE does a covariance calculation for IHS solutions. 6 | ! 7 | ! Licensing: 8 | ! 9 | ! This code is distributed under the GNU LGPL license. 10 | ! 11 | ! Modified: 12 | ! 13 | ! 27 June 2008 14 | ! 15 | ! Author: 16 | ! 17 | ! John Burkardt 18 | ! 19 | ! Parameters: 20 | ! 21 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 22 | ! 23 | ! Input, integer ( kind = 4 ) N, the number of points to be generated. 24 | ! 25 | ! Input, integer ( kind = 4 ) X(DIM_NUM,N), the points. 26 | ! 27 | ! Output, real ( kind = 8 ) AVERAGE, the average minimum distance. 28 | ! 29 | ! Output, real ( kind = 8 ) STD, the standard deviation of the 30 | ! minimum distances. 31 | ! 32 | ! Output, real ( kind = 8 ) COVC, the covariance of the minimum distances. 33 | ! 34 | implicit none 35 | 36 | integer ( kind = 4 ) dim_num 37 | integer ( kind = 4 ) n 38 | 39 | real ( kind = 8 ) average 40 | real ( kind = 8 ) covc 41 | real ( kind = 8 ) dist 42 | integer ( kind = 4 ) i 43 | integer ( kind = 4 ) j 44 | real ( kind = 8 ) mindist(n) 45 | real ( kind = 8 ), parameter :: r8_huge = 1.0D+30 46 | real ( kind = 8 ) std 47 | real ( kind = 8 ) vec(dim_num) 48 | integer ( kind = 4 ) x(dim_num,n) 49 | ! 50 | ! Set up the distance matrix. 51 | ! 52 | do i = 1, n 53 | mindist(i) = r8_huge 54 | do j = 1, n 55 | if ( i /= j ) then 56 | vec(1:dim_num) = real ( x(1:dim_num,i) - x(1:dim_num,j), kind = 8 ) 57 | dist = sqrt ( dot_product ( vec(1:dim_num), vec(1:dim_num) ) ) 58 | mindist(i) = min ( mindist(i), dist ) 59 | end if 60 | end do 61 | end do 62 | ! 63 | ! Find the average minimum distance. 64 | ! 65 | average = sum ( mindist(1:n) ) / real ( n, kind = 8 ) 66 | ! 67 | ! Compute the standard deviation of the distances. 68 | ! 69 | call r8vec_std ( n, mindist, std ) 70 | ! 71 | ! Compute the covariance. 72 | ! 73 | covc = std / average 74 | 75 | return 76 | end 77 | subroutine ihs ( dim_num, n, duplication, seed, x ) 78 | 79 | !*****************************************************************************80 80 | ! 81 | !! IHS implements the improved distributed hypercube sampling algorithm. 82 | ! 83 | ! Discussion: 84 | ! 85 | ! N Points in an DIM_NUM dimensional Latin hypercube are to be selected. 86 | ! Each of the coordinate dimensions is discretized to the values 87 | ! 1 through N. The points are to be chosen in such a way that 88 | ! no two points have any coordinate value in common. This is 89 | ! a standard Latin hypercube requirement, and there are many 90 | ! solutions. 91 | ! 92 | ! This algorithm differs in that it tries to pick a solution 93 | ! which has the property that the points are "spread out" 94 | ! as evenly as possible. It does this by determining an optimal 95 | ! even spacing, and using the DUPLICATION factor to allow it 96 | ! to choose the best of the various options available to it. 97 | ! 98 | ! Licensing: 99 | ! 100 | ! This code is distributed under the GNU LGPL license. 101 | ! 102 | ! Modified: 103 | ! 104 | ! 02 April 2003 105 | ! 106 | ! Author: 107 | ! 108 | ! John Burkardt 109 | ! 110 | ! Reference: 111 | ! 112 | ! Brian Beachkofski, Ramana Grandhi, 113 | ! Improved Distributed Hypercube Sampling, 114 | ! American Institute of Aeronautics and Astronautics Paper 2002-1274. 115 | ! 116 | ! Parameters: 117 | ! 118 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 119 | ! 120 | ! Input, integer ( kind = 4 ) N, the number of points to be generated. 121 | ! 122 | ! Input, integer ( kind = 4 ) DUPLICATION, the duplication factor. This must 123 | ! be at least 1. A value of 5 is reasonable. 124 | ! 125 | ! Input/output, integer ( kind = 4 ) SEED, a seed for the random 126 | ! number generator. 127 | ! 128 | ! Output, integer ( kind = 4 ) X(DIM_NUM,N), the points. 129 | ! 130 | implicit none 131 | 132 | integer ( kind = 4 ) dim_num 133 | integer ( kind = 4 ) duplication 134 | integer ( kind = 4 ) n 135 | 136 | integer ( kind = 4 ) avail(dim_num,n) 137 | integer ( kind = 4 ) best 138 | integer ( kind = 4 ) count 139 | real ( kind = 8 ) dist 140 | integer ( kind = 4 ) i 141 | integer ( kind = 4 ) i4_uniform 142 | integer ( kind = 4 ) j 143 | integer ( kind = 4 ) k 144 | integer ( kind = 4 ) list(duplication*n) 145 | real ( kind = 8 ) min_all 146 | real ( kind = 8 ) min_can 147 | real ( kind = 8 ) opt 148 | integer ( kind = 4 ) point(dim_num,duplication*n) 149 | integer ( kind = 4 ) point_index 150 | real ( kind = 8 ), parameter :: r8_huge = 1.0D+30 151 | integer ( kind = 4 ) seed 152 | real ( kind = 8 ) vec(dim_num) 153 | integer ( kind = 4 ) x(dim_num,n) 154 | !f2py integer intent(in) :: dim_num 155 | !f2py integer intent(in) :: n 156 | !f2py integer optional,intent(in) :: duplication=5 157 | !f2py integer intent(in) :: seed 158 | !f2py integer intent(out),depend(dim_num,n),dimension(dim_num,n) :: x 159 | 160 | opt = real ( n, kind = 8 ) / & 161 | ( real ( n, kind = 8 ) )**( 1.0D+00 / real ( dim_num, kind = 8 ) ) 162 | ! 163 | ! Pick the first point. 164 | ! 165 | call i4vec_uniform ( dim_num, 1, n, seed, x(1:dim_num,n) ) 166 | ! 167 | ! Initialize AVAIL, 168 | ! and set an entry in a random row of each column of AVAIL to N. 169 | ! 170 | do j = 1, n 171 | avail(1:dim_num,j) = j 172 | end do 173 | 174 | do i = 1, dim_num 175 | avail(i,x(i,n)) = n 176 | end do 177 | ! 178 | ! Main loop: 179 | ! Assign a value to X(1:DIM_NUM,COUNT) for COUNT = N-1 down to 2. 180 | ! 181 | do count = n-1, 2, -1 182 | ! 183 | ! Generate valid points. 184 | ! 185 | do i = 1, dim_num 186 | 187 | do k = 1, duplication 188 | list(count*(k-1)+1:k*count) = avail(i,1:count) 189 | end do 190 | 191 | do k = count*duplication, 1, -1 192 | point_index = i4_uniform ( 1, k, seed ) 193 | point(i,k) = list(point_index) 194 | list(point_index) = list(k) 195 | end do 196 | 197 | end do 198 | ! 199 | ! For each candidate, determine the distance to all the 200 | ! points that have already been selected, and save the minimum value. 201 | ! 202 | min_all = r8_huge 203 | best = 0 204 | 205 | do k = 1, duplication*count 206 | 207 | min_can = r8_huge 208 | 209 | do j = count+1, n 210 | vec(1:dim_num) = real ( point(1:dim_num,k) - x(1:dim_num,j), kind = 8 ) 211 | dist = sqrt ( dot_product ( vec(1:dim_num), vec(1:dim_num) ) ) 212 | min_can = min ( min_can, dist ) 213 | end do 214 | 215 | if ( abs ( min_can - opt ) < min_all ) then 216 | min_all = abs ( min_can - opt ) 217 | best = k 218 | end if 219 | 220 | end do 221 | 222 | x(1:dim_num,count) = point(1:dim_num,best) 223 | ! 224 | ! Having chosen X(*,COUNT), update AVAIL. 225 | ! 226 | do i = 1, dim_num 227 | 228 | do j = 1, n 229 | if ( avail(i,j) == x(i,count) ) then 230 | avail(i,j) = avail(i,count) 231 | end if 232 | end do 233 | 234 | end do 235 | 236 | end do 237 | ! 238 | ! For the last point, there's only one choice. 239 | ! 240 | x(1:dim_num,1) = avail(1:dim_num,1) 241 | 242 | return 243 | end 244 | subroutine r8vec_std ( n, a, std ) 245 | 246 | !*****************************************************************************80 247 | ! 248 | !! R8VEC_STD returns the standard deviation of a real vector. 249 | ! 250 | ! Discussion: 251 | ! 252 | ! The standard deviation of a vector X of length N is defined as 253 | ! 254 | ! mean ( X(1:n) ) = sum ( X(1:n) ) / n 255 | ! 256 | ! std ( X(1:n) ) = sqrt ( sum ( ( X(1:n) - mean )^2 ) / ( n - 1 ) ) 257 | ! 258 | ! Licensing: 259 | ! 260 | ! This code is distributed under the GNU LGPL license. 261 | ! 262 | ! Modified: 263 | ! 264 | ! 06 February 2003 265 | ! 266 | ! Author: 267 | ! 268 | ! John Burkardt 269 | ! 270 | ! Parameters: 271 | ! 272 | ! Input, integer ( kind = 4 ) N, the number of entries in the vector. 273 | ! N should be at least 2. 274 | ! 275 | ! Input, real ( kind = 8 ) A(N), the vector. 276 | ! 277 | ! Output, real ( kind = 8 ) STD, the standard deviation of the vector. 278 | ! 279 | implicit none 280 | 281 | integer ( kind = 4 ) n 282 | 283 | real ( kind = 8 ) a(n) 284 | real ( kind = 8 ) mean 285 | real ( kind = 8 ) std 286 | 287 | if ( n < 2 ) then 288 | 289 | std = 0.0D+00 290 | 291 | else 292 | 293 | mean = sum ( a(1:n) ) / real ( n, kind = 8 ) 294 | 295 | std = sum ( ( a(1:n) - mean )**2 ) 296 | 297 | std = sqrt ( std / real ( n - 1, kind = 8 ) ) 298 | 299 | end if 300 | 301 | return 302 | end 303 | subroutine i4vec_uniform ( n, a, b, seed, x ) 304 | 305 | !*****************************************************************************80 306 | ! 307 | !! I4VEC_UNIFORM returns a scaled pseudorandom I4VEC. 308 | ! 309 | ! Discussion: 310 | ! 311 | ! An I4VEC is a vector of integer ( kind = 4 ) values. 312 | ! 313 | ! The pseudorandom numbers should be scaled to be uniformly distributed 314 | ! between A and B. 315 | ! 316 | ! Licensing: 317 | ! 318 | ! This code is distributed under the GNU LGPL license. 319 | ! 320 | ! Modified: 321 | ! 322 | ! 31 May 2007 323 | ! 324 | ! Author: 325 | ! 326 | ! John Burkardt 327 | ! 328 | ! Reference: 329 | ! 330 | ! Paul Bratley, Bennett Fox, Linus Schrage, 331 | ! A Guide to Simulation, 332 | ! Second Edition, 333 | ! Springer, 1987, 334 | ! ISBN: 0387964673, 335 | ! LC: QA76.9.C65.B73. 336 | ! 337 | ! Bennett Fox, 338 | ! Algorithm 647: 339 | ! Implementation and Relative Efficiency of Quasirandom 340 | ! Sequence Generators, 341 | ! ACM Transactions on Mathematical Software, 342 | ! Volume 12, Number 4, December 1986, pages 362-376. 343 | ! 344 | ! Pierre L'Ecuyer, 345 | ! Random Number Generation, 346 | ! in Handbook of Simulation, 347 | ! edited by Jerry Banks, 348 | ! Wiley, 1998, 349 | ! ISBN: 0471134031, 350 | ! LC: T57.62.H37. 351 | ! 352 | ! Peter Lewis, Allen Goodman, James Miller, 353 | ! A Pseudo-Random Number Generator for the System/360, 354 | ! IBM Systems Journal, 355 | ! Volume 8, Number 2, 1969, pages 136-143. 356 | ! 357 | ! Parameters: 358 | ! 359 | ! Input, integer ( kind = 4 ) N, the dimension of the vector. 360 | ! 361 | ! Input, integer ( kind = 4 ) A, B, the limits of the interval. 362 | ! 363 | ! Input/output, integer ( kind = 4 ) SEED, the "seed" value, which 364 | ! should NOT be 0. On output, SEED has been updated. 365 | ! 366 | ! Output, integer ( kind = 4 ) X(N), a vector of numbers between A and B. 367 | ! 368 | implicit none 369 | 370 | integer ( kind = 4 ) n 371 | 372 | integer ( kind = 4 ) a 373 | integer ( kind = 4 ) b 374 | integer ( kind = 4 ) i 375 | integer ( kind = 4 ), parameter :: i4_huge = 2147483647 376 | integer ( kind = 4 ) k 377 | real ( kind = 4 ) r 378 | integer ( kind = 4 ) seed 379 | integer ( kind = 4 ) value 380 | integer ( kind = 4 ) x(n) 381 | 382 | if ( seed == 0 ) then 383 | write ( *, '(a)' ) ' ' 384 | write ( *, '(a)' ) 'I4VEC_UNIFORM - Fatal error!' 385 | write ( *, '(a)' ) ' Input value of SEED = 0.' 386 | stop 387 | end if 388 | 389 | do i = 1, n 390 | 391 | k = seed / 127773 392 | 393 | seed = 16807 * ( seed - k * 127773 ) - k * 2836 394 | 395 | if ( seed < 0 ) then 396 | seed = seed + i4_huge 397 | end if 398 | 399 | r = real ( seed, kind = 4 ) * 4.656612875E-10 400 | ! 401 | ! Scale R to lie between A-0.5 and B+0.5. 402 | ! 403 | r = ( 1.0E+00 - r ) * ( real ( min ( a, b ), kind = 4 ) - 0.5E+00 ) & 404 | + r * ( real ( max ( a, b ), kind = 4 ) + 0.5E+00 ) 405 | ! 406 | ! Use rounding to convert R to an integer between A and B. 407 | ! 408 | value = nint ( r, kind = 4 ) 409 | 410 | value = max ( value, min ( a, b ) ) 411 | value = min ( value, max ( a, b ) ) 412 | 413 | x(i) = value 414 | 415 | end do 416 | 417 | return 418 | end 419 | -------------------------------------------------------------------------------- /src/lambert.f90: -------------------------------------------------------------------------------- 1 | subroutine lambert1 ( n, eta ) 2 | 3 | !*****************************************************************************80 4 | ! 5 | !! LAMBERT1 computes the Lambert sequence in 1D. 6 | ! 7 | ! Licensing: 8 | ! 9 | ! This code is distributed under the GNU LGPL license. 10 | ! 11 | ! Modified: 12 | ! 13 | ! 12 April 2003 14 | ! 15 | ! Author: 16 | ! 17 | ! John Burkardt 18 | ! 19 | ! Reference: 20 | ! 21 | ! J P Lambert, 22 | ! Quasi-Random Sequences for Optimization and Numerical Integration, 23 | ! in Numerical Integration, 24 | ! edited by P Keast and G Fairweather, 25 | ! D Reidel, 1987, pages 193-203. 26 | ! 27 | ! Parameters: 28 | ! 29 | ! Input, integer ( kind = 4 ) N, the number of elements of the sequence 30 | ! to compute. 31 | ! 32 | ! Output, real ( kind = 8 ) ETA(1,N), the elements of the sequence. 33 | ! 34 | implicit none 35 | 36 | integer ( kind = 4 ) n 37 | 38 | real ( kind = 8 ) eta(1,n) 39 | integer ( kind = 4 ) j 40 | real ( kind = 8 ) t 41 | real ( kind = 8 ) x 42 | !f2py integer intent(in) :: n 43 | !f2py real*8 intent(out),depend(n),dimension(1,n) :: eta 44 | 45 | eta(1,1) = 0.0D+00 46 | 47 | do j = 2, n 48 | 49 | t = 1.0D+00 50 | 51 | do 52 | 53 | t = t / 2.0D+00 54 | 55 | if ( x + t < 1.0D+00 ) then 56 | exit 57 | end if 58 | 59 | end do 60 | 61 | x = x + t - 1.0D+00 62 | 63 | if ( x < 0.0D+00 ) then 64 | x = x + 2.0D+00 * t 65 | end if 66 | 67 | eta(1,j) = x 68 | 69 | end do 70 | 71 | return 72 | end 73 | subroutine lambert2 ( n, eta ) 74 | 75 | !*****************************************************************************80 76 | ! 77 | !! LAMBERT2 computes the Lambert sequence in 2D. 78 | ! 79 | ! Licensing: 80 | ! 81 | ! This code is distributed under the GNU LGPL license. 82 | ! 83 | ! Modified: 84 | ! 85 | ! 09 April 2003 86 | ! 87 | ! Author: 88 | ! 89 | ! John Burkardt 90 | ! 91 | ! Reference: 92 | ! 93 | ! J P Lambert, 94 | ! Quasi-Random Sequences for Optimization and Numerical Integration, 95 | ! in Numerical Integration, 96 | ! edited by P Keast and G Fairweather, 97 | ! D Reidel, 1987, pages 193-203. 98 | ! 99 | ! Parameters: 100 | ! 101 | ! Input, integer ( kind = 4 ) N, the number of elements of the sequence 102 | ! to compute. 103 | ! 104 | ! Output, real ( kind = 8 ) ETA(2,N), the elements of the sequence. 105 | ! 106 | implicit none 107 | 108 | integer ( kind = 4 ) n 109 | 110 | real ( kind = 8 ) eta(2,n) 111 | integer ( kind = 4 ) j 112 | real ( kind = 8 ) t 113 | real ( kind = 8 ) u 114 | real ( kind = 8 ) x 115 | real ( kind = 8 ) y 116 | !f2py integer intent(in) :: n 117 | !f2py real*8 intent(out),depend(n),dimension(2,n) :: eta 118 | 119 | eta(1:2,1) = 0.0D+00 120 | 121 | do j = 2, n 122 | 123 | t = 1.0D+00 124 | 125 | do 126 | 127 | t = t / 2.0D+00 128 | u = 1.0D+00 - t 129 | 130 | if ( x < u .or. t <= y ) then 131 | exit 132 | end if 133 | 134 | end do 135 | 136 | x = x - u 137 | 138 | if ( x < 0.0D+00 ) then 139 | x = x + 2.0D+00 * t 140 | if ( y < t ) then 141 | y = y + t 142 | else 143 | y = y - t 144 | end if 145 | end if 146 | 147 | eta(1:2,j) = (/ x, y /) 148 | 149 | end do 150 | 151 | return 152 | end 153 | subroutine lambert3 ( n, eta ) 154 | 155 | !*****************************************************************************80 156 | ! 157 | !! LAMBERT3 computes the Lambert sequence in 3D. 158 | ! 159 | ! Licensing: 160 | ! 161 | ! This code is distributed under the GNU LGPL license. 162 | ! 163 | ! Modified: 164 | ! 165 | ! 10 April 2003 166 | ! 167 | ! Author: 168 | ! 169 | ! John Burkardt 170 | ! 171 | ! Reference: 172 | ! 173 | ! J P Lambert, 174 | ! Quasi-Random Sequences for Optimization and Numerical Integration, 175 | ! in Numerical Integration, 176 | ! edited by P Keast and G Fairweather, 177 | ! D Reidel, 1987, pages 193-203. 178 | ! 179 | ! Parameters: 180 | ! 181 | ! Input, integer ( kind = 4 ) N, the number of elements of the sequence 182 | ! to compute. 183 | ! 184 | ! Output, real ( kind = 8 ) ETA(3,N), the elements of the sequence. 185 | ! 186 | implicit none 187 | 188 | integer n 189 | 190 | real ( kind = 8 ) eta(3,n) 191 | integer ( kind = 4 ) j 192 | real ( kind = 8 ) t 193 | real ( kind = 8 ) u 194 | real ( kind = 8 ) x 195 | real ( kind = 8 ) y 196 | real ( kind = 8 ) z 197 | !f2py integer intent(in) :: n 198 | !f2py real*8 intent(out),depend(n),dimension(3,n) :: eta 199 | 200 | eta(1:3,1) = 0.0D+00 201 | 202 | do j = 2, n 203 | 204 | t = 1.0D+00 205 | 206 | do 207 | 208 | t = t / 2.0D+00 209 | u = 1.0D+00 - t 210 | 211 | if ( x < u .or. y < u .or. t <= z ) then 212 | exit 213 | end if 214 | 215 | end do 216 | 217 | x = x - u 218 | y = y - u 219 | z = z - t 220 | 221 | if ( x < 0.0D+00 ) then 222 | 223 | x = x + 2.0D+00 * t 224 | if ( y < 0.0D+00 ) then 225 | y = y + 2.0D+00 * t 226 | end if 227 | if ( z < 0.0D+00 ) then 228 | z = z + 2.0D+00 * t 229 | end if 230 | 231 | else 232 | 233 | if ( y < 0.0D+00 ) then 234 | if ( z < 0.0D+00 ) then 235 | y = y + t 236 | z = z + 2.0D+00 * t 237 | else if ( y < 0.0D+00 ) then 238 | y = y + 2.0D+00 * t 239 | z = z + t 240 | end if 241 | else if ( 0.0D+00 <= y ) then 242 | y = y + t 243 | end if 244 | 245 | end if 246 | 247 | eta(1:3,j) = (/ x, y, z /) 248 | 249 | end do 250 | 251 | return 252 | end 253 | subroutine lambert4 ( n, eta ) 254 | 255 | !*****************************************************************************80 256 | ! 257 | !! LAMBERT4 computes the Lambert sequence in 4D. 258 | ! 259 | ! Licensing: 260 | ! 261 | ! This code is distributed under the GNU LGPL license. 262 | ! 263 | ! Modified: 264 | ! 265 | ! 11 April 2003 266 | ! 267 | ! Author: 268 | ! 269 | ! John Burkardt 270 | ! 271 | ! Reference: 272 | ! 273 | ! J P Lambert, 274 | ! Quasi-Random Sequences for Optimization and Numerical Integration, 275 | ! in Numerical Integration, 276 | ! edited by P Keast and G Fairweather, 277 | ! D Reidel, 1987, pages 193-203. 278 | ! 279 | ! Parameters: 280 | ! 281 | ! Input, integer ( kind = 4 ) N, the number of elements of the sequence 282 | ! to compute. 283 | ! 284 | ! Output, real ( kind = 8 ) ETA(4,N), the elements of the sequence. 285 | ! 286 | implicit none 287 | 288 | integer n 289 | 290 | real ( kind = 8 ) eta(4,n) 291 | integer ( kind = 4 ) j 292 | real ( kind = 8 ) t 293 | real ( kind = 8 ) u 294 | real ( kind = 8 ) w 295 | real ( kind = 8 ) x 296 | real ( kind = 8 ) y 297 | real ( kind = 8 ) z 298 | !f2py integer intent(in) :: n 299 | !f2py real*8 intent(out),depend(n),dimension(4,n) :: eta 300 | 301 | eta(1:4,1) = 0.0D+00 302 | 303 | do j = 2, n 304 | 305 | t = 1.0D+00 306 | 307 | do 308 | 309 | t = t / 2.0D+00 310 | u = 1.0D+00 - t 311 | 312 | if ( x < u .or. y < u .or. z < u .or. t <= w ) then 313 | exit 314 | end if 315 | 316 | end do 317 | 318 | x = x - u 319 | y = y - u 320 | z = z - u 321 | w = w - t 322 | 323 | if ( x < 0.0D+00 ) then 324 | 325 | x = x + 2.0D+00 * t 326 | 327 | if ( y < 0.0D+00 ) then 328 | y = y + 2.0D+00 * t 329 | end if 330 | if ( z < 0.0D+00 ) then 331 | z = z + 2.0D+00 * t 332 | end if 333 | if ( w < 0.0D+00 ) then 334 | w = w + 2.0D+00 * t 335 | end if 336 | 337 | else if ( y < 0.0D+00 ) then 338 | 339 | if ( z < 0.0D+00 ) then 340 | 341 | if ( w < 0.0D+00 ) then 342 | y = y + 2.0D+00 * t 343 | z = z + 2.0D+00 * t 344 | w = w + t 345 | else if ( 0.0D+00 <= w ) then 346 | y = y + t 347 | z = z + 2.0D+00 * t 348 | end if 349 | 350 | else if ( 0.0D+00 <= z ) then 351 | 352 | if ( w < 0.0D+00 ) then 353 | y = y + 2.0D+00 * t 354 | z = z + t 355 | w = w + 2.0D+00 * t 356 | else if ( 0.0D+00 <= w ) then 357 | y = y + 2.0D+00 * t 358 | w = w + t 359 | end if 360 | 361 | end if 362 | 363 | else if ( z < 0.0D+00 ) then 364 | 365 | if ( w < 0.0D+00 ) then 366 | z = z + t 367 | w = w + 2.0D+00 * t 368 | else if ( 0.0D+00 <= w ) then 369 | z = z + 2.0D+00 * t 370 | w = w + t 371 | end if 372 | 373 | else 374 | 375 | y = y + t 376 | 377 | end if 378 | 379 | eta(1:4,j) = (/ x, y, z, w /) 380 | 381 | end do 382 | 383 | return 384 | end 385 | -------------------------------------------------------------------------------- /src/latin_center.f90: -------------------------------------------------------------------------------- 1 | subroutine get_seed ( seed ) 2 | 3 | !*****************************************************************************80 4 | ! 5 | !! GET_SEED returns a seed for the random number generator. 6 | ! 7 | ! Discussion: 8 | ! 9 | ! The seed depends on the current time, and ought to be (slightly) 10 | ! different every millisecond. Once the seed is obtained, a random 11 | ! number generator should be called a few times to further process 12 | ! the seed. 13 | ! 14 | ! Licensing: 15 | ! 16 | ! This code is distributed under the GNU LGPL license. 17 | ! 18 | ! Modified: 19 | ! 20 | ! 02 August 2004 21 | ! 22 | ! Author: 23 | ! 24 | ! John Burkardt 25 | ! 26 | ! Parameters: 27 | ! 28 | ! Output, integer ( kind = 4 ) SEED, a pseudorandom seed value. 29 | ! 30 | implicit none 31 | 32 | integer ( kind = 4 ), parameter :: i4_huge = 2147483647 33 | integer ( kind = 4 ) seed 34 | !f2py intent(out) seed 35 | real ( kind = 8 ) temp 36 | character ( len = 10 ) time 37 | character ( len = 8 ) today 38 | integer ( kind = 4 ) values(8) 39 | character ( len = 5 ) zone 40 | 41 | call date_and_time ( today, time, zone, values ) 42 | 43 | temp = 0.0D+00 44 | 45 | temp = temp + real ( values(2) - 1, kind = 8 ) / 11.0D+00 46 | temp = temp + real ( values(3) - 1, kind = 8 ) / 30.0D+00 47 | temp = temp + real ( values(5), kind = 8 ) / 23.0D+00 48 | temp = temp + real ( values(6), kind = 8 ) / 59.0D+00 49 | temp = temp + real ( values(7), kind = 8 ) / 59.0D+00 50 | temp = temp + real ( values(8), kind = 8 ) / 999.0D+00 51 | temp = temp / 6.0D+00 52 | 53 | do while ( temp <= 0.0D+00 ) 54 | temp = temp + 1.0D+00 55 | end do 56 | 57 | do while ( 1.0D+00 < temp ) 58 | temp = temp - 1.0D+00 59 | end do 60 | 61 | seed = int ( real ( i4_huge, kind = 8 ) * temp ) 62 | ! 63 | ! Never use a seed of 0 or maximum integer. 64 | ! 65 | if ( seed == 0 ) then 66 | seed = 1 67 | end if 68 | 69 | if ( seed == i4_huge ) then 70 | seed = seed - 1 71 | end if 72 | 73 | return 74 | end 75 | function i4_uniform ( a, b, seed ) 76 | 77 | !*****************************************************************************80 78 | ! 79 | !! I4_UNIFORM returns a scaled pseudorandom I4. 80 | ! 81 | ! Discussion: 82 | ! 83 | ! An I4 is an integer ( kind = 4 ) value. 84 | ! 85 | ! The pseudorandom number will be scaled to be uniformly distributed 86 | ! between A and B. 87 | ! 88 | ! Licensing: 89 | ! 90 | ! This code is distributed under the GNU LGPL license. 91 | ! 92 | ! Modified: 93 | ! 94 | ! 12 November 2006 95 | ! 96 | ! Author: 97 | ! 98 | ! John Burkardt 99 | ! 100 | ! Reference: 101 | ! 102 | ! Paul Bratley, Bennett Fox, Linus Schrage, 103 | ! A Guide to Simulation, 104 | ! Springer Verlag, pages 201-202, 1983. 105 | ! 106 | ! Pierre L'Ecuyer, 107 | ! Random Number Generation, 108 | ! in Handbook of Simulation, 109 | ! edited by Jerry Banks, 110 | ! Wiley Interscience, page 95, 1998. 111 | ! 112 | ! Bennett Fox, 113 | ! Algorithm 647: 114 | ! Implementation and Relative Efficiency of Quasirandom 115 | ! Sequence Generators, 116 | ! ACM Transactions on Mathematical Software, 117 | ! Volume 12, Number 4, pages 362-376, 1986. 118 | ! 119 | ! Peter Lewis, Allen Goodman, James Miller 120 | ! A Pseudo-Random Number Generator for the System/360, 121 | ! IBM Systems Journal, 122 | ! Volume 8, pages 136-143, 1969. 123 | ! 124 | ! Parameters: 125 | ! 126 | ! Input, integer ( kind = 4 ) A, B, the limits of the interval. 127 | ! 128 | ! Input/output, integer ( kind = 4 ) SEED, the "seed" value, which 129 | ! should NOT be 0. On output, SEED has been updated. 130 | ! 131 | ! Output, integer ( kind = 4 ) I4_UNIFORM, a number between A and B. 132 | ! 133 | implicit none 134 | 135 | integer ( kind = 4 ) a 136 | integer ( kind = 4 ) b 137 | integer ( kind = 4 ), parameter :: i4_huge = 2147483647 138 | integer ( kind = 4 ) i4_uniform 139 | integer ( kind = 4 ) k 140 | real ( kind = 4 ) r 141 | integer ( kind = 4 ) seed 142 | integer ( kind = 4 ) value 143 | !f2py intent(in) a 144 | !f2py intent(in) b 145 | !f2py intent(in) seed 146 | !f2py intent(out) i4_uniform 147 | 148 | if ( seed == 0 ) then 149 | write ( *, '(a)' ) ' ' 150 | write ( *, '(a)' ) 'I4_UNIFORM - Fatal error!' 151 | write ( *, '(a)' ) ' Input value of SEED = 0.' 152 | stop 153 | end if 154 | 155 | k = seed / 127773 156 | 157 | seed = 16807 * ( seed - k * 127773 ) - k * 2836 158 | 159 | if ( seed < 0 ) then 160 | seed = seed + i4_huge 161 | end if 162 | 163 | r = real ( seed, kind = 4 ) * 4.656612875E-10 164 | ! 165 | ! Scale R to lie between A-0.5 and B+0.5. 166 | ! 167 | r = ( 1.0E+00 - r ) * ( real ( min ( a, b ), kind = 4 ) - 0.5E+00 ) & 168 | + r * ( real ( max ( a, b ), kind = 4 ) + 0.5E+00 ) 169 | ! 170 | ! Use rounding to convert R to an integer between A and B. 171 | ! 172 | value = nint ( r, kind = 4 ) 173 | 174 | value = max ( value, min ( a, b ) ) 175 | value = min ( value, max ( a, b ) ) 176 | 177 | i4_uniform = value 178 | 179 | return 180 | end 181 | subroutine latin_center ( dim_num, point_num, seed, x ) 182 | 183 | !*****************************************************************************80 184 | ! 185 | !! LATIN_CENTER returns points in a Latin Center Square. 186 | ! 187 | ! Discussion: 188 | ! 189 | ! In each spatial dimension, there will be exactly one 190 | ! point with the coordinate value 191 | ! 192 | ! ( 1, 3, 5, ..., 2*point_num-1 ) / ( 2 * point_num ) 193 | ! 194 | ! Licensing: 195 | ! 196 | ! This code is distributed under the GNU LGPL license. 197 | ! 198 | ! Modified: 199 | ! 200 | ! 20 March 2003 201 | ! 202 | ! Author: 203 | ! 204 | ! John Burkardt 205 | ! 206 | ! Parameters: 207 | ! 208 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 209 | ! 210 | ! Input, integer ( kind = 4 ) POINT_NUM, the number of points. 211 | ! 212 | ! Input/output, integer ( kind = 4 ) SEED, a seed for the random 213 | ! number generator. 214 | ! 215 | ! Output, real ( kind = 8 ) X(DIM_NUM,POINT_NUM), the points. 216 | ! 217 | implicit none 218 | 219 | integer ( kind = 4 ) dim_num 220 | integer ( kind = 4 ) point_num 221 | 222 | integer ( kind = 4 ) :: base = 1 223 | integer ( kind = 4 ) i 224 | integer ( kind = 4 ) j 225 | integer ( kind = 4 ) perm(point_num) 226 | integer ( kind = 4 ) seed 227 | real ( kind = 8 ) x(dim_num,point_num) 228 | !f2py intent(in) dim_num 229 | !f2py intent(in) point_num 230 | !f2py intent(out), depend(dim_num, point_num), dimension(dim_num, point_num) :: x 231 | do i = 1, dim_num 232 | 233 | call perm_uniform ( point_num, base, seed, perm ) 234 | 235 | do j = 1, point_num 236 | x(i,j) = real ( 2 * perm(j) - 1, kind = 8 ) & 237 | / real ( 2 * point_num, kind = 8 ) 238 | end do 239 | 240 | end do 241 | 242 | return 243 | end 244 | subroutine perm_uniform ( n, base, seed, p ) 245 | 246 | !*****************************************************************************80 247 | ! 248 | !! PERM_UNIFORM selects a random permutation of N objects. 249 | ! 250 | ! Licensing: 251 | ! 252 | ! This code is distributed under the GNU LGPL license. 253 | ! 254 | ! Modified: 255 | ! 256 | ! 18 November 2008 257 | ! 258 | ! Author: 259 | ! 260 | ! John Burkardt 261 | ! 262 | ! Reference: 263 | ! 264 | ! Albert Nijenhuis, Herbert Wilf, 265 | ! Combinatorial Algorithms, 266 | ! Academic Press, 1978, second edition, 267 | ! ISBN 0-12-519260-6. 268 | ! 269 | ! Parameters: 270 | ! 271 | ! Input, integer ( kind = 4 ) N, the number of objects to be permuted. 272 | ! 273 | ! Input, integer ( kind = 4 ) BASE, is 0 for a 0-based permutation and 1 for 274 | ! a 1-based permutation. 275 | ! 276 | ! Input/output, integer ( kind = 4 ) SEED, a seed for the random 277 | ! number generator. 278 | ! 279 | ! Output, integer ( kind = 4 ) P(N), the permutation. P(I) is the "new" 280 | ! location of the object originally at I. 281 | ! 282 | implicit none 283 | 284 | integer ( kind = 4 ) n 285 | 286 | integer ( kind = 4 ) base 287 | integer ( kind = 4 ) i 288 | integer ( kind = 4 ) i4_uniform 289 | integer ( kind = 4 ) j 290 | integer ( kind = 4 ) k 291 | integer ( kind = 4 ) p(n) 292 | integer ( kind = 4 ) seed 293 | !f2py intent(in) n 294 | !f2py intent(in) base 295 | !f2py intent(out), depend(n), dimension(n) :: p 296 | !f2py intent(in) seed 297 | 298 | do i = 1, n 299 | p(i) = ( i - 1 ) + base 300 | end do 301 | 302 | do i = 1, n 303 | j = i4_uniform ( i, n, seed ) 304 | k = p(i) 305 | p(i) = p(j) 306 | p(j) = k 307 | end do 308 | 309 | return 310 | end 311 | -------------------------------------------------------------------------------- /src/latin_cover.f90: -------------------------------------------------------------------------------- 1 | function i4_modp ( i, j ) 2 | 3 | !*****************************************************************************80 4 | ! 5 | !! I4_MODP returns the nonnegative remainder of I4 division. 6 | ! 7 | ! Discussion: 8 | ! 9 | ! If 10 | ! NREM = I4_MODP ( I, J ) 11 | ! NMULT = ( I - NREM ) / J 12 | ! then 13 | ! I = J * NMULT + NREM 14 | ! where NREM is always nonnegative. 15 | ! 16 | ! The MOD function computes a result with the same sign as the 17 | ! quantity being divided. Thus, suppose you had an angle A, 18 | ! and you wanted to ensure that it was between 0 and 360. 19 | ! Then mod(A,360) would do, if A was positive, but if A 20 | ! was negative, your result would be between -360 and 0. 21 | ! 22 | ! On the other hand, I4_MODP(A,360) is between 0 and 360, always. 23 | ! 24 | ! An I4 is an integer ( kind = 4 ) value. 25 | ! 26 | ! Example: 27 | ! 28 | ! I J MOD I4_MODP Factorization 29 | ! 30 | ! 107 50 7 7 107 = 2 * 50 + 7 31 | ! 107 -50 7 7 107 = -2 * -50 + 7 32 | ! -107 50 -7 43 -107 = -3 * 50 + 43 33 | ! -107 -50 -7 43 -107 = 3 * -50 + 43 34 | ! 35 | ! Licensing: 36 | ! 37 | ! This code is distributed under the GNU LGPL license. 38 | ! 39 | ! Modified: 40 | ! 41 | ! 02 March 1999 42 | ! 43 | ! Author: 44 | ! 45 | ! John Burkardt 46 | ! 47 | ! Parameters: 48 | ! 49 | ! Input, integer ( kind = 4 ) I, the number to be divided. 50 | ! 51 | ! Input, integer ( kind = 4 ) J, the number that divides I. 52 | ! 53 | ! Output, integer ( kind = 4 ) I4_MODP, the nonnegative remainder when I is 54 | ! divided by J. 55 | ! 56 | implicit none 57 | 58 | integer ( kind = 4 ) i 59 | integer ( kind = 4 ) i4_modp 60 | integer ( kind = 4 ) j 61 | integer ( kind = 4 ) value 62 | !f2py intent(in) i 63 | !f2py intent(in) j 64 | !f2py intent(out) i4_modp 65 | 66 | if ( j == 0 ) then 67 | write ( *, '(a)' ) ' ' 68 | write ( *, '(a)' ) 'I4_MODP - Fatal error!' 69 | write ( *, '(a,i8)' ) ' Illegal divisor J = ', j 70 | stop 71 | end if 72 | 73 | value = mod ( i, j ) 74 | 75 | if ( value < 0 ) then 76 | value = value + abs ( j ) 77 | end if 78 | 79 | i4_modp = value 80 | 81 | return 82 | end 83 | function i4_wrap ( ival, ilo, ihi ) 84 | 85 | !*****************************************************************************80 86 | ! 87 | !! I4_WRAP forces an I4 to lie between given limits by wrapping. 88 | ! 89 | ! Discussion: 90 | ! 91 | ! An I4 is an integer ( kind = 4 ) value. 92 | ! 93 | ! There appears to be a bug in the GFORTRAN compiler which can lead to 94 | ! erroneous results when the first argument of I4_WRAP is an expression. 95 | ! In particular: 96 | ! 97 | ! do i = 1, 3 98 | ! if ( test ) then 99 | ! i4 = i4_wrap ( i + 1, 1, 3 ) 100 | ! end if 101 | ! end do 102 | ! 103 | ! was, when I = 3, returning I4 = 3. So I had to replace this with 104 | ! 105 | ! do i = 1, 3 106 | ! if ( test ) then 107 | ! i4 = i + 1 108 | ! i4 = i4_wrap ( i4, 1, 3 ) 109 | ! end if 110 | ! end do 111 | ! 112 | ! Example: 113 | ! 114 | ! ILO = 4, IHI = 8 115 | ! 116 | ! I Value 117 | ! 118 | ! -2 8 119 | ! -1 4 120 | ! 0 5 121 | ! 1 6 122 | ! 2 7 123 | ! 3 8 124 | ! 4 4 125 | ! 5 5 126 | ! 6 6 127 | ! 7 7 128 | ! 8 8 129 | ! 9 4 130 | ! 10 5 131 | ! 11 6 132 | ! 12 7 133 | ! 13 8 134 | ! 14 4 135 | ! 136 | ! Licensing: 137 | ! 138 | ! This code is distributed under the GNU LGPL license. 139 | ! 140 | ! Modified: 141 | ! 142 | ! 07 September 2009 143 | ! 144 | ! Author: 145 | ! 146 | ! John Burkardt 147 | ! 148 | ! Parameters: 149 | ! 150 | ! Input, integer ( kind = 4 ) IVAL, a value. 151 | ! 152 | ! Input, integer ( kind = 4 ) ILO, IHI, the desired bounds. 153 | ! 154 | ! Output, integer ( kind = 4 ) I4_WRAP, a "wrapped" version of the value. 155 | ! 156 | implicit none 157 | 158 | integer ( kind = 4 ) i4_modp 159 | integer ( kind = 4 ) i4_wrap 160 | integer ( kind = 4 ) ihi 161 | integer ( kind = 4 ) ilo 162 | integer ( kind = 4 ) ival 163 | integer ( kind = 4 ) jhi 164 | integer ( kind = 4 ) jlo 165 | integer ( kind = 4 ) value 166 | integer ( kind = 4 ) wide 167 | !f2py intent(in) ival 168 | !f2py intent(in) ilo 169 | !f2py intent(in) ihi 170 | !f2py intent(out) i4_wrap 171 | 172 | jlo = min ( ilo, ihi ) 173 | jhi = max ( ilo, ihi ) 174 | 175 | wide = jhi - jlo + 1 176 | 177 | if ( wide == 1 ) then 178 | value = jlo 179 | else 180 | value = jlo + i4_modp ( ival - jlo, wide ) 181 | end if 182 | 183 | i4_wrap = value 184 | 185 | return 186 | end 187 | subroutine latin_cover ( n, p, a ) 188 | 189 | !*****************************************************************************80 190 | ! 191 | !! LATIN_COVER returns a 2D Latin Square Covering. 192 | ! 193 | ! Licensing: 194 | ! 195 | ! This code is distributed under the GNU LGPL license. 196 | ! 197 | ! Modified: 198 | ! 199 | ! 24 June 2012 200 | ! 201 | ! Author: 202 | ! 203 | ! John Burkardt 204 | ! 205 | ! Parameters: 206 | ! 207 | ! Input, integer ( kind = 4 ) N, the number of points. 208 | ! 209 | ! Input, integer ( kind = 4 ) P(N), a permutation which describes the 210 | ! first Latin square. 211 | ! 212 | ! Output, integer ( kind = 4 ) A(N,N), the Latin cover. A(I,J) = K 213 | ! means that (I,J) is one element of the K-th Latin square. 214 | ! 215 | implicit none 216 | 217 | integer ( kind = 4 ) n 218 | 219 | integer ( kind = 4 ) a(n,n) 220 | integer ( kind = 4 ) i 221 | integer ( kind = 4 ) i4_wrap 222 | integer ( kind = 4 ) ik 223 | integer ( kind = 4 ) k 224 | integer ( kind = 4 ) p(n) 225 | !f2py intent(in) p 226 | !f2py optional, intent(in), check(n<=len(p)) :: n = len(p) 227 | !f2py intent(out), depend(n), dimensions(n,n) :: a 228 | call perm_check ( n, p ) 229 | 230 | do i = 1, n 231 | do k = 1, n 232 | ik = i4_wrap ( i + k - 1, 1, n ) 233 | a(i,p(ik)) = k 234 | end do 235 | end do 236 | 237 | return 238 | end 239 | subroutine latin_cover_2d ( n, p, a ) 240 | 241 | !*****************************************************************************80 242 | ! 243 | !! LATIN_COVER_2D returns a 2D Latin Square Covering. 244 | ! 245 | ! Discussion: 246 | ! 247 | ! This procedure has a chance of being extended to M dimensions. 248 | ! 249 | ! A basic solution is computed, and the user is permitted to permute 250 | ! both the I and J coordinates. 251 | ! 252 | ! Licensing: 253 | ! 254 | ! This code is distributed under the GNU LGPL license. 255 | ! 256 | ! Modified: 257 | ! 258 | ! 24 June 2012 259 | ! 260 | ! Author: 261 | ! 262 | ! John Burkardt 263 | ! 264 | ! Parameters: 265 | ! 266 | ! Input, integer ( kind = 4 ) N, the number of points. 267 | ! 268 | ! Input, integer ( kind = 4 ) P(2,N), permutations to be applied 269 | ! to the spatial dimensions. 270 | ! 271 | ! Output, integer ( kind = 4 ) A(N,N), the Latin cover. A(I,J) = K 272 | ! means that (I,J) is one element of the K-th Latin square. 273 | ! 274 | implicit none 275 | 276 | integer ( kind = 4 ) n 277 | 278 | integer ( kind = 4 ) a(n,n) 279 | integer ( kind = 4 ) b(n,n) 280 | integer ( kind = 4 ) :: base = 1 281 | integer ( kind = 4 ) i 282 | integer ( kind = 4 ) i4_wrap 283 | integer ( kind = 4 ) j 284 | integer ( kind = 4 ) p(2,n) 285 | 286 | call perm_check ( n, p(1,1:n) ) 287 | call perm_check ( n, p(2,1:n) ) 288 | ! 289 | ! Set up the basic solution. 290 | ! 291 | do i = 1, n 292 | do j = 1, n 293 | a(i,j) = i4_wrap ( i - j + base, 0 + base, n - 1 + base ) 294 | end do 295 | end do 296 | ! 297 | ! Apply permutation to dimension I. 298 | ! 299 | do i = 1, n 300 | b(p(1,i),1:n) = a(i,1:n) 301 | end do 302 | ! 303 | ! Apply permutation to dimension J. 304 | ! 305 | do j = 1, n 306 | a(1:n,p(2,j)) = b(1:n,j) 307 | end do 308 | 309 | return 310 | end 311 | subroutine latin_cover_3d ( n, p, a ) 312 | 313 | !*****************************************************************************80 314 | ! 315 | !! LATIN_COVER_3D returns a 3D Latin Square Covering. 316 | ! 317 | ! Discussion: 318 | ! 319 | ! A basic solution is computed, and the user is permitted to permute 320 | ! I, J and K coordinates. 321 | ! 322 | ! Licensing: 323 | ! 324 | ! This code is distributed under the GNU LGPL license. 325 | ! 326 | ! Modified: 327 | ! 328 | ! 24 June 2012 329 | ! 330 | ! Author: 331 | ! 332 | ! John Burkardt 333 | ! 334 | ! Parameters: 335 | ! 336 | ! Input, integer ( kind = 4 ) N, the number of points. 337 | ! 338 | ! Input, integer ( kind = 4 ) P(3,N), permutations to be applied 339 | ! to the spatial dimensions. 340 | ! 341 | ! Output, integer ( kind = 4 ) A(N,N,N), the Latin cover. A(I,J,K) = L 342 | ! means that (I,J,K) is one element of the L-th Latin square. 343 | ! 344 | implicit none 345 | 346 | integer ( kind = 4 ) n 347 | 348 | integer ( kind = 4 ) a(n,n,n) 349 | integer ( kind = 4 ) b(n,n,n) 350 | integer ( kind = 4 ) :: base = 1 351 | integer ( kind = 4 ) i 352 | integer ( kind = 4 ) i4_wrap 353 | integer ( kind = 4 ) ik 354 | integer ( kind = 4 ) j 355 | integer ( kind = 4 ) jk 356 | integer ( kind = 4 ) k 357 | integer ( kind = 4 ) p(3,n) 358 | 359 | call perm_check ( n, p(1,1:n) ) 360 | call perm_check ( n, p(2,1:n) ) 361 | call perm_check ( n, p(3,1:n) ) 362 | ! 363 | ! Set up the basic solution. 364 | ! 365 | do i = 1, n 366 | do j = 1, n 367 | do k = 1, n 368 | ik = i4_wrap ( i + 1 - k, 1, n ) 369 | jk = i4_wrap ( j + 1 - k, 1, n ) 370 | b(i,j,k) = ik + ( jk - 1 ) * n 371 | end do 372 | end do 373 | end do 374 | ! 375 | ! Apply permutation to dimension I. 376 | ! 377 | do i = 1, n 378 | a(p(1,i),1:n,1:n) = b(i,1:n,1:n) 379 | end do 380 | ! 381 | ! Apply permutation to dimension J. 382 | ! 383 | do j = 1, n 384 | b(1:n,p(2,j),1:n) = a(1:n,j,1:n) 385 | end do 386 | ! 387 | ! Apply permutation to dimension K. 388 | ! 389 | do k = 1, n 390 | a(1:n,1:n,p(3,k)) = b(1:n,1:n,k) 391 | end do 392 | 393 | return 394 | end 395 | subroutine perm_check ( n, p ) 396 | 397 | !*****************************************************************************80 398 | ! 399 | !! PERM_CHECK checks that a vector represents a permutation. 400 | ! 401 | ! Discussion: 402 | ! 403 | ! The routine verifies that each of the integers from 1 404 | ! to N occurs among the N entries of the permutation. 405 | ! 406 | ! Licensing: 407 | ! 408 | ! This code is distributed under the GNU LGPL license. 409 | ! 410 | ! Modified: 411 | ! 412 | ! 06 August 2000 413 | ! 414 | ! Author: 415 | ! 416 | ! John Burkardt 417 | ! 418 | ! Parameters: 419 | ! 420 | ! Input, integer ( kind = 4 ) N, the number of entries. 421 | ! 422 | ! Input, integer ( kind = 4 ) P(N), the permutation, in standard index form. 423 | ! 424 | implicit none 425 | 426 | integer ( kind = 4 ) n 427 | 428 | integer ( kind = 4 ) ierror 429 | integer ( kind = 4 ) ifind 430 | integer ( kind = 4 ) iseek 431 | integer ( kind = 4 ) p(n) 432 | 433 | ierror = 0 434 | 435 | do iseek = 1, n 436 | 437 | ierror = iseek 438 | 439 | do ifind = 1, n 440 | if ( p(ifind) == iseek ) then 441 | ierror = 0 442 | exit 443 | end if 444 | end do 445 | 446 | if ( ierror /= 0 ) then 447 | write ( *, '(a)' ) ' ' 448 | write ( *, '(a)' ) ' ' 449 | write ( *, '(a)' ) 'PERM_CHECK - Fatal error!' 450 | write ( *, '(a)' ) ' The input array does not represent' 451 | write ( *, '(a)' ) ' a proper permutation. In particular, the' 452 | write ( *, '(a,i8)' ) ' array is missing the value ', ierror 453 | stop 454 | end if 455 | 456 | end do 457 | 458 | return 459 | end -------------------------------------------------------------------------------- /src/latin_edge.f90: -------------------------------------------------------------------------------- 1 | subroutine latin_edge ( dim_num, point_num, seed, x ) 2 | 3 | !*****************************************************************************80 4 | ! 5 | !! LATIN_EDGE returns edge points in a Latin square. 6 | ! 7 | ! Discussion: 8 | ! 9 | ! In each spatial dimension, there will be exactly one 10 | ! point with the coordinate value 11 | ! 12 | ! ( 0, 1, 2, ..., point_num-1 ) / ( point_num - 1 ) 13 | ! 14 | ! Licensing: 15 | ! 16 | ! This code is distributed under the GNU LGPL license. 17 | ! 18 | ! Modified: 19 | ! 20 | ! 10 September 2004 21 | ! 22 | ! Author: 23 | ! 24 | ! John Burkardt 25 | ! 26 | ! Parameters: 27 | ! 28 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 29 | ! 30 | ! Input, integer ( kind = 4 ) POINT_NUM, the number of points, which should 31 | ! be at least 2! 32 | ! 33 | ! Input/output, integer ( kind = 4 ) SEED, a seed for the random 34 | ! number generator, 35 | ! needed if the portable UNIFORM routine is being used. 36 | ! 37 | ! Output, real ( kind = 8 ) X(DIM_NUM,POINT_NUM), the points. 38 | ! 39 | implicit none 40 | 41 | integer ( kind = 4 ) dim_num 42 | integer ( kind = 4 ) point_num 43 | 44 | integer ( kind = 4 ) :: base = 1 45 | integer ( kind = 4 ) i 46 | integer ( kind = 4 ) j 47 | integer ( kind = 4 ) perm(point_num) 48 | integer ( kind = 4 ) seed 49 | real ( kind = 8 ) x(dim_num,point_num) 50 | !f2py intent(in) dim_num 51 | !f2py intent(in) point_num 52 | !f2py intent(out), depend(dim_num, point_num), dimension(dim_num, point_num) :: x 53 | 54 | if ( point_num == 1 ) then 55 | 56 | x(1:dim_num,1) = 0.5D+00 57 | 58 | else 59 | 60 | do i = 1, dim_num 61 | 62 | call perm_uniform ( point_num, base, seed, perm ) 63 | 64 | do j = 1, point_num 65 | x(i,j) = real ( perm(j) - 1, kind = 8 ) & 66 | / real ( point_num - 1, kind = 8 ) 67 | end do 68 | 69 | end do 70 | 71 | end if 72 | 73 | return 74 | end -------------------------------------------------------------------------------- /src/latin_random.f90: -------------------------------------------------------------------------------- 1 | subroutine latin_random ( dim_num, point_num, seed, x ) 2 | 3 | !*****************************************************************************80 4 | ! 5 | !! LATIN_RANDOM returns points in a Latin Random square. 6 | ! 7 | ! Discussion: 8 | ! 9 | ! In each spatial dimension, there will be exactly one 10 | ! point whose coordinate value lies between consecutive 11 | ! values in the list: 12 | ! 13 | ! ( 0, 1, 2, ..., point_num ) / point_num 14 | ! 15 | ! Licensing: 16 | ! 17 | ! This code is distributed under the GNU LGPL license. 18 | ! 19 | ! Modified: 20 | ! 21 | ! 08 April 2003 22 | ! 23 | ! Author: 24 | ! 25 | ! John Burkardt 26 | ! 27 | ! Parameters: 28 | ! 29 | ! Input, integer ( kind = 4 ) DIM_NUM, the spatial dimension. 30 | ! 31 | ! Input, integer ( kind = 4 ) POINT_NUM, the number of points. 32 | ! 33 | ! Input/output, integer ( kind = 4 ) SEED, a seed for the random 34 | ! number generator. 35 | ! 36 | ! Output, real ( kind = 8 ) X(DIM_NUM,POINT_NUM), the points. 37 | ! 38 | implicit none 39 | 40 | integer ( kind = 4 ) dim_num 41 | integer ( kind = 4 ) point_num 42 | 43 | integer ( kind = 4 ) :: base = 1 44 | integer ( kind = 4 ) i 45 | integer ( kind = 4 ) j 46 | integer ( kind = 4 ) perm(point_num) 47 | real ( kind = 8 ) r8_uniform_01 48 | integer ( kind = 4 ) seed 49 | real ( kind = 8 ) x(dim_num,point_num) 50 | !f2py intent(in) dim_num 51 | !f2py intent(in) point_num 52 | !f2py intent(out), depend(dim_num, point_num), dimension(dim_num, point_num) :: x 53 | 54 | ! 55 | ! Pick DIM_NUM * POINT_NUM random numbers between 0 and 1. 56 | ! 57 | ! For fast results, use the FORTRAN90 standard RANDOM_NUMBER routine. 58 | ! For reproductible results, use the UNIFORM routine. 59 | ! 60 | if ( .false. ) then 61 | 62 | call random_number ( harvest = x(1:dim_num,1:point_num) ) 63 | 64 | else 65 | 66 | do i = 1, dim_num 67 | do j = 1, point_num 68 | x(i,j) = r8_uniform_01 ( seed ) 69 | end do 70 | end do 71 | 72 | end if 73 | ! 74 | ! For spatial dimension I, 75 | ! pick a random permutation of 1 to POINT_NUM, 76 | ! force the corresponding I-th components of X to lie in the 77 | ! interval ( PERM(J)-1, PERM(J) ) / POINT_NUM. 78 | ! 79 | do i = 1, dim_num 80 | 81 | call perm_uniform ( point_num, base, seed, perm ) 82 | 83 | do j = 1, point_num 84 | x(i,j) = ( real ( perm(j) - 1, kind = 8 ) + x(i,j) ) & 85 | / real ( point_num, kind = 8 ) 86 | end do 87 | 88 | end do 89 | 90 | return 91 | end 92 | function r8_uniform_01 ( seed ) 93 | 94 | !*****************************************************************************80 95 | ! 96 | !! R8_UNIFORM_01 returns a unit pseudorandom R8. 97 | ! 98 | ! Discussion: 99 | ! 100 | ! An R8 is a real ( kind = 8 ) value. 101 | ! 102 | ! This routine implements the recursion 103 | ! 104 | ! seed = 16807 * seed mod ( 2^31 - 1 ) 105 | ! r8_uniform_01 = seed / ( 2^31 - 1 ) 106 | ! 107 | ! The integer ( kind = 4 ) arithmetic never requires more than 32 bits, 108 | ! including a sign bit. 109 | ! 110 | ! If the initial seed is 12345, then the first three computations are 111 | ! 112 | ! Input Output R8_UNIFORM_01 113 | ! SEED SEED 114 | ! 115 | ! 12345 207482415 0.096616 116 | ! 207482415 1790989824 0.833995 117 | ! 1790989824 2035175616 0.947702 118 | ! 119 | ! Licensing: 120 | ! 121 | ! This code is distributed under the GNU LGPL license. 122 | ! 123 | ! Modified: 124 | ! 125 | ! 05 July 2006 126 | ! 127 | ! Author: 128 | ! 129 | ! John Burkardt 130 | ! 131 | ! Reference: 132 | ! 133 | ! Paul Bratley, Bennett Fox, Linus Schrage, 134 | ! A Guide to Simulation, 135 | ! Springer Verlag, pages 201-202, 1983. 136 | ! 137 | ! Pierre L'Ecuyer, 138 | ! Random Number Generation, 139 | ! in Handbook of Simulation, 140 | ! edited by Jerry Banks, 141 | ! Wiley Interscience, page 95, 1998. 142 | ! 143 | ! Bennett Fox, 144 | ! Algorithm 647: 145 | ! Implementation and Relative Efficiency of Quasirandom 146 | ! Sequence Generators, 147 | ! ACM Transactions on Mathematical Software, 148 | ! Volume 12, Number 4, pages 362-376, 1986. 149 | ! 150 | ! Peter Lewis, Allen Goodman, James Miller 151 | ! A Pseudo-Random Number Generator for the System/360, 152 | ! IBM Systems Journal, 153 | ! Volume 8, pages 136-143, 1969. 154 | ! 155 | ! Parameters: 156 | ! 157 | ! Input/output, integer ( kind = 4 ) SEED, the "seed" value, which should 158 | ! NOT be 0. On output, SEED has been updated. 159 | ! 160 | ! Output, real ( kind = 8 ) R8_UNIFORM_01, a new pseudorandom variate, 161 | ! strictly between 0 and 1. 162 | ! 163 | implicit none 164 | 165 | integer ( kind = 4 ) k 166 | real ( kind = 8 ) r8_uniform_01 167 | integer ( kind = 4 ) seed 168 | 169 | if ( seed == 0 ) then 170 | write ( *, '(a)' ) ' ' 171 | write ( *, '(a)' ) 'R8_UNIFORM_01 - Fatal error!' 172 | write ( *, '(a)' ) ' Input value of SEED = 0.' 173 | stop 174 | end if 175 | 176 | k = seed / 127773 177 | 178 | seed = 16807 * ( seed - k * 127773 ) - k * 2836 179 | 180 | if ( seed < 0 ) then 181 | seed = seed + 2147483647 182 | end if 183 | ! 184 | ! Although SEED can be represented exactly as a 32 bit integer ( kind = 4 ), 185 | ! it generally cannot be represented exactly as a 32 bit real number! 186 | ! 187 | r8_uniform_01 = real ( seed, kind = 8 ) * 4.656612875D-10 188 | 189 | return 190 | end -------------------------------------------------------------------------------- /src/latinize.f90: -------------------------------------------------------------------------------- 1 | subroutine latinize ( m, n, table ) 2 | 3 | !*****************************************************************************80 4 | ! 5 | !! R8MAT_LATINIZE "Latinizes" an R8MAT. 6 | ! 7 | ! Discussion: 8 | ! 9 | ! On output, each row of the table will have the properties that: 10 | ! 1) the minimum and maximum row values are the same as on input; 11 | ! 2) the row contains N evenly spaced values between the 12 | ! minimum and maximum; 13 | ! 3) in each row, the elements retain their ordering. 14 | ! 15 | ! Licensing: 16 | ! 17 | ! This code is distributed under the GNU LGPL license. 18 | ! 19 | ! Modified: 20 | ! 21 | ! 04 February 2012 22 | ! 23 | ! Author: 24 | ! 25 | ! John Burkardt 26 | ! 27 | ! Parameters: 28 | ! 29 | ! Input, integer ( kind = 4 ) M, the spatial dimension. 30 | ! 31 | ! Input, integer ( kind = 4 ) N, the number of columns. 32 | ! 33 | ! Input/output, real ( kind = 8 ) TABLE(M,N). On input, the dataset to 34 | ! be "Latinized". On output, the Latinized dataset. 35 | ! 36 | implicit none 37 | 38 | integer ( kind = 4 ) m 39 | integer ( kind = 4 ) n 40 | 41 | integer ( kind = 4 ) i 42 | integer ( kind = 4 ) indx(n) 43 | integer ( kind = 4 ) j 44 | real ( kind = 8 ) table(m,n) 45 | !f2py intent(in,out), dimension(m, n) :: table 46 | !f2py intent(in), depend(table), check(m <= shape(table, 0)) :: m = shape(table, 0) 47 | !f2py intent(in), depend(table), check(n <= shape(table, 1)) :: n = shape(table, 1) 48 | real ( kind = 8 ) v_max 49 | real ( kind = 8 ) v_min 50 | 51 | if ( n <= 2 ) then 52 | return 53 | end if 54 | 55 | do i = 1, m 56 | 57 | v_min = minval ( table(i,1:n) ) 58 | v_max = maxval ( table(i,1:n) ) 59 | 60 | call r8vec_sort_heap_index_a ( n, table(i,1:n), indx ) 61 | 62 | do j = 1, n 63 | table(i,indx(j)) = ( real ( n - j, kind = 8 ) * v_min & 64 | + real ( j - 1, kind = 8 ) * v_max ) & 65 | / real ( n - 1, kind = 8 ) 66 | end do 67 | 68 | end do 69 | 70 | return 71 | end 72 | subroutine r8vec_sort_heap_index_a ( n, a, indx ) 73 | 74 | !*****************************************************************************80 75 | ! 76 | !! R8VEC_SORT_HEAP_INDEX_A does an indexed heap ascending sort of a real vector. 77 | ! 78 | ! Discussion: 79 | ! 80 | ! The sorting is not actually carried out. Rather an index array is 81 | ! created which defines the sorting. This array may be used to sort 82 | ! or index the array, or to sort or index related arrays keyed on the 83 | ! original array. 84 | ! 85 | ! Once the index array is computed, the sorting can be carried out 86 | ! "implicitly: 87 | ! 88 | ! A(INDX(I)), I = 1 to N is sorted, 89 | ! 90 | ! or explicitly, by the call 91 | ! 92 | ! call R8VEC_PERMUTE ( N, A, INDX ) 93 | ! 94 | ! after which A(I), I = 1 to N is sorted. 95 | ! 96 | ! Licensing: 97 | ! 98 | ! This code is distributed under the GNU LGPL license. 99 | ! 100 | ! Modified: 101 | ! 102 | ! 25 September 2001 103 | ! 104 | ! Author: 105 | ! 106 | ! John Burkardt 107 | ! 108 | ! Parameters: 109 | ! 110 | ! Input, integer ( kind = 4 ) N, the number of entries in the array. 111 | ! 112 | ! Input, real ( kind = 8 ) A(N), an array to be index-sorted. 113 | ! 114 | ! Output, integer ( kind = 4 ) INDX(N), the sort index. The 115 | ! I-th element of the sorted array is A(INDX(I)). 116 | ! 117 | implicit none 118 | 119 | integer ( kind = 4 ) n 120 | 121 | real ( kind = 8 ) a(n) 122 | real ( kind = 8 ) aval 123 | integer ( kind = 4 ) i 124 | integer ( kind = 4 ) indx(n) 125 | integer ( kind = 4 ) indxt 126 | integer ( kind = 4 ) ir 127 | integer ( kind = 4 ) j 128 | integer ( kind = 4 ) l 129 | 130 | if ( n < 1 ) then 131 | return 132 | end if 133 | 134 | if ( n == 1 ) then 135 | indx(1) = 1 136 | return 137 | end if 138 | 139 | do i = 1, n 140 | indx(i) = i 141 | end do 142 | 143 | l = n / 2 + 1 144 | ir = n 145 | 146 | do 147 | 148 | if ( 1 < l ) then 149 | 150 | l = l - 1 151 | indxt = indx(l) 152 | aval = a(indxt) 153 | 154 | else 155 | 156 | indxt = indx(ir) 157 | aval = a(indxt) 158 | indx(ir) = indx(1) 159 | ir = ir - 1 160 | 161 | if ( ir == 1 ) then 162 | indx(1) = indxt 163 | exit 164 | end if 165 | 166 | end if 167 | 168 | i = l 169 | j = l + l 170 | 171 | do while ( j <= ir ) 172 | 173 | if ( j < ir ) then 174 | if ( a(indx(j)) < a(indx(j+1)) ) then 175 | j = j + 1 176 | end if 177 | end if 178 | 179 | if ( aval < a(indx(j)) ) then 180 | indx(i) = indx(j) 181 | i = j 182 | j = j + j 183 | else 184 | j = ir + 1 185 | end if 186 | 187 | end do 188 | 189 | indx(i) = indxt 190 | 191 | end do 192 | 193 | return 194 | end -------------------------------------------------------------------------------- /unittests/test1.py: -------------------------------------------------------------------------------- 1 | """ 2 | Unittests for best.design 3 | 4 | Author: 5 | Ilias Bilionis 6 | 7 | Date: 8 | 8/31/2013 9 | """ 10 | 11 | 12 | import best.design 13 | import numpy as np 14 | import unittest 15 | 16 | 17 | class TestDesign(unittest.TestCase): 18 | 19 | def test_latinize(self): 20 | x = np.random.rand(1000, 2) 21 | x_lhc = best.design.latinize(x) 22 | 23 | 24 | if __name__ == '__main__': 25 | unittest.main() 26 | --------------------------------------------------------------------------------