├── .gitignore ├── LICENSE.md ├── README.md ├── avg_vs_sloc.svg ├── cpp ├── .idea │ ├── .name │ ├── cxx.iml │ ├── encodings.xml │ ├── misc.xml │ ├── modules.xml │ └── workspace.xml ├── CMakeLists.txt ├── cmake │ └── FindEigen3.cmake └── src │ ├── cppdopri.cpp │ ├── cppdopri.h │ ├── elements.cpp │ ├── elements.h │ ├── kepler.cpp │ ├── kepler.h │ ├── lambert.cpp │ ├── lambert.h │ └── main.cpp ├── fortran ├── CMakeLists.txt └── src │ ├── elements.f90 │ ├── fdopri.f90 │ ├── kepler.f90 │ ├── lambert.f90 │ ├── main.f90 │ └── newton.f90 ├── java ├── .gradle │ └── 2.11 │ │ └── taskArtifacts │ │ ├── cache.properties │ │ ├── cache.properties.lock │ │ ├── fileSnapshots.bin │ │ └── taskArtifacts.bin ├── .idea │ ├── compiler.xml │ ├── copyright │ │ └── profiles_settings.xml │ ├── description.html │ ├── encodings.xml │ ├── libraries │ │ ├── JNI.xml │ │ └── org_apache_commons_commons_math3_3_6.xml │ ├── misc.xml │ ├── modules.xml │ ├── project-template.xml │ ├── uiDesigner.xml │ └── workspace.xml ├── java.iml ├── native │ ├── CMakeLists.txt │ ├── com_helgeeichhorn_icatt_Dopri.h │ └── jdopri.c └── src │ └── com │ └── helgeeichhorn │ └── icatt │ ├── Benchmark.java │ ├── Dopri.java │ ├── Elements.java │ ├── ElementsFast.java │ ├── Gravity.java │ ├── Kepler.java │ ├── KeplerFunctional.java │ ├── Lambert.java │ ├── LambertFast.java │ ├── Main.java │ ├── Newton.java │ └── NewtonFunctional.java ├── julia ├── ICATT.jl ├── dopri.jl ├── elements.jl ├── kepler.jl ├── lambert.jl └── main.jl ├── lib └── dopri │ ├── CMakeLists.txt │ ├── dop853.f │ ├── dopri.f90 │ ├── dopri.h │ └── dopri5.f ├── matlab ├── .gitignore ├── CMakeLists.txt ├── benchmark.m ├── c2.m ├── c3.m ├── cmake │ ├── FindMatlab.cmake │ └── MatlabTestsRedirect.cmake ├── elements.m ├── gravity.m ├── icatt_matlab │ └── icatt_matlab.xcodeproj │ │ ├── project.pbxproj │ │ ├── project.xcworkspace │ │ ├── contents.xcworkspacedata │ │ └── xcuserdata │ │ │ └── helge.xcuserdatad │ │ │ └── UserInterfaceState.xcuserstate │ │ └── xcuserdata │ │ └── helge.xcuserdatad │ │ ├── xcdebugger │ │ └── Breakpoints_v2.xcbkptlist │ │ └── xcschemes │ │ ├── debug.xcscheme │ │ └── xcschememanagement.plist ├── lambert.m ├── mean2ecc.m ├── newton.m ├── period.m ├── propagator.f90 ├── propagator_module.f90 └── proptest.m └── python ├── _dopri.c ├── icatt ├── __init__.py ├── build_dopri.py ├── dopri.py ├── elements.py ├── kepler.py └── lambert.py └── main.py /.gitignore: -------------------------------------------------------------------------------- 1 | build/ 2 | __pycache__/ 3 | java/out/ 4 | python/icatt/_* 5 | java/lib 6 | java/.idea/ 7 | *.mex* 8 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | The Fortran files dop853.f and dopri5.f are distributed under the 2 | following license: 3 | 4 | > Copyright (c) 2004, Ernst Hairer 5 | > 6 | > Redistribution and use in source and binary forms, with or without 7 | > modification, are permitted provided that the following conditions are 8 | > met: 9 | > 10 | > - Redistributions of source code must retain the above copyright 11 | > notice, this list of conditions and the following disclaimer. 12 | > 13 | > - Redistributions in binary form must reproduce the above copyright 14 | > notice, this list of conditions and the following disclaimer in the 15 | > documentation and/or other materials provided with the distribution. 16 | > 17 | > THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS 18 | > IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED 19 | > TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 20 | > PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR 21 | > CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 22 | > EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 23 | > PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 24 | > PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 25 | > LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 26 | > NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 27 | > SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | All other files are distributed under the following license. 30 | 31 | > Copyright (c) 2016, Helge Eichhorn, Juan Luis Cano, Frazer McLean 32 | > 33 | > Permission is hereby granted, free of charge, to any person obtaining 34 | > a copy of this software and associated documentation files (the 35 | > "Software"), to deal in the Software without restriction, including 36 | > without limitation the rights to use, copy, modify, merge, publish, 37 | > distribute, sublicense, and/or sell copies of the Software, and to 38 | > permit persons to whom the Software is furnished to do so, subject to 39 | > the following conditions: 40 | > 41 | > The above copyright notice and this permission notice shall be 42 | > included in all copies or substantial portions of the Software. 43 | > 44 | > THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 45 | > EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 46 | > MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 47 | > IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 48 | > CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 49 | > TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 50 | > SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 51 | 52 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ICATT 2016 Benchmarks 2 | 3 | ![Time vs. SLOC](https://rawgit.com/helgee/icatt-2016/master/avg_vs_sloc.svg) 4 | -------------------------------------------------------------------------------- /avg_vs_sloc.svg: -------------------------------------------------------------------------------- 1 | 2 | 12 | 13 | 14 | Average runtime (N=100,000) w.r.t Fortran 15 | 16 | 17 | 10-1 18 | 100 19 | 101 20 | 102 21 | 103 22 | 23 | 24 | 25 | Fortran 26 | C++ 27 | Java 28 | Julia 29 | Python 30 | Matlab 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | Languages 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 0.0 108 | 0.5 109 | 1.0 110 | 1.5 111 | 112 | 113 | SLOC w.r.t Fortran 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | -------------------------------------------------------------------------------- /cpp/.idea/.name: -------------------------------------------------------------------------------- 1 | cxx -------------------------------------------------------------------------------- /cpp/.idea/encodings.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /cpp/.idea/misc.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | -------------------------------------------------------------------------------- /cpp/.idea/modules.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /cpp/.idea/workspace.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 27 | 28 | 29 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 145 | 146 | 147 | 148 | 149 | true 150 | 151 | 152 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | 183 | 184 | 185 | 188 | 189 | 190 | 191 | 194 | 195 | 198 | 199 | 200 | 201 | 204 | 205 | 208 | 209 | 212 | 213 | 214 | 215 | 218 | 219 | 222 | 223 | 226 | 227 | 230 | 231 | 232 | 233 | 234 | 235 | 236 | 237 | 238 | 239 | 240 | 241 | 242 | 243 | 244 | 245 | 246 | 247 | 248 | 249 | 250 | 251 | 252 | 253 | 254 | 255 | 256 | 257 | 258 | 259 | 260 | 261 | 262 | 263 | 264 | 265 | 266 | 267 | 268 | 269 | 270 | 271 | 272 | 273 | 274 | 275 | 276 | 277 | 278 | 279 | 280 | 281 | 282 | 283 | 284 | 285 | 286 | 287 | 288 | 289 | 290 | 291 | 292 | 293 | 294 | 295 | 296 | 297 | 298 | 299 | 300 | 301 | 302 | 303 | 304 | 305 | 306 | 307 | 308 | 309 | 310 | 311 | 1456928528512 312 | 315 | 316 | 317 | 318 | 319 | 320 | 321 | 322 | 323 | 324 | 325 | 326 | 327 | 328 | 329 | 330 | 331 | 332 | 333 | 334 | 335 | 336 | 337 | 338 | 339 | 340 | 341 | 342 | 345 | 348 | 349 | 350 | 352 | 353 | 354 | 356 | 357 | 358 | 359 | 360 | 361 | 362 | 363 | 364 | 365 | 366 | 367 | 368 | 369 | 370 | 371 | 372 | 373 | 374 | 375 | 376 | 377 | 378 | 379 | 380 | 381 | 382 | 383 | 384 | 385 | 386 | 387 | 388 | 389 | 390 | 391 | 392 | 393 | 394 | 395 | 396 | 397 | 398 | 399 | 400 | 401 | 402 | 403 | 404 | 405 | 406 | 407 | 408 | 409 | 410 | 411 | 412 | 413 | 414 | 415 | 416 | 417 | 418 | 419 | 420 | 421 | 422 | 423 | 424 | 425 | 426 | 427 | 428 | 429 | 430 | 431 | 432 | 433 | 434 | 435 | 436 | 437 | 438 | 439 | 440 | 441 | 442 | 443 | 444 | 445 | 446 | 447 | 448 | 449 | 450 | 451 | 452 | 453 | 454 | 455 | 456 | 457 | 458 | 459 | 460 | 461 | 462 | 463 | 464 | 465 | 466 | 467 | 468 | 469 | 470 | 471 | 472 | 473 | 474 | 475 | 476 | 477 | 478 | 479 | 480 | 481 | 482 | 483 | 484 | 485 | 486 | 487 | -------------------------------------------------------------------------------- /cpp/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 3.3) 2 | project(ICATT) 3 | 4 | set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -std=c++11 -O2") 5 | set(CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake) 6 | find_package(Eigen3 REQUIRED) 7 | 8 | add_subdirectory(../lib/dopri ${CMAKE_BINARY_DIR}/dopri) 9 | 10 | include_directories( 11 | ${EIGEN3_INCLUDE_DIR} 12 | ${PROJECT_SOURCE_DIR}/src 13 | ../lib/dopri) 14 | link_directories(${PROJECT_SOURCE_DIR}) 15 | 16 | set(SOURCE_FILES src/main.cpp src/elements.cpp src/kepler.cpp src/cppdopri.cpp src/lambert.cpp) 17 | add_executable(icatt ${SOURCE_FILES}) 18 | target_link_libraries(icatt dopri) 19 | -------------------------------------------------------------------------------- /cpp/cmake/FindEigen3.cmake: -------------------------------------------------------------------------------- 1 | # - Try to find Eigen3 lib 2 | # 3 | # This module supports requiring a minimum version, e.g. you can do 4 | # find_package(Eigen3 3.1.2) 5 | # to require version 3.1.2 or newer of Eigen3. 6 | # 7 | # Once done this will define 8 | # 9 | # EIGEN3_FOUND - system has eigen lib with correct version 10 | # EIGEN3_INCLUDE_DIR - the eigen include directory 11 | # EIGEN3_VERSION - eigen version 12 | 13 | # Copyright (c) 2006, 2007 Montel Laurent, 14 | # Copyright (c) 2008, 2009 Gael Guennebaud, 15 | # Copyright (c) 2009 Benoit Jacob 16 | # Redistribution and use is allowed according to the terms of the 2-clause BSD license. 17 | 18 | if(NOT Eigen3_FIND_VERSION) 19 | if(NOT Eigen3_FIND_VERSION_MAJOR) 20 | set(Eigen3_FIND_VERSION_MAJOR 2) 21 | endif(NOT Eigen3_FIND_VERSION_MAJOR) 22 | if(NOT Eigen3_FIND_VERSION_MINOR) 23 | set(Eigen3_FIND_VERSION_MINOR 91) 24 | endif(NOT Eigen3_FIND_VERSION_MINOR) 25 | if(NOT Eigen3_FIND_VERSION_PATCH) 26 | set(Eigen3_FIND_VERSION_PATCH 0) 27 | endif(NOT Eigen3_FIND_VERSION_PATCH) 28 | 29 | set(Eigen3_FIND_VERSION "${Eigen3_FIND_VERSION_MAJOR}.${Eigen3_FIND_VERSION_MINOR}.${Eigen3_FIND_VERSION_PATCH}") 30 | endif(NOT Eigen3_FIND_VERSION) 31 | 32 | macro(_eigen3_check_version) 33 | file(READ "${EIGEN3_INCLUDE_DIR}/Eigen/src/Core/util/Macros.h" _eigen3_version_header) 34 | 35 | string(REGEX MATCH "define[ \t]+EIGEN_WORLD_VERSION[ \t]+([0-9]+)" _eigen3_world_version_match "${_eigen3_version_header}") 36 | set(EIGEN3_WORLD_VERSION "${CMAKE_MATCH_1}") 37 | string(REGEX MATCH "define[ \t]+EIGEN_MAJOR_VERSION[ \t]+([0-9]+)" _eigen3_major_version_match "${_eigen3_version_header}") 38 | set(EIGEN3_MAJOR_VERSION "${CMAKE_MATCH_1}") 39 | string(REGEX MATCH "define[ \t]+EIGEN_MINOR_VERSION[ \t]+([0-9]+)" _eigen3_minor_version_match "${_eigen3_version_header}") 40 | set(EIGEN3_MINOR_VERSION "${CMAKE_MATCH_1}") 41 | 42 | set(EIGEN3_VERSION ${EIGEN3_WORLD_VERSION}.${EIGEN3_MAJOR_VERSION}.${EIGEN3_MINOR_VERSION}) 43 | if(${EIGEN3_VERSION} VERSION_LESS ${Eigen3_FIND_VERSION}) 44 | set(EIGEN3_VERSION_OK FALSE) 45 | else(${EIGEN3_VERSION} VERSION_LESS ${Eigen3_FIND_VERSION}) 46 | set(EIGEN3_VERSION_OK TRUE) 47 | endif(${EIGEN3_VERSION} VERSION_LESS ${Eigen3_FIND_VERSION}) 48 | 49 | if(NOT EIGEN3_VERSION_OK) 50 | 51 | message(STATUS "Eigen3 version ${EIGEN3_VERSION} found in ${EIGEN3_INCLUDE_DIR}, " 52 | "but at least version ${Eigen3_FIND_VERSION} is required") 53 | endif(NOT EIGEN3_VERSION_OK) 54 | endmacro(_eigen3_check_version) 55 | 56 | if (EIGEN3_INCLUDE_DIR) 57 | 58 | # in cache already 59 | _eigen3_check_version() 60 | set(EIGEN3_FOUND ${EIGEN3_VERSION_OK}) 61 | 62 | else (EIGEN3_INCLUDE_DIR) 63 | 64 | find_path(EIGEN3_INCLUDE_DIR NAMES signature_of_eigen3_matrix_library 65 | PATHS 66 | ${CMAKE_INSTALL_PREFIX}/include 67 | ${KDE4_INCLUDE_DIR} 68 | PATH_SUFFIXES eigen3 eigen 69 | ) 70 | 71 | if(EIGEN3_INCLUDE_DIR) 72 | _eigen3_check_version() 73 | endif(EIGEN3_INCLUDE_DIR) 74 | 75 | include(FindPackageHandleStandardArgs) 76 | find_package_handle_standard_args(Eigen3 DEFAULT_MSG EIGEN3_INCLUDE_DIR EIGEN3_VERSION_OK) 77 | 78 | mark_as_advanced(EIGEN3_INCLUDE_DIR) 79 | 80 | endif(EIGEN3_INCLUDE_DIR) 81 | 82 | -------------------------------------------------------------------------------- /cpp/src/cppdopri.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include "dopri.h" 6 | #include "kepler.h" 7 | #include "elements.h" 8 | 9 | using Eigen::VectorXd; 10 | using Eigen::Vector3d; 11 | using std::pow; 12 | using std::sqrt; 13 | 14 | namespace dopri { 15 | void gravity(int *n, double *x, double *y, double *f, double *rpar, int *ipar) { 16 | auto r = sqrt(y[0] * y[0] + y[1] * y[1] + y[2] * y[2]); 17 | auto r3 = r*r*r; 18 | f[0] = y[3]; 19 | f[1] = y[4]; 20 | f[2] = y[5]; 21 | f[3] = -rpar[0] * y[0] / r3; 22 | f[4] = -rpar[0] * y[1] / r3; 23 | f[5] = -rpar[0] * y[2] / r3; 24 | } 25 | 26 | void solout_dummy(int *nr, double *xold, double *x, double *y, int *n, double *con, 27 | int *icomp, int *nd, double *rpar, int *ipar, int *irtrn, double *xout){}; 28 | 29 | void integrate(void (*func)(int *, double *, double *, double *, double *, int *), 30 | double *x, VectorXd *rv, double xend, double rpar[], int ipar[], 31 | double reltol = 1e-6, double abstol = 1e-8) { 32 | int n = rv->size(); 33 | double rtol[] = {reltol}; 34 | double atol[] = {abstol}; 35 | int itol = 0; 36 | int iout = 0; 37 | int lwork = 11*n+8*n+21; 38 | int liwork = n + 21; 39 | double work[lwork]; 40 | memset(work, 0, sizeof(work)); 41 | int iwork[liwork]; 42 | memset(iwork, 0, sizeof(iwork)); 43 | int idid = 0; 44 | c_dop853(&n, func, x, rv->data(), &xend, rtol, atol, &itol, &solout_dummy, 45 | &iout, work, &lwork, iwork, &liwork, rpar, ipar, &idid); 46 | } 47 | 48 | void benchmark(int times) { 49 | auto mu = 3.986004418e5; 50 | Vector3d r(8.59072560e+02, -4.13720368e+03, 5.29556871e+03); 51 | Vector3d v(7.37289205e+00, 2.08223573e+00, 4.39999794e-01); 52 | VectorXd rv(r.size()+v.size()); 53 | rv << r, v; 54 | VectorXd rv0(rv); 55 | auto el = elements::elements(r, v, mu); 56 | auto x = 0.0; 57 | double rpar[] = {mu}; 58 | int ipar[] = {0}; 59 | auto xend = kepler::period(el[0], mu); 60 | auto best = std::numeric_limits::infinity(); 61 | auto worst = -std::numeric_limits::infinity(); 62 | double all = 0; 63 | for (auto i=0; i < times; i++) { 64 | auto begin = std::chrono::high_resolution_clock::now(); 65 | integrate(&gravity, &x, &rv0, xend, rpar, ipar); 66 | auto end = std::chrono::high_resolution_clock::now(); 67 | auto current = std::chrono::duration_cast(end-begin).count()/1e9; 68 | all += current; 69 | if (current < best) { 70 | best = current; 71 | } 72 | if (current > worst) { 73 | worst = current; 74 | } 75 | rv0 = rv; 76 | x = 0; 77 | } 78 | std::cout << "[" << all/times << "," << best << "," << worst << "]" << std::endl; 79 | } 80 | } 81 | -------------------------------------------------------------------------------- /cpp/src/cppdopri.h: -------------------------------------------------------------------------------- 1 | #include 2 | #include "dopri.h" 3 | 4 | #ifndef ICATT_DOPRI_H 5 | #define ICATT_DOPRI_H 6 | namespace dopri { 7 | using Eigen::VectorXd; 8 | void gravity(int *n, double *x, double *y, double *f, double *rpar, int *ipar); 9 | 10 | void solout_dummy(int *nr, double *xold, double *x, double *y, int *n, double *con, 11 | int *icomp, int *nd, double *rpar, int *ipar, int *irtrn, double *xout); 12 | void integrate(void (*func)(int *, double *, double *, double *, double *, int *), 13 | double *x, VectorXd *rv, double xend, double rpar[], int ipar[], 14 | double reltol, double abstol); 15 | void benchmark(int times); 16 | } 17 | #endif //ICATT_DOPRI_H 18 | -------------------------------------------------------------------------------- /cpp/src/elements.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include "elements.h" 5 | 6 | using Eigen::Vector3d; 7 | 8 | namespace elements 9 | { 10 | VectorXd elements(Vector3d r, Vector3d v, double mu) 11 | { 12 | auto r_mag = r.norm(); 13 | auto v_mag = v.norm(); 14 | auto v_mag2 = v_mag * v_mag; 15 | auto h = r.cross(v); 16 | auto h_mag = h.norm(); 17 | Vector3d k(0,0,1); 18 | auto n = k.cross(h); 19 | auto n_mag = n.norm(); 20 | auto xi = v_mag2/2 - mu/r_mag; 21 | auto e = ((v_mag2-mu/r_mag)*r - v*r.dot(v))/mu; 22 | auto ecc = e.norm(); 23 | double sma; 24 | if (ecc != 1) { 25 | sma = -mu/(2*xi); 26 | } else { 27 | sma = pow(h_mag,2)/mu; 28 | } 29 | auto inc = acos(h.z()/h_mag); 30 | auto node = acos(n.x()/n_mag); 31 | auto peri = acos(n.dot(e)/(ecc*n_mag)); 32 | auto ano = acos(e.dot(r)/(ecc*r_mag)); 33 | if (n.y() < 0) { 34 | node = M_PI*2 - node; 35 | } 36 | if (e.z() < 0) { 37 | peri = M_PI*2 - peri; 38 | } 39 | if (r.dot(v) < 0) { 40 | ano = M_PI*2 - ano; 41 | } 42 | VectorXd out(6); out << sma, ecc, inc, node, peri, ano; 43 | return out; 44 | } 45 | 46 | void benchmark(int times) { 47 | auto mu = 3.986004418e5; 48 | Vector3d r(8.59072560e+02, -4.13720368e+03, 5.29556871e+03); 49 | Vector3d v(7.37289205e+00, 2.08223573e+00, 4.39999794e-01); 50 | 51 | auto best = std::numeric_limits::infinity(); 52 | auto worst = -std::numeric_limits::infinity(); 53 | double all = 0; 54 | for (auto i=0; i < times; i++) { 55 | auto begin = std::chrono::high_resolution_clock::now(); 56 | 57 | elements(r, v, mu); 58 | 59 | auto end = std::chrono::high_resolution_clock::now(); 60 | auto current = std::chrono::duration_cast(end-begin).count()/1e9; 61 | all += current; 62 | if (current < best) { 63 | best = current; 64 | } 65 | if (current > worst) { 66 | worst = current; 67 | } 68 | } 69 | std::cout << "[" << all/times << "," << best << "," << worst << "]" << std::endl; 70 | } 71 | } 72 | -------------------------------------------------------------------------------- /cpp/src/elements.h: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #ifndef ICATT_ELEMENTS_H 4 | #define ICATT_ELEMENTS_H 5 | namespace elements { 6 | using namespace Eigen; 7 | VectorXd elements(Vector3d r, Vector3d v, double mu); 8 | void benchmark(int times); 9 | } 10 | #endif //ICATT_ELEMENTS_H 11 | -------------------------------------------------------------------------------- /cpp/src/kepler.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include "kepler.h" 7 | #include "elements.h" 8 | 9 | using std::function; 10 | using std::runtime_error; 11 | using Eigen::Vector3d; 12 | 13 | namespace kepler { 14 | double period(double sma, double mu) { 15 | return M_PI * 2 * sqrt(pow(sma, 3) / mu); 16 | } 17 | 18 | double newton( 19 | double p0, 20 | function const &func, 21 | function const &deriv, 22 | int maxiter = 50, 23 | double tol = 1e-8 24 | ) { 25 | for (auto i = 1; i < maxiter; i++) { 26 | auto p = p0 - func(p0) / deriv(p0); 27 | if (fabs(p - p0) < tol) { 28 | return p; 29 | } 30 | p0 = p; 31 | } 32 | throw runtime_error("Not converged."); 33 | } 34 | 35 | double mean2ecc(double M, double ecc) { 36 | auto E = newton(M, [ecc, M](double E) -> double { 37 | return E - ecc * sin(E) - M; 38 | }, [ecc](double E) -> double { 39 | return 1 - ecc * cos(E); 40 | }); 41 | return E; 42 | } 43 | 44 | double ecc2true(double E, double ecc) { 45 | return 2 * atan2(sqrt(1 + ecc) * sin(E / 2), sqrt(1 - ecc) * cos(E / 2)); 46 | } 47 | 48 | void benchmark(int times) { 49 | auto mu = 3.986004418e5; 50 | Vector3d r(8.59072560e+02, -4.13720368e+03, 5.29556871e+03); 51 | Vector3d v(7.37289205e+00, 2.08223573e+00, 4.39999794e-01); 52 | auto el = elements::elements(r, v, mu); 53 | 54 | auto best = std::numeric_limits::infinity(); 55 | auto worst = -std::numeric_limits::infinity(); 56 | double all = 0; 57 | for (auto i=0; i < times; i++) { 58 | auto begin = std::chrono::high_resolution_clock::now(); 59 | 60 | mean2ecc(M_PI, el[1]); 61 | 62 | auto end = std::chrono::high_resolution_clock::now(); 63 | auto current = std::chrono::duration_cast(end-begin).count()/1e9; 64 | all += current; 65 | if (current < best) { 66 | best = current; 67 | } 68 | if (current > worst) { 69 | worst = current; 70 | } 71 | } 72 | std::cout << "[" << all/times << "," << best << "," << worst << "]" << std::endl; 73 | } 74 | } 75 | 76 | -------------------------------------------------------------------------------- /cpp/src/kepler.h: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #ifndef ICATT_KEPLER_H 4 | #define ICATT_KEPLER_H 5 | namespace kepler { 6 | double period(double sma, double mu); 7 | 8 | double newton(double x0, std::function const &func, std::function const &deriv, 9 | int maxiter, double tol); 10 | 11 | double mean2ecc(double M, double ecc); 12 | 13 | double ecc2true(double E, double ecc); 14 | void benchmark(int times); 15 | } 16 | #endif //ICATT_KEPLER_H 17 | -------------------------------------------------------------------------------- /cpp/src/lambert.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | 7 | using Eigen::Vector3d; 8 | using std::runtime_error; 9 | 10 | namespace lambert { 11 | struct LambertResults { 12 | Vector3d v0; 13 | Vector3d v; 14 | }; 15 | 16 | double c2(double psi) { 17 | double res; 18 | auto eps = 1.0; 19 | if (psi > eps) { 20 | res = (1 - cos(sqrt(psi))) / psi; 21 | } else if (psi < -eps) { 22 | res = (cosh(sqrt(-psi)) - 1) / (-psi); 23 | } else { 24 | res = 1.0 / 2.0; 25 | auto delta = (-psi) / tgamma(2 + 2 + 1); 26 | auto k = 1; 27 | while (res + delta != res) { 28 | res += delta; 29 | k += 1; 30 | delta = pow(-psi, k) / tgamma(2*k + 2 + 1); 31 | } 32 | } 33 | return res; 34 | } 35 | 36 | double c3(double psi) { 37 | double res; 38 | auto eps = 1.0; 39 | if (psi > eps) { 40 | res = (sqrt(psi) - sin(sqrt(psi))) / (psi * sqrt(psi)); 41 | } else if (psi < -eps) { 42 | res = (sinh(sqrt(-psi)) - sqrt(-psi)) / (-psi * sqrt(-psi)); 43 | } else { 44 | res = 1.0 / 6.0; 45 | auto delta = (-psi) / tgamma(2 + 3 + 1); 46 | int k = 1; 47 | while (res + delta != res) { 48 | res += delta; 49 | k += 1; 50 | delta = pow(-psi, k) / tgamma(2*k + 3 + 1); 51 | } 52 | } 53 | return res; 54 | } 55 | 56 | LambertResults lambert(double k, Vector3d r0, Vector3d r, double tof, 57 | bool shortway=true, int numiter=35, double rtol=1e-8) { 58 | int t_m; 59 | if (shortway) { 60 | t_m = 1; 61 | } else { 62 | t_m = -1; 63 | } 64 | auto norm_r0 = r0.norm(); 65 | auto norm_r = r.norm(); 66 | auto cos_dnu = r0.dot(r) / (norm_r * norm_r0); 67 | 68 | auto A = t_m * sqrt(norm_r * norm_r0 * (1 + cos_dnu)); 69 | 70 | if (A == 0.0) { 71 | throw runtime_error("Cannot compute orbit, phase angle is 180 degrees"); 72 | } 73 | 74 | auto psi = 0.0; 75 | auto psi_low = -4*M_PI; 76 | auto psi_up = 4*M_PI; 77 | 78 | auto count = 0; 79 | double y; 80 | while (count < numiter) { 81 | y = norm_r0 + norm_r + A * (psi * c3(psi) - 1) / sqrt(c2(psi)); 82 | if (A > 0.0 & y < 0.0) { 83 | while (y < 0.0) { 84 | psi_low = psi; 85 | psi = (0.8 * (1.0 / c3(psi)) * 86 | (1.0 - (norm_r0 + norm_r) * sqrt(c2(psi)) / A)); 87 | y = norm_r0 + norm_r + A * (psi * c3(psi) - 1) / sqrt(c2(psi)); 88 | } 89 | } 90 | auto xi = sqrt(y / c2(psi)); 91 | auto tof_new = (pow(xi, 3) * c3(psi) + A * sqrt(y)) / sqrt(k); 92 | 93 | if (fabs((tof_new - tof) / tof) < rtol) { 94 | break; 95 | } else { 96 | count += 1; 97 | if (tof_new <= tof) { 98 | psi_low = psi; 99 | } else { 100 | psi_up = psi; 101 | } 102 | psi = (psi_up + psi_low) / 2; 103 | } 104 | } 105 | if (count > numiter) { 106 | throw runtime_error("Maximum number of iterations reached"); 107 | } 108 | auto f = 1 - y / norm_r0; 109 | auto g = A * sqrt(y / k); 110 | auto gdot = 1 - y / norm_r; 111 | auto v0 = (r - f * r0) / g; 112 | auto v = (gdot * r - r0) / g; 113 | LambertResults results = {v, v0}; 114 | return results; 115 | } 116 | 117 | void benchmark(int times) { 118 | auto mu = 3.986004418e5; 119 | Vector3d r0(5000.0, 10000.0, 2100.0); 120 | Vector3d r(-14600.0, 2500.0, 7000.0); 121 | auto tof = 3600.0; 122 | 123 | auto best = std::numeric_limits::infinity(); 124 | auto worst = -std::numeric_limits::infinity(); 125 | double all = 0; 126 | for (auto i=0; i < times; i++) { 127 | auto begin = std::chrono::high_resolution_clock::now(); 128 | 129 | lambert(mu, r0, r, tof); 130 | 131 | auto end = std::chrono::high_resolution_clock::now(); 132 | auto current = std::chrono::duration_cast(end-begin).count()/1e9; 133 | all += current; 134 | if (current < best) { 135 | best = current; 136 | } 137 | if (current > worst) { 138 | worst = current; 139 | } 140 | } 141 | std::cout << "[" << all/times << "," << best << "," << worst << "]" << std::endl; 142 | } 143 | } 144 | -------------------------------------------------------------------------------- /cpp/src/lambert.h: -------------------------------------------------------------------------------- 1 | namespace lambert { 2 | double c2(double psi); 3 | double c3(double psi); 4 | void benchmark(int times); 5 | } 6 | -------------------------------------------------------------------------------- /cpp/src/main.cpp: -------------------------------------------------------------------------------- 1 | #include "elements.h" 2 | #include "kepler.h" 3 | #include "cppdopri.h" 4 | #include "lambert.h" 5 | 6 | int main() 7 | { 8 | int n = 100000; 9 | elements::benchmark(n); 10 | kepler::benchmark(n); 11 | lambert::benchmark(n); 12 | dopri::benchmark(n); 13 | } 14 | -------------------------------------------------------------------------------- /fortran/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 3.3) 2 | 3 | project(icatt Fortran) 4 | enable_language(Fortran) 5 | 6 | set(CMAKE_Fortran_MODULE_DIRECTORY ${PROJECT_BINARY_DIR}/include) 7 | set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -O2") 8 | 9 | add_subdirectory(../lib/dopri ${PROJECT_BINARY_DIR}/dopri) 10 | 11 | set(SRCS src/main.f90 12 | src/elements.f90 13 | src/fdopri.f90 14 | src/kepler.f90 15 | src/newton.f90 16 | src/lambert.f90) 17 | 18 | add_executable(icatt ${SRCS}) 19 | target_link_libraries(icatt dopri) 20 | -------------------------------------------------------------------------------- /fortran/src/elements.f90: -------------------------------------------------------------------------------- 1 | module elements 2 | 3 | implicit none 4 | 5 | double precision, parameter :: pi = 3.1415926535897931d0 6 | 7 | contains 8 | 9 | pure function fromrv(r, v, mu) result(ele) 10 | double precision, dimension(:), intent(in) :: r 11 | double precision, dimension(:), intent(in) :: v 12 | double precision, intent(in) :: mu 13 | double precision, dimension(6) :: ele 14 | 15 | double precision :: r_mag, v_mag, h_mag, n_mag, xi 16 | double precision, dimension(3) :: h, n, k, e 17 | 18 | r_mag = norm2(r) 19 | v_mag = norm2(v) 20 | h = cross(r,v) 21 | h_mag = norm2(h) 22 | k = [0d0, 0d0, 1d0] 23 | n = cross(k, h) 24 | n_mag = norm2(n) 25 | xi = v_mag**2/2 - mu/r_mag 26 | e = ((v_mag**2 - mu/r_mag)*r - v*dot_product(r,v))/mu 27 | ele(2) = norm2(e) 28 | if (ele(2) /= 1.0) then 29 | ele(1) = -mu/(2*xi) 30 | else 31 | ele(1) = h_mag**2/mu 32 | end if 33 | ele(3) = acos(h(3)/h_mag) 34 | ele(4) = acos(n(1)/n_mag) 35 | ele(5) = acos(dot_product(n,e)/(ele(2)*n_mag)) 36 | ele(6) = acos(dot_product(e,r)/(ele(2)*r_mag)) 37 | if (n(2) < 0) then 38 | ele(4) = 2*pi - ele(4) 39 | end if 40 | if (e(3) < 0) then 41 | ele(5) = 2*pi - ele(5) 42 | end if 43 | if (dot_product(r,v) < 0) then 44 | ele(6) = 2*pi - ele(6) 45 | end if 46 | end function fromrv 47 | 48 | pure function cross(a, b) 49 | double precision, dimension(:), intent(in) :: a 50 | double precision, dimension(:), intent(in) :: b 51 | double precision, dimension(3) :: cross 52 | 53 | cross(1) = a(2) * b(3) - a(3) * b(2) 54 | cross(2) = a(3) * b(1) - a(1) * b(3) 55 | cross(3) = a(1) * b(2) - a(2) * b(1) 56 | end function cross 57 | 58 | subroutine benchmark_elements(times) 59 | integer, intent(in) :: times 60 | 61 | double precision, dimension(3) :: r 62 | double precision, dimension(3) :: v 63 | double precision, dimension(6) :: el 64 | double precision, parameter :: mu = 3.986004418d5 65 | 66 | double precision :: current, rate 67 | integer(kind=8) :: start, finish, irate 68 | double precision :: total, best, worst 69 | integer :: i 70 | 71 | r = [8.59072560d+02, -4.13720368d+03, 5.29556871d+03] 72 | v = [7.37289205d+00, 2.08223573d+00, 4.39999794d-01] 73 | 74 | worst = -1d20 75 | best = 1d20 76 | total = 0d0 77 | call system_clock(count_rate=irate) 78 | rate = dble(irate) 79 | do i=1, times 80 | call system_clock(start) 81 | 82 | el = fromrv(r, v, mu) 83 | 84 | call system_clock(finish) 85 | current = (finish - start)/rate 86 | if (current < best .and. current > 0) then 87 | best = current 88 | end if 89 | if (current > worst) then 90 | worst = current 91 | end if 92 | total = total + current 93 | end do 94 | print *, total/times, best, worst 95 | end subroutine benchmark_elements 96 | 97 | end module elements 98 | -------------------------------------------------------------------------------- /fortran/src/fdopri.f90: -------------------------------------------------------------------------------- 1 | module fdopri 2 | 3 | use dopri 4 | use elements, only: fromrv 5 | use kepler, only: period 6 | 7 | implicit none 8 | 9 | contains 10 | 11 | subroutine integrate(fcn, y, t, tend, rpar, ipar,& 12 | stat, solout, rtol, atol) 13 | double precision, dimension(:), intent(inout) :: y 14 | double precision, intent(inout) :: t 15 | double precision, intent(inout) :: tend 16 | double precision, dimension(:), intent(inout) :: rpar 17 | integer, dimension(:), intent(inout) :: ipar 18 | integer, intent(out), optional :: stat 19 | double precision, dimension(:), intent(in), optional :: rtol 20 | double precision, dimension(:), intent(in), optional :: atol 21 | procedure(dopfcn) :: fcn 22 | procedure(dopsolout), optional :: solout 23 | 24 | integer :: lwork 25 | integer :: liwork 26 | integer :: iout 27 | integer :: idid 28 | integer :: itol 29 | integer, dimension(:), allocatable :: iwork 30 | integer :: n 31 | double precision, dimension(:), allocatable :: rtol_ 32 | double precision, dimension(:), allocatable :: atol_ 33 | double precision, dimension(:), allocatable :: work 34 | double precision, dimension(:), allocatable :: y0 35 | 36 | n = size(y) 37 | lwork = 11*n + 8*n + 21 38 | liwork = n + 21 39 | allocate(work(lwork)) 40 | allocate(iwork(liwork)) 41 | allocate(y0(n)) 42 | allocate(rtol_(n)) 43 | allocate(atol_(n)) 44 | 45 | if (present(rtol)) then 46 | rtol_ = rtol 47 | else 48 | rtol_ = 1d-6 49 | end if 50 | if (present(atol)) then 51 | atol_ = atol 52 | else 53 | atol_ = 1d-8 54 | end if 55 | 56 | iout = 0 57 | itol = 0 58 | iwork = 0 59 | work = 0d0 60 | 61 | y0 = y 62 | if (present(solout)) then 63 | call dop853(n, fcn, t, y0, tend, rtol_, atol_,& 64 | itol, solout, iout, work, lwork, iwork,& 65 | liwork, rpar, ipar, idid) 66 | else 67 | call dop853(n, fcn, t, y0, tend, rtol_, atol_,& 68 | itol, soldummy, iout, work, lwork, iwork,& 69 | liwork, rpar, ipar, idid) 70 | end if 71 | y = y0 72 | 73 | if (present(stat)) stat = idid 74 | end subroutine integrate 75 | 76 | subroutine gravity(n, t, y, f, rpar, ipar) 77 | integer, intent(inout) :: n 78 | double precision, intent(inout) :: t 79 | double precision, dimension(n), intent(inout) :: y 80 | double precision, dimension(n), intent(inout) :: f 81 | double precision, dimension(:), intent(inout) :: rpar 82 | integer, dimension(:),intent(inout) :: ipar 83 | 84 | double precision :: r 85 | 86 | r = sqrt(y(1)**2 + y(2)**2 + y(3)**2) 87 | f(1) = y(4) 88 | f(2) = y(5) 89 | f(3) = y(6) 90 | 91 | f(4) = -rpar(1) * y(1) / r**3 92 | f(5) = -rpar(1) * y(2) / r**3 93 | f(6) = -rpar(1) * y(3) / r**3 94 | end subroutine gravity 95 | 96 | subroutine soldummy(nr, xold, x, y, n, con, icomp,& 97 | nd, rpar, ipar, irtrn, xout) 98 | integer, intent(inout) :: n 99 | integer, intent(inout) :: nr 100 | integer, intent(inout) :: nd 101 | integer, intent(inout) :: irtrn 102 | integer, dimension(:), intent(inout) :: ipar 103 | integer, dimension(nd), intent(inout) :: icomp 104 | double precision, intent(inout) :: xold 105 | double precision, intent(inout) :: x 106 | double precision, dimension(n), intent(inout) :: y 107 | double precision, dimension(8*nd), intent(inout) :: con 108 | double precision, dimension(:), intent(inout) :: rpar 109 | double precision, intent(inout) :: xout 110 | xout = 0d0 111 | end subroutine soldummy 112 | 113 | subroutine benchmark_dopri(times) 114 | integer, intent(in) :: times 115 | 116 | double precision, dimension(6) :: rv 117 | double precision, dimension(6) :: rv0 118 | double precision, dimension(6) :: el 119 | double precision, dimension(1) :: rpar 120 | integer, dimension(1) :: ipar 121 | double precision :: t 122 | double precision :: tend 123 | double precision, parameter :: mu = 3.986004418d5 124 | 125 | double precision :: current, rate 126 | integer(kind=8) :: start, finish, irate 127 | double precision :: total, best, worst 128 | integer :: i 129 | 130 | rv = [8.59072560d+02, -4.13720368d+03, 5.29556871d+03, 7.37289205d+00, 2.08223573d+00, 4.39999794d-01] 131 | rv0 = rv 132 | el = fromrv(rv(:3), rv(4:), mu) 133 | rpar(1) = mu 134 | ipar(1) = 0 135 | t = 0d0 136 | tend = period(el(1), mu) 137 | 138 | worst = -1d20 139 | best = 1d20 140 | total = 0d0 141 | call system_clock(count_rate=irate) 142 | rate = dble(irate) 143 | do i=1, times 144 | call system_clock(start) 145 | 146 | call integrate(gravity, rv, t, tend, rpar, ipar) 147 | 148 | call system_clock(finish) 149 | current = (finish - start)/rate 150 | rv = rv0 151 | t = 0d0 152 | if (current < best .and. current > 0) then 153 | best = current 154 | end if 155 | if (current > worst) then 156 | worst = current 157 | end if 158 | total = total + current 159 | end do 160 | print *, total/times, best, worst 161 | end subroutine benchmark_dopri 162 | 163 | end module fdopri 164 | -------------------------------------------------------------------------------- /fortran/src/kepler.f90: -------------------------------------------------------------------------------- 1 | module kepler 2 | 3 | use newton 4 | use elements, only: fromrv 5 | 6 | implicit none 7 | 8 | double precision, parameter :: pi = 3.1415926535897931d0 9 | 10 | type, extends(newtoncallback) :: keplercb 11 | double precision :: ecc 12 | double precision :: mean 13 | contains 14 | procedure :: func => keplereq 15 | procedure :: deriv => keplerderiv 16 | end type keplercb 17 | 18 | contains 19 | 20 | double precision function mean2ecc(mean, ecc) 21 | double precision, intent(in) :: mean 22 | double precision, intent(in) :: ecc 23 | 24 | type(keplercb) :: cb 25 | 26 | cb = keplercb(ecc, mean) 27 | mean2ecc = newtonsolver(cb, mean) 28 | end function mean2ecc 29 | 30 | double precision function keplereq(this, x) 31 | class(keplercb), intent(in) :: this 32 | double precision, intent(in) :: x 33 | keplereq = x - this%ecc * sin(x) - this%mean 34 | end function keplereq 35 | 36 | double precision function keplerderiv(this, x) 37 | class(keplercb), intent(in) :: this 38 | double precision, intent(in) :: x 39 | keplerderiv = 1 - this%ecc * cos(x) 40 | end function keplerderiv 41 | 42 | double precision function period(sma, mu) 43 | double precision, intent(in) :: sma 44 | double precision, intent(in) :: mu 45 | period = 2*pi*sqrt(sma**3/mu); 46 | end function period 47 | 48 | subroutine benchmark_kepler(times) 49 | integer, intent(in) :: times 50 | 51 | double precision, dimension(3) :: r 52 | double precision, dimension(3) :: v 53 | double precision, dimension(6) :: el 54 | double precision, parameter :: mu = 3.986004418d5 55 | double precision :: e 56 | 57 | double precision :: current, rate 58 | integer(kind=8) :: start, finish, irate 59 | double precision :: total, best, worst 60 | integer :: i 61 | 62 | r = [8.59072560d+02, -4.13720368d+03, 5.29556871d+03] 63 | v = [7.37289205d+00, 2.08223573d+00, 4.39999794d-01] 64 | el = fromrv(r, v, mu) 65 | 66 | worst = -1d20 67 | best = 1d20 68 | total = 0d0 69 | call system_clock(count_rate=irate) 70 | rate = dble(irate) 71 | do i=1, times 72 | call system_clock(start) 73 | 74 | e = mean2ecc(pi/2, el(2)) 75 | 76 | call system_clock(finish) 77 | current = (finish - start)/rate 78 | if (current < best .and. current > 0) then 79 | best = current 80 | end if 81 | if (current > worst) then 82 | worst = current 83 | end if 84 | total = total + current 85 | end do 86 | print *, total/times, best, worst 87 | end subroutine benchmark_kepler 88 | 89 | end module kepler 90 | -------------------------------------------------------------------------------- /fortran/src/lambert.f90: -------------------------------------------------------------------------------- 1 | module lambert 2 | 3 | implicit none 4 | 5 | double precision, parameter :: pi = 3.1415926535897931d0 6 | 7 | type lambertresult 8 | double precision, dimension(3) :: v0 9 | double precision, dimension(3) :: v 10 | end type lambertresult 11 | 12 | contains 13 | 14 | type(lambertresult) function lambertsolver(k, r0, r, tof, short, numiter, rtol) 15 | double precision, intent(in) :: k 16 | double precision, dimension(:), intent(in) :: r0 17 | double precision, dimension(:), intent(in) :: r 18 | double precision, intent(in) :: tof 19 | logical, intent(in), optional :: short 20 | integer, intent(in), optional :: numiter 21 | double precision, intent(in), optional :: rtol 22 | 23 | logical :: short_ 24 | integer :: numiter_ 25 | double precision :: rtol_ 26 | 27 | double precision :: norm_r0, norm_r, cos_dnu 28 | double precision :: a, psi, psi_low, psi_up 29 | double precision :: y, xi, tof_new, g, gdot 30 | integer :: t_m, counter 31 | double precision, dimension(3) :: f, v, v0 32 | 33 | short_ = .true. 34 | if (present(short)) short_ = short 35 | numiter_ = 35 36 | if (present(numiter)) numiter_ = numiter 37 | rtol_ = 1e-8 38 | if (present(rtol)) rtol_ = rtol 39 | 40 | if (short_) then 41 | t_m = 1 42 | else 43 | t_m = -1 44 | end if 45 | 46 | norm_r0 = norm2(r0) 47 | norm_r = norm2(r) 48 | cos_dnu = dot_product(r0, r) / (norm_r0 * norm_r) 49 | 50 | a = t_m * sqrt(norm_r * norm_r0 * (1 + cos_dnu)) 51 | 52 | if (a == 0d0) then 53 | write(*,*) "Cannot compute orbit, phase angle is 180 degrees" 54 | stop 1 55 | end if 56 | 57 | psi = 0d0 58 | psi_low = -4 * pi 59 | psi_up = 4 * pi 60 | 61 | counter = 0 62 | do while (counter < numiter_) 63 | y = norm_r0 + norm_r + a * (psi * c3(psi) - 1) / sqrt(c2(psi)) 64 | if (a > 0d0 .and. y < 0d0) then 65 | do while (y < 0d0) 66 | psi_low = psi 67 | psi = (0.8d0 * (1d0 / c3(psi)) * & 68 | (1d0 - (norm_r0 + norm_r) * sqrt(c2(psi)) / a)) 69 | y = norm_r0 + norm_r + a * (psi * c3(psi) - 1) / sqrt(c2(psi)) 70 | end do 71 | end if 72 | xi = sqrt(y / c2(psi)) 73 | tof_new = (xi**3 * c3(psi) + A * sqrt(y)) / sqrt(k) 74 | 75 | if (abs((tof_new - tof) / tof) < rtol_) then 76 | exit 77 | else 78 | counter = counter + 1 79 | if (tof_new <= tof) then 80 | psi_low = psi 81 | else 82 | psi_up = psi 83 | end if 84 | psi = (psi_up + psi_low) / 2 85 | end if 86 | end do 87 | 88 | if (counter > numiter_) then 89 | write(*,*) "Maximum number of iterations reached." 90 | stop 1 91 | end if 92 | 93 | f = 1 - y / norm_r0 94 | g = a * sqrt(y / k) 95 | gdot = 1 - y / norm_r 96 | 97 | v0 = (r - f * r0) / g 98 | v = (gdot * r - r0) / g 99 | lambertsolver = lambertresult(v0, v) 100 | end function lambertsolver 101 | 102 | double precision function c2(psi) 103 | double precision, intent(in) :: psi 104 | 105 | double precision :: eps 106 | double precision :: delta 107 | integer :: k 108 | 109 | eps = 1.0 110 | if (psi > eps) then 111 | c2 = (1 - cos(sqrt(psi))) / psi 112 | else if (psi < -eps) then 113 | c2 = (cosh(sqrt(-psi)) - 1) / (-psi) 114 | else 115 | c2 = 1d0 / 2d0 116 | delta = (-psi) / gamma(2d0 + 2d0 + 1d0) 117 | k = 1 118 | do while (c2 + delta /= c2) 119 | c2 = c2 + delta 120 | k = k + 1 121 | delta = (-psi)**k / gamma(2 * k + 2d0 + 1d0) 122 | end do 123 | end if 124 | end function c2 125 | 126 | double precision function c3(psi) 127 | double precision, intent(in) :: psi 128 | 129 | double precision :: eps 130 | double precision :: delta 131 | integer :: k 132 | 133 | eps = 1.0 134 | if (psi > eps) then 135 | c3 = (sqrt(psi) - sin(sqrt(psi))) / (psi * sqrt(psi)) 136 | else if (psi < -eps) then 137 | c3 = (sinh(sqrt(-psi)) - sqrt(-psi)) / (-psi * sqrt(-psi)) 138 | else 139 | c3 = 1d0 / 6d0 140 | delta = (-psi) / gamma(2d0 + 3d0 + 1d0) 141 | k = 1 142 | do while (c3 + delta /= c3) 143 | c3 = c3 + delta 144 | k = k + 1 145 | delta = (-psi) ** k / gamma(2 * k + 3d0 + 1d0) 146 | end do 147 | end if 148 | end function c3 149 | 150 | subroutine benchmark_lambert(times) 151 | integer, intent(in) :: times 152 | 153 | double precision, dimension(3) :: r 154 | double precision, dimension(3) :: r0 155 | double precision :: tof 156 | double precision, parameter :: mu = 3.986004418d5 157 | type(lambertresult) :: res 158 | 159 | double precision :: current, rate 160 | integer(kind=8) :: start, finish, irate 161 | double precision :: total, best, worst 162 | integer :: i 163 | 164 | r0 = [5000d0, 10000d0, 2100d0] 165 | r = [-14600d0, 2500d0, 7000d0] 166 | tof = 3600d0 167 | 168 | worst = -1d20 169 | best = 1d20 170 | total = 0d0 171 | call system_clock(count_rate=irate) 172 | rate = dble(irate) 173 | do i=1, times 174 | call system_clock(start) 175 | 176 | res = lambertsolver(mu, r0, r, tof) 177 | 178 | call system_clock(finish) 179 | current = (finish - start)/rate 180 | if (current < best .and. current > 0) then 181 | best = current 182 | end if 183 | if (current > worst) then 184 | worst = current 185 | end if 186 | total = total + current 187 | end do 188 | print *, total/times, best, worst 189 | end subroutine benchmark_lambert 190 | 191 | end module lambert 192 | -------------------------------------------------------------------------------- /fortran/src/main.f90: -------------------------------------------------------------------------------- 1 | program main 2 | 3 | use elements, only: benchmark_elements 4 | use kepler, only: benchmark_kepler 5 | use fdopri, only: benchmark_dopri 6 | use lambert, only: benchmark_lambert 7 | 8 | implicit none 9 | 10 | integer, parameter :: times = 100000 11 | 12 | call benchmark_elements(times) 13 | call benchmark_kepler(times) 14 | call benchmark_lambert(times) 15 | call benchmark_dopri(times) 16 | 17 | end program main 18 | -------------------------------------------------------------------------------- /fortran/src/newton.f90: -------------------------------------------------------------------------------- 1 | module newton 2 | 3 | implicit none 4 | 5 | type, abstract :: newtoncallback 6 | contains 7 | procedure(dpfunc), deferred :: func 8 | procedure(dpfunc), deferred :: deriv 9 | end type newtoncallback 10 | 11 | abstract interface 12 | function dpfunc(this, x) result(fx) 13 | import :: newtoncallback 14 | class(newtoncallback), intent(in) :: this 15 | double precision, intent(in) :: x 16 | double precision :: fx 17 | end function dpfunc 18 | end interface 19 | 20 | contains 21 | 22 | double precision function newtonsolver(cb, x0, maxiter, tol) 23 | class(newtoncallback), intent(in) :: cb 24 | double precision, intent(in) :: x0 25 | integer, intent(in), optional :: maxiter 26 | double precision, intent(in), optional :: tol 27 | 28 | integer :: maxiter_ 29 | double precision :: tol_ 30 | 31 | integer :: i 32 | double precision :: p 33 | double precision :: p0 34 | 35 | p0 = x0 36 | maxiter_ = 50 37 | if (present(maxiter)) maxiter_ = maxiter 38 | tol_ = 1d-8 39 | if (present(tol)) tol_ = tol 40 | 41 | do i = 1, maxiter_ 42 | p = p0 - cb%func(p0) / cb%deriv(p0) 43 | if (abs(p - p0) < tol_) then 44 | newtonsolver = p 45 | return 46 | end if 47 | p0 = p 48 | end do 49 | 50 | write(*,*) "Not converged." 51 | stop 1 52 | end function newtonsolver 53 | 54 | end module newton 55 | -------------------------------------------------------------------------------- /java/.gradle/2.11/taskArtifacts/cache.properties: -------------------------------------------------------------------------------- 1 | #Sun Mar 06 14:25:04 CET 2016 2 | -------------------------------------------------------------------------------- /java/.gradle/2.11/taskArtifacts/cache.properties.lock: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OpenAstrodynamics/benchmarks/0fb1012b3639a6d6c53d80cd00b43b72a67b8022/java/.gradle/2.11/taskArtifacts/cache.properties.lock -------------------------------------------------------------------------------- /java/.gradle/2.11/taskArtifacts/fileSnapshots.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OpenAstrodynamics/benchmarks/0fb1012b3639a6d6c53d80cd00b43b72a67b8022/java/.gradle/2.11/taskArtifacts/fileSnapshots.bin -------------------------------------------------------------------------------- /java/.gradle/2.11/taskArtifacts/taskArtifacts.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OpenAstrodynamics/benchmarks/0fb1012b3639a6d6c53d80cd00b43b72a67b8022/java/.gradle/2.11/taskArtifacts/taskArtifacts.bin -------------------------------------------------------------------------------- /java/.idea/compiler.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | -------------------------------------------------------------------------------- /java/.idea/copyright/profiles_settings.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | -------------------------------------------------------------------------------- /java/.idea/description.html: -------------------------------------------------------------------------------- 1 | Simple Java application that includes a class with main() method -------------------------------------------------------------------------------- /java/.idea/encodings.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /java/.idea/libraries/JNI.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | -------------------------------------------------------------------------------- /java/.idea/libraries/org_apache_commons_commons_math3_3_6.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | -------------------------------------------------------------------------------- /java/.idea/misc.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 47 | 48 | 49 | 50 | -------------------------------------------------------------------------------- /java/.idea/modules.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /java/.idea/project-template.xml: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /java/.idea/uiDesigner.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | -------------------------------------------------------------------------------- /java/java.iml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /java/native/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 3.3) 2 | 3 | add_subdirectory(../../lib/dopri ${CMAKE_BINARY_DIR}/dopri) 4 | 5 | #if(DEFINED ENV{JAVA_HOME}) 6 | set(JAVA_HOME $ENV{JAVA_HOME}) 7 | #else() 8 | # set(JAVA_HOME /Library/Java/JavaVirtualMachines/jdk1.8.0_74.jdk/Contents/Home/) 9 | #endif() 10 | 11 | include_directories(${CMAKE_SOURCE_DIR} 12 | ${JAVA_HOME}/include 13 | ${JAVA_HOME}/include/linux 14 | ${CMAKE_SOURCE_DIR}/../../lib/dopri) 15 | 16 | set(SRCS jdopri.c) 17 | 18 | add_library(jnilib SHARED ${SRCS}) 19 | target_link_libraries(jnilib dopri) 20 | -------------------------------------------------------------------------------- /java/native/com_helgeeichhorn_icatt_Dopri.h: -------------------------------------------------------------------------------- 1 | /* DO NOT EDIT THIS FILE - it is machine generated */ 2 | #include 3 | /* Header for class com_helgeeichhorn_icatt_Dopri */ 4 | 5 | #ifndef _Included_com_helgeeichhorn_icatt_Dopri 6 | #define _Included_com_helgeeichhorn_icatt_Dopri 7 | #ifdef __cplusplus 8 | extern "C" { 9 | #endif 10 | /* 11 | * Class: com_helgeeichhorn_icatt_Dopri 12 | * Method: jdop853 13 | * Signature: (Lcom/helgeeichhorn/icatt/Dopri/DopriInterface;ID[DD[D[DII[D[II)V 14 | */ 15 | JNIEXPORT void JNICALL Java_com_helgeeichhorn_icatt_Dopri_jdop853 16 | (JNIEnv *, jobject, jobject, jint, jdouble, jdoubleArray, jdouble, jdoubleArray, jdoubleArray, jint, jint, jdoubleArray, jintArray, jint); 17 | 18 | #ifdef __cplusplus 19 | } 20 | #endif 21 | #endif 22 | -------------------------------------------------------------------------------- /java/native/jdopri.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include "dopri.h" 5 | 6 | jobject g_DopriInterface; 7 | jmethodID g_FuncMethod; 8 | JNIEnv *g_env; 9 | 10 | void fcn(int *n, double *x, double *y, double *f, double *rpar, int *ipar){ 11 | int l = ipar[0]; 12 | jdoubleArray jrpar = (*g_env)->NewDoubleArray(g_env, l); 13 | (*g_env)->SetDoubleArrayRegion(g_env, jrpar, 0 , l, rpar); 14 | jdoubleArray jy = (*g_env)->NewDoubleArray(g_env, *n); 15 | (*g_env)->SetDoubleArrayRegion(g_env, jy, 0 , *n, y); 16 | 17 | jdoubleArray retval; 18 | retval = (*g_env)->CallObjectMethod(g_env, g_DopriInterface, g_FuncMethod, *x, jy, jrpar); 19 | jdouble *out = (*g_env)->GetDoubleArrayElements(g_env, retval, NULL); 20 | memcpy(f, out, *n*sizeof(double)); 21 | (*g_env)->ReleaseDoubleArrayElements(g_env, retval, out, 0); 22 | return; 23 | } 24 | 25 | void solout(int *nr, double *xold, double *x, double *y, int *n, double *con, 26 | int *icomp, int *nd, double *rpar, int *ipar, int *irtrn, double *xout){ 27 | return; 28 | } 29 | 30 | JNIEXPORT void JNICALL Java_com_helgeeichhorn_icatt_Dopri_jdop853 31 | (JNIEnv *env, jobject thisObj, jobject DopriInterface, jint n, jdouble x, jdoubleArray y, 32 | jdouble xend, jdoubleArray rtol, jdoubleArray atol, jint itol, jint iout, 33 | jdoubleArray rpar, jintArray ipar, jint idid) { 34 | jclass objClass = (*env)->GetObjectClass(env, DopriInterface); 35 | jmethodID FuncMethod = (*env)->GetMethodID(env, objClass, "func", "(D[D[D)[D"); 36 | if (FuncMethod == NULL) { 37 | printf("'func' method not found.\n"); 38 | return; 39 | } 40 | g_FuncMethod = FuncMethod; 41 | g_DopriInterface = DopriInterface; 42 | g_env = env; 43 | jdouble *cy = (*env)->GetDoubleArrayElements(env, y, NULL); 44 | jdouble *crpar = (*env)->GetDoubleArrayElements(env, rpar, NULL); 45 | jdouble *crtol = (*env)->GetDoubleArrayElements(env, rtol, NULL); 46 | jdouble *catol = (*env)->GetDoubleArrayElements(env, atol, NULL); 47 | jint *cipar = (*env)->GetIntArrayElements(env, ipar, NULL); 48 | int lwork = 11*n+8*n+21; 49 | int liwork = n + 21; 50 | double work[lwork]; 51 | memset(work, 0, sizeof(work)); 52 | int iwork[liwork]; 53 | memset(iwork, 0, sizeof(iwork)); 54 | c_dop853(&n, &fcn, &x, cy, &xend, crtol, catol, &itol, &solout, 55 | &iout, work, &lwork, iwork, &liwork, crpar, cipar, &idid); 56 | (*env)->SetDoubleArrayRegion(env, y, 0 , n, cy); 57 | jclass thisClass = (*env)->GetObjectClass(env, thisObj); 58 | jfieldID fid = (*env)->GetFieldID(env, thisClass, "y", "[D"); 59 | if (fid == NULL) { 60 | printf("Field not found.\n"); 61 | return; 62 | } 63 | (*env)->SetObjectField(env, thisObj, fid, y); 64 | return; 65 | } 66 | -------------------------------------------------------------------------------- /java/src/com/helgeeichhorn/icatt/Benchmark.java: -------------------------------------------------------------------------------- 1 | package com.helgeeichhorn.icatt; 2 | 3 | import org.apache.commons.math3.geometry.euclidean.threed.Vector3D; 4 | 5 | import java.util.Arrays; 6 | 7 | public class Benchmark { 8 | private static double mu = 3.986004418e5; 9 | private static double rv[] = { 10 | 8.59072560e+02, -4.13720368e+03, 5.29556871e+03, 11 | 7.37289205e+00, 2.08223573e+00, 4.39999794e-01}; 12 | public static Vector3D r = new Vector3D(8.59072560e+02, -4.13720368e+03, 5.29556871e+03); 13 | public static Vector3D v = new Vector3D(7.37289205e+00, 2.08223573e+00, 4.39999794e-01); 14 | public static void benchmarkElements(int times) { 15 | double worst = Double.NEGATIVE_INFINITY; 16 | double best = Double.POSITIVE_INFINITY; 17 | double all = 0; 18 | Long current; 19 | double seconds; 20 | long start; 21 | long end; 22 | ElementsFast.fromRv(r, v, mu); 23 | for (int i = 0; i < times; i++) { 24 | start = System.nanoTime(); 25 | ElementsFast.fromRv(r, v, mu); 26 | end = System.nanoTime(); 27 | current = end - start; 28 | seconds = current.doubleValue()/1e9; 29 | if (seconds < best) { 30 | best = seconds; 31 | } 32 | if (seconds > worst) { 33 | worst = seconds; 34 | } 35 | all += seconds; 36 | 37 | } 38 | double[] results = {all/times, best, worst}; 39 | System.out.println(Arrays.toString(results)); 40 | } 41 | public static void benchmarkKepler(int times) { 42 | double[] ele = Elements.fromRv(r, v, mu); 43 | double worst = Double.NEGATIVE_INFINITY; 44 | double best = Double.POSITIVE_INFINITY; 45 | double all = 0; 46 | Long current; 47 | double seconds; 48 | long start; 49 | long end ; 50 | Kepler.meanToEcc(Math.PI/2, ele[1]); 51 | for (int i = 0; i < times; i++) { 52 | start = System.nanoTime(); 53 | Kepler.meanToEcc(Math.PI/2, ele[1]); 54 | end = System.nanoTime(); 55 | current = end - start; 56 | seconds = current.doubleValue()/1e9; 57 | if (seconds < best) { 58 | best = seconds; 59 | } 60 | if (seconds > worst) { 61 | worst = seconds; 62 | } 63 | all += seconds; 64 | 65 | } 66 | double[] results = {all/times, best, worst}; 67 | System.out.println(Arrays.toString(results)); 68 | } 69 | public static void benchmarkKeplerFunctional(int times) { 70 | double[] ele = Elements.fromRv(r, v, mu); 71 | double worst = Double.NEGATIVE_INFINITY; 72 | double best = Double.POSITIVE_INFINITY; 73 | double all = 0; 74 | Long current; 75 | double seconds; 76 | long start; 77 | long end ; 78 | KeplerFunctional.meanToEcc(Math.PI/2, ele[1]); 79 | for (int i = 0; i < times; i++) { 80 | start = System.nanoTime(); 81 | KeplerFunctional.meanToEcc(Math.PI/2, ele[1]); 82 | end = System.nanoTime(); 83 | current = end - start; 84 | seconds = current.doubleValue()/1e9; 85 | if (seconds < best) { 86 | best = seconds; 87 | } 88 | if (seconds > worst) { 89 | worst = seconds; 90 | } 91 | all += seconds; 92 | 93 | } 94 | double[] results = {all/times, best, worst}; 95 | System.out.println(Arrays.toString(results)); 96 | } 97 | public static void benchmarkDopri(int times) { 98 | double[] ele = Elements.fromRv(r, v, mu); 99 | double period = Kepler.period(ele[0], mu); 100 | double worst = Double.NEGATIVE_INFINITY; 101 | double best = Double.POSITIVE_INFINITY; 102 | double all = 0; 103 | Long current; 104 | double seconds; 105 | long start; 106 | long end ; 107 | double rpar[] = {mu}; 108 | Dopri d = new Dopri(new Gravity(), 0, rv, rpar); 109 | d.integrate(period); 110 | for (int i = 0; i < times; i++) { 111 | start = System.nanoTime(); 112 | d = new Dopri(new Gravity(), 0, rv, rpar); 113 | d.integrate(period); 114 | end = System.nanoTime(); 115 | current = end - start; 116 | seconds = current.doubleValue()/1e9; 117 | if (seconds < best) { 118 | best = seconds; 119 | } 120 | if (seconds > worst) { 121 | worst = seconds; 122 | } 123 | all += seconds; 124 | 125 | } 126 | double[] results = {all/times, best, worst}; 127 | System.out.println(Arrays.toString(results)); 128 | } 129 | public static void benchmarkLambert(int times) { 130 | Vector3D rlam0 = new Vector3D(5000.0, 10000.0, 2100.0); 131 | Vector3D rlam = new Vector3D(-14600.0, 2500.0, 7000.0); 132 | double tof = 3600; 133 | double worst = Double.NEGATIVE_INFINITY; 134 | double best = Double.POSITIVE_INFINITY; 135 | double all = 0; 136 | Long current; 137 | double seconds; 138 | long start; 139 | long end ; 140 | LambertFast.solve(mu, rlam0, rlam, tof); 141 | for (int i = 0; i < times; i++) { 142 | start = System.nanoTime(); 143 | LambertFast.solve(mu, rlam0, rlam, tof); 144 | end = System.nanoTime(); 145 | current = end - start; 146 | seconds = current.doubleValue()/1e9; 147 | if (seconds < best) { 148 | best = seconds; 149 | } 150 | if (seconds > worst) { 151 | worst = seconds; 152 | } 153 | all += seconds; 154 | 155 | } 156 | double[] results = {all/times, best, worst}; 157 | System.out.println(Arrays.toString(results)); 158 | } 159 | } 160 | -------------------------------------------------------------------------------- /java/src/com/helgeeichhorn/icatt/Dopri.java: -------------------------------------------------------------------------------- 1 | package com.helgeeichhorn.icatt; 2 | 3 | import java.util.Arrays; 4 | 5 | public class Dopri { 6 | static { 7 | System.loadLibrary("jnilib"); 8 | } 9 | private DopriInterface dopri; 10 | private double x; 11 | private double[] y; 12 | private double[] rtol; 13 | private double[] atol; 14 | private double[] rpar; 15 | 16 | Dopri(DopriInterface f, double x0, double[] y0, 17 | double[] reltol, double[] abstol, double[] params) { 18 | dopri = f; 19 | x = x0; 20 | y = y0; 21 | rtol = reltol; 22 | atol = abstol; 23 | rpar = params; 24 | } 25 | 26 | Dopri(DopriInterface f, double x0, double[] y0, double[] params) { 27 | dopri = f; 28 | x = x0; 29 | y = y0; 30 | rtol = new double[1]; 31 | Arrays.fill(rtol, 1e-6); 32 | atol = new double[1]; 33 | Arrays.fill(atol, 1e-8); 34 | rpar = params; 35 | } 36 | 37 | public double[] integrate(double xend) { 38 | int n = this.y.length; 39 | int itol = 0; 40 | int iout = 0; 41 | int idid = 0; 42 | int[] ipar = {this.rpar.length}; 43 | jdop853(this.dopri, n, this.x, this.y, xend, this.rtol, this.atol, itol, iout, 44 | this.rpar, ipar, idid); 45 | return this.y; 46 | } 47 | 48 | public native void jdop853(DopriInterface dopri, int n, double x, double[] y, double xend, double[] rtol, 49 | double[] atol, int itol, int iout, double[] rpar, int[] ipar, int idid); 50 | 51 | 52 | public interface DopriInterface { 53 | double[] func(double x, double[] y, double[] params); 54 | } 55 | } 56 | -------------------------------------------------------------------------------- /java/src/com/helgeeichhorn/icatt/Elements.java: -------------------------------------------------------------------------------- 1 | package com.helgeeichhorn.icatt; 2 | 3 | import org.apache.commons.math3.geometry.euclidean.threed.Vector3D; 4 | 5 | public class Elements { 6 | public static double[] fromRv(Vector3D r, Vector3D v, double mu) { 7 | Vector3D h, k, n, e; 8 | double r_mag, v_mag2, h_mag, n_mag, xi; 9 | double[] ele; 10 | 11 | r_mag = r.getNorm(); 12 | v_mag2 = Math.pow(v.getNorm(), 2d); 13 | h = r.crossProduct(v); 14 | h_mag = h.getNorm(); 15 | k = new Vector3D(0,0,1d); 16 | n = k.crossProduct(h); 17 | n_mag = n.getNorm(); 18 | xi = v_mag2/2d - mu/r_mag; 19 | e = r.scalarMultiply(v_mag2 - mu/r_mag).subtract(r.dotProduct(v), v).scalarMultiply(1/mu); 20 | ele = new double[6]; 21 | ele[1] = e.getNorm(); 22 | if (ele[1] != 1d) { 23 | ele[0] = -mu/(2*xi); 24 | } else { 25 | ele[0] = Math.pow(h_mag,2)/mu; 26 | } 27 | ele[2] = Math.acos(h.getZ()/h_mag); 28 | ele[3] = Math.acos(n.getX()/n_mag); 29 | ele[4] = Math.acos(n.dotProduct(e)/(ele[1]*n_mag)); 30 | ele[5] = Math.acos(e.dotProduct(r)/(ele[1]*r_mag)); 31 | if (n.getY() < 0) { 32 | ele[3] = 2*Math.PI - ele[3]; 33 | } 34 | if (e.getZ() < 0) { 35 | ele[4] = 2*Math.PI - ele[4]; 36 | } 37 | if (r.dotProduct(v) < 0) { 38 | ele[5] = 2*Math.PI - ele[5]; 39 | } 40 | return ele; 41 | } 42 | } 43 | -------------------------------------------------------------------------------- /java/src/com/helgeeichhorn/icatt/ElementsFast.java: -------------------------------------------------------------------------------- 1 | package com.helgeeichhorn.icatt; 2 | 3 | import org.apache.commons.math3.geometry.euclidean.threed.Vector3D; 4 | import org.apache.commons.math3.util.FastMath; 5 | 6 | public class ElementsFast { 7 | public static double[] fromRv(Vector3D r, Vector3D v, double mu) { 8 | 9 | final double r_mag = r.getNorm(); 10 | final double v_mag2 = v.getNormSq(); 11 | final Vector3D h = r.crossProduct(v); 12 | final double h_mag2 = h.getNormSq(); 13 | final double h_mag = FastMath.sqrt(h_mag2); 14 | final Vector3D k = Vector3D.PLUS_K; 15 | final Vector3D n = k.crossProduct(h); 16 | final double n_mag = n.getNorm(); 17 | final double xi = v_mag2/2d - mu/r_mag; 18 | final Vector3D e = new Vector3D(v_mag2 / mu - 1/r_mag, r, -r.dotProduct(v) / mu, v); 19 | final double[] ele = new double[6]; 20 | ele[1] = e.getNorm(); 21 | if (ele[1] != 1d) { 22 | ele[0] = -mu/(2*xi); 23 | } else { 24 | ele[0] = h_mag2/mu; 25 | } 26 | ele[2] = FastMath.acos(h.getZ()/h_mag); 27 | ele[3] = FastMath.acos(n.getX()/n_mag); 28 | ele[4] = FastMath.acos(n.dotProduct(e)/(ele[1]*n_mag)); 29 | ele[5] = FastMath.acos(e.dotProduct(r)/(ele[1]*r_mag)); 30 | if (n.getY() < 0) { 31 | ele[3] = 2*Math.PI - ele[3]; 32 | } 33 | if (e.getZ() < 0) { 34 | ele[4] = 2*Math.PI - ele[4]; 35 | } 36 | if (r.dotProduct(v) < 0) { 37 | ele[5] = 2*Math.PI - ele[5]; 38 | } 39 | return ele; 40 | } 41 | } 42 | -------------------------------------------------------------------------------- /java/src/com/helgeeichhorn/icatt/Gravity.java: -------------------------------------------------------------------------------- 1 | package com.helgeeichhorn.icatt; 2 | 3 | public class Gravity implements Dopri.DopriInterface { 4 | public double[] func(double x, double[] y, double[] rpar) { 5 | double r = Math.sqrt(y[0]*y[0]+y[1]*y[1]+y[2]*y[2]); 6 | double[] f = new double[6]; 7 | f[0] = y[3]; 8 | f[1] = y[4]; 9 | f[2] = y[5]; 10 | f[3] = -rpar[0]*y[0]/Math.pow(r,3); 11 | f[4] = -rpar[0]*y[1]/Math.pow(r,3); 12 | f[5] = -rpar[0]*y[2]/Math.pow(r,3); 13 | return f; 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /java/src/com/helgeeichhorn/icatt/Kepler.java: -------------------------------------------------------------------------------- 1 | package com.helgeeichhorn.icatt; 2 | 3 | public class Kepler { 4 | public static double meanMotion(double period, double deltaT) { 5 | return 2*Math.PI/period*deltaT; 6 | } 7 | 8 | public static double period(double sma, double mu) { 9 | return 2*Math.PI*Math.sqrt(Math.pow(sma,3)/mu); 10 | } 11 | 12 | static class KeplerEquation implements Newton.NewtonInterface { 13 | private double ecc; 14 | private double M; 15 | public KeplerEquation(double meanAnomaly, double eccentricity) { 16 | M = meanAnomaly; 17 | ecc = eccentricity; 18 | } 19 | public double func(double E) { 20 | return E - this.ecc*Math.sin(E) - this.M; 21 | } 22 | public double deriv(double E) { 23 | return 1 - this.ecc*Math.cos(E); 24 | } 25 | } 26 | 27 | public static double meanToEcc(double M, double ecc) { 28 | KeplerEquation keplerEq = new KeplerEquation(M, ecc); 29 | return Newton.getRoot(M, keplerEq); 30 | } 31 | } 32 | -------------------------------------------------------------------------------- /java/src/com/helgeeichhorn/icatt/KeplerFunctional.java: -------------------------------------------------------------------------------- 1 | package com.helgeeichhorn.icatt; 2 | 3 | import java.util.function.Function; 4 | 5 | public class KeplerFunctional { 6 | public static double meanToEcc(double M, double ecc) { 7 | Function keplerEq = E -> E - ecc * Math.sin(E) - M; 8 | Function keplerDeriv = E -> 1 - ecc * Math.cos(E); 9 | return NewtonFunctional.getRoot(M, keplerEq, keplerDeriv); 10 | } 11 | } 12 | -------------------------------------------------------------------------------- /java/src/com/helgeeichhorn/icatt/Lambert.java: -------------------------------------------------------------------------------- 1 | package com.helgeeichhorn.icatt; 2 | 3 | import org.apache.commons.math3.geometry.euclidean.threed.Vector3D; 4 | import org.apache.commons.math3.special.Gamma; 5 | 6 | public class Lambert { 7 | public static final class LambertResult { 8 | public Vector3D v0; 9 | public Vector3D v; 10 | 11 | LambertResult(Vector3D v0, Vector3D v) { 12 | this.v0 = v0; 13 | this.v = v; 14 | } 15 | } 16 | public static LambertResult solve(double k, Vector3D r0, Vector3D r, double tof) { 17 | boolean shortway = true; 18 | int numiter = 35; 19 | double rtol = 1e-8; 20 | return solve(k, r0, r, tof, shortway, numiter, rtol); 21 | } 22 | public static LambertResult solve(double k, Vector3D r0, Vector3D r, double tof, 23 | boolean shortway, int numiter, double rtol) { 24 | int tm; 25 | if (shortway) { 26 | tm = 1; 27 | } else { 28 | tm = -1; 29 | } 30 | double normR0 = r0.getNorm(); 31 | double normR = r.getNorm(); 32 | double cosDnu = r0.dotProduct(r) / (normR0*normR); 33 | double A = tm * Math.sqrt(normR * normR0 * (1 + cosDnu)); 34 | 35 | if (A == 0.0) { 36 | throw new RuntimeException("Cannot compute orbit, phase angle is 180 degrees"); 37 | } 38 | double psi = 0.0; 39 | double psiLow = -4*Math.PI; 40 | double psiUp = 4*Math.PI; 41 | 42 | double y = 0; 43 | int count = 0; 44 | while (count < numiter) { 45 | y = normR0 + normR + A * (psi * c3(psi) - 1) / Math.sqrt(c2(psi)); 46 | if (A > 0 & y < 0) { 47 | while (y < 0) { 48 | psiLow = psi; 49 | psi = (0.8 * (1.0 / c3(psi)) * 50 | (1.0 - (normR0 + normR) * Math.sqrt(c2(psi)) / A)); 51 | y = normR + normR0 + A * (psi * c3(psi) - 1) / Math.sqrt(c2(psi)); 52 | } 53 | } 54 | double xi = Math.sqrt(y / c2(psi)); 55 | double tofNew = (Math.pow(xi, 3) * c3(psi) + A * Math.sqrt(y)) / Math.sqrt(k); 56 | 57 | if (Math.abs((tofNew - tof) / tof) < rtol) { 58 | break; 59 | } else { 60 | count += 1; 61 | if (tofNew <= tof) { 62 | psiLow = psi; 63 | } else { 64 | psiUp = psi; 65 | } 66 | psi = (psiUp + psiLow) / 2; 67 | } 68 | } 69 | if (count >= numiter) { 70 | throw new RuntimeException("Maximum number of iterations reached."); 71 | } 72 | double f = 1 - y / normR0; 73 | double g = A * Math.sqrt(y / k); 74 | double gdot = 1 - y / normR; 75 | Vector3D v0 = r.subtract(r0.scalarMultiply(f)).scalarMultiply(1/g); 76 | Vector3D v = r.scalarMultiply(gdot).subtract(r0).scalarMultiply(1/g); 77 | return new LambertResult(v0, v); 78 | } 79 | 80 | public static double c2(double psi) { 81 | double res; 82 | double eps = 1.0; 83 | if (psi > eps) { 84 | res = (1 - Math.cos(Math.sqrt(psi))) / psi; 85 | } else if (psi < -eps) { 86 | res = (Math.cosh(Math.sqrt(-psi)) - 1) / -psi; 87 | } else { 88 | res = 1.0 / 2.0; 89 | double delta = (-psi) / Gamma.gamma(2+2+1); 90 | int k = 1; 91 | while (res + delta != res) { 92 | res += delta; 93 | k += 1; 94 | delta = Math.pow(-psi, k) / Gamma.gamma(2 * k + 2 + 1); 95 | } 96 | } 97 | return res; 98 | } 99 | 100 | public static double c3(double psi) { 101 | double res; 102 | double eps = 1.0; 103 | if (psi > eps) { 104 | res = (Math.sqrt(psi) - Math.sin(Math.sqrt(psi))) / (psi * Math.sqrt(psi)); 105 | } else if (psi < -eps) { 106 | res = (Math.sinh(Math.sqrt(-psi)) - Math.sqrt(-psi)) / (-psi * Math.sqrt(-psi)); 107 | } else { 108 | res = 1.0/6.0; 109 | double delta = (-psi) / Gamma.gamma(2 + 3 + 1); 110 | int k = 1; 111 | while (res + delta != res) { 112 | res += delta; 113 | k += 1; 114 | delta = Math.pow(-psi, k) / Gamma.gamma(2 * k + 3 + 1); 115 | } 116 | } 117 | return res; 118 | } 119 | } 120 | -------------------------------------------------------------------------------- /java/src/com/helgeeichhorn/icatt/LambertFast.java: -------------------------------------------------------------------------------- 1 | package com.helgeeichhorn.icatt; 2 | 3 | import org.apache.commons.math3.geometry.euclidean.threed.Vector3D; 4 | import org.apache.commons.math3.special.Gamma; 5 | import org.apache.commons.math3.util.FastMath; 6 | 7 | public class LambertFast { 8 | public static final class LambertResult { 9 | public Vector3D v0; 10 | public Vector3D v; 11 | 12 | LambertResult(Vector3D v0, Vector3D v) { 13 | this.v0 = v0; 14 | this.v = v; 15 | } 16 | } 17 | public static LambertResult solve(double k, Vector3D r0, Vector3D r, double tof) { 18 | boolean shortway = true; 19 | int numiter = 35; 20 | double rtol = 1e-8; 21 | return solve(k, r0, r, tof, shortway, numiter, rtol); 22 | } 23 | public static LambertResult solve(double k, Vector3D r0, Vector3D r, double tof, 24 | boolean shortway, int numiter, double rtol) { 25 | int tm; 26 | if (shortway) { 27 | tm = 1; 28 | } else { 29 | tm = -1; 30 | } 31 | double normR0 = r0.getNorm(); 32 | double normR = r.getNorm(); 33 | double cosDnu = r0.dotProduct(r) / (normR0*normR); 34 | double A = tm * FastMath.sqrt(normR * normR0 * (1 + cosDnu)); 35 | 36 | if (A == 0.0) { 37 | throw new RuntimeException("Cannot compute orbit, phase angle is 180 degrees"); 38 | } 39 | double psi = 0.0; 40 | double psiLow = -4*FastMath.PI; 41 | double psiUp = 4*FastMath.PI; 42 | 43 | double y = 0; 44 | int count = 0; 45 | while (count < numiter) { 46 | y = normR0 + normR + A * (psi * c3(psi) - 1) / FastMath.sqrt(c2(psi)); 47 | if (A > 0 & y < 0) { 48 | while (y < 0) { 49 | psiLow = psi; 50 | psi = (0.8 * (1.0 / c3(psi)) * 51 | (1.0 - (normR0 + normR) * FastMath.sqrt(c2(psi)) / A)); 52 | y = normR + normR0 + A * (psi * c3(psi) - 1) / FastMath.sqrt(c2(psi)); 53 | } 54 | } 55 | double sss = y / c2(psi); 56 | double xi = FastMath.sqrt(sss); 57 | double tofNew = (sss * xi * c3(psi) + A * FastMath.sqrt(y)) / FastMath.sqrt(k); 58 | 59 | if (FastMath.abs((tofNew - tof) / tof) < rtol) { 60 | break; 61 | } else { 62 | count += 1; 63 | if (tofNew <= tof) { 64 | psiLow = psi; 65 | } else { 66 | psiUp = psi; 67 | } 68 | psi = (psiUp + psiLow) / 2; 69 | } 70 | } 71 | if (count >= numiter) { 72 | throw new RuntimeException("Maximum number of iterations reached."); 73 | } 74 | double f = 1 - y / normR0; 75 | double g = A * FastMath.sqrt(y / k); 76 | double gdot = 1 - y / normR; 77 | Vector3D v0 = new Vector3D(1/g, r, -f/g, r0); 78 | Vector3D v = new Vector3D(gdot/g, r, -1/g, r0); 79 | return new LambertResult(v0, v); 80 | } 81 | 82 | public static double c2(double psi) { 83 | double res; 84 | double eps = 1.0; 85 | if (psi > eps) { 86 | res = (1 - FastMath.cos(FastMath.sqrt(psi))) / psi; 87 | } else if (psi < -eps) { 88 | res = (FastMath.cosh(FastMath.sqrt(-psi)) - 1) / -psi; 89 | } else { 90 | res = 1.0 / 2.0; 91 | double delta = (-psi) / Gamma.gamma(2+2+1); 92 | int k = 1; 93 | double mpsik = -psi; 94 | while (res + delta != res) { 95 | res += delta; 96 | k += 1; 97 | mpsik *= -psi; 98 | delta = mpsik / Gamma.gamma(2 * k + 2 + 1); 99 | } 100 | } 101 | return res; 102 | } 103 | 104 | public static double c3(double psi) { 105 | double res; 106 | double eps = 1.0; 107 | if (psi > eps) { 108 | res = (FastMath.sqrt(psi) - FastMath.sin(FastMath.sqrt(psi))) / (psi * FastMath.sqrt(psi)); 109 | } else if (psi < -eps) { 110 | res = (FastMath.sinh(FastMath.sqrt(-psi)) - FastMath.sqrt(-psi)) / (-psi * FastMath.sqrt(-psi)); 111 | } else { 112 | res = 1.0/6.0; 113 | double delta = (-psi) / Gamma.gamma(2 + 3 + 1); 114 | int k = 1; 115 | double mpsik = -psi; 116 | while (res + delta != res) { 117 | res += delta; 118 | k += 1; 119 | mpsik *= -psi; 120 | delta = mpsik / Gamma.gamma(2 * k + 3 + 1); 121 | } 122 | } 123 | return res; 124 | } 125 | } 126 | -------------------------------------------------------------------------------- /java/src/com/helgeeichhorn/icatt/Main.java: -------------------------------------------------------------------------------- 1 | package com.helgeeichhorn.icatt; 2 | 3 | public class Main { 4 | public static void main(String[] args) { 5 | int n = 100000; 6 | Benchmark b = new Benchmark(); 7 | b.benchmarkElements(n); 8 | b.benchmarkKepler(n); 9 | b.benchmarkKeplerFunctional(n); 10 | b.benchmarkLambert(n); 11 | b.benchmarkDopri(n); 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /java/src/com/helgeeichhorn/icatt/Newton.java: -------------------------------------------------------------------------------- 1 | package com.helgeeichhorn.icatt; 2 | 3 | public class Newton { 4 | public interface NewtonInterface { 5 | double func(double x); 6 | double deriv(double x); 7 | } 8 | 9 | public static double getRoot(double p0, NewtonInterface newton, int maxiter, double tol) { 10 | Double result = Double.NaN; 11 | for (int i=0; i < maxiter; i++) { 12 | double p = p0 - newton.func(p0) / newton.deriv(p0); 13 | if (Math.abs(p - p0) < tol) { 14 | result = p; 15 | break; 16 | } 17 | p0 = p; 18 | } 19 | if (result.isNaN()) { 20 | throw new RuntimeException("Not converged."); 21 | } else { 22 | return result; 23 | } 24 | } 25 | 26 | public static double getRoot(double x0, NewtonInterface newton) { 27 | return getRoot(x0, newton, 50, 1e-8); 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /java/src/com/helgeeichhorn/icatt/NewtonFunctional.java: -------------------------------------------------------------------------------- 1 | package com.helgeeichhorn.icatt; 2 | 3 | import java.util.function.Function; 4 | 5 | public class NewtonFunctional { 6 | public static double getRoot( 7 | double p0, Function func, Function deriv, int maxiter, double tol) { 8 | Double result = Double.NaN; 9 | for (int i=0; i < maxiter; i++) { 10 | double p = p0 - func.apply(p0) / deriv.apply(p0); 11 | if (Math.abs(p - p0) < tol) { 12 | result = p; 13 | break; 14 | } 15 | p0 = p; 16 | } 17 | if (result.isNaN()) { 18 | throw new RuntimeException("Not converged."); 19 | } else { 20 | return result; 21 | } 22 | } 23 | 24 | public static double getRoot(double x0, Function func, Function deriv) { 25 | return getRoot(x0, func, deriv, 50, 1e-8); 26 | } 27 | 28 | } 29 | -------------------------------------------------------------------------------- /julia/ICATT.jl: -------------------------------------------------------------------------------- 1 | module ICATT 2 | 3 | include("elements.jl") 4 | include("kepler.jl") 5 | include("lambert.jl") 6 | include("dopri.jl") 7 | 8 | end 9 | -------------------------------------------------------------------------------- /julia/dopri.jl: -------------------------------------------------------------------------------- 1 | export benchmark_dopri 2 | 3 | function benchmark_dopri(times::Int) 4 | y = [8.59072560e+02, -4.13720368e+03, 5.29556871e+03, 7.37289205e+00, 2.08223573e+00, 4.39999794e-01] 5 | y0 = copy(y) 6 | mu = 3.986004418e5 7 | el = elements(y[1:3], y[4:6], mu) 8 | rpar = [mu] 9 | x = 0.0 10 | xend = period(el[1], mu) 11 | worst = -Inf 12 | best = Inf 13 | total = 0.0 14 | dopri!(x, y, xend, rpar) 15 | for i = 1:times 16 | gc_enable(false) 17 | t = @elapsed dopri!(x, y, xend, rpar) 18 | gc_enable(true) 19 | y = copy(y0) 20 | x = 0.0 21 | if t > worst 22 | worst = t 23 | end 24 | if t < best 25 | best = t 26 | end 27 | total += t 28 | end 29 | println("[$(total/times),$best,$worst]") 30 | end 31 | 32 | function gravity!(_n::Ptr{Cint}, _x::Ptr{Cdouble}, _y::Ptr{Cdouble}, _f::Ptr{Cdouble}, 33 | _rpar::Ptr{Cdouble}, _ipar::Ptr{Cint}) 34 | n = unsafe_load(_n, 1) 35 | t = unsafe_load(_x, 1) 36 | rpar = unsafe_load(_rpar, 1) 37 | y = unsafe_wrap(Array, _y, n, false) 38 | f = unsafe_wrap(Array, _f, n, false) 39 | 40 | r = sqrt(y[1]*y[1]+y[2]*y[2]+y[3]*y[3]) 41 | r3 = r*r*r 42 | f[1] = y[4] 43 | f[2] = y[5] 44 | f[3] = y[6] 45 | f[4] = -rpar[1] * y[1] / r3 46 | f[5] = -rpar[1] * y[2] / r3 47 | f[6] = -rpar[1] * y[3] / r3 48 | return nothing 49 | end 50 | 51 | function _solout(_nr::Ptr{Cint}, _xold::Ptr{Cdouble}, _x::Ptr{Cdouble}, 52 | _y::Ptr{Cdouble}, _n::Ptr{Cint}, _con::Ptr{Cdouble}, _icomp::Ptr{Cint}, 53 | _nd::Ptr{Cint}, _rpar::Ptr{Cdouble}, _ipar::Ptr{Cint}, _irtrn::Ptr{Cint}, 54 | _xout::Ptr{Cdouble}) 55 | return nothing 56 | end 57 | 58 | cfcn = cfunction(gravity!, Void, (Ptr{Cint}, Ptr{Cdouble}, Ptr{Cdouble}, Ptr{Cdouble}, Ptr{Cdouble}, Ptr{Cint})) 59 | csolout = cfunction(_solout, Void, (Ptr{Cint}, Ptr{Cdouble}, Ptr{Cdouble}, 60 | Ptr{Cdouble}, Ptr{Cint}, Ptr{Cdouble}, Ptr{Cint}, 61 | Ptr{Cint}, Ptr{Cdouble}, Ptr{Cint}, Ptr{Cint}, 62 | Ptr{Cdouble})) 63 | 64 | function dopri!(x::Float64, y::Vector{Float64}, xend::Float64, 65 | rpar::Vector{Float64}=Float64[], reltol::Float64=1e-6, abstol::Float64=1e-8) 66 | n = length(y) 67 | lwork = 11*n + 8*n + 21 68 | liwork = n + 21 69 | work = zeros(Cdouble, lwork) 70 | iwork = zeros(Cint, liwork) 71 | ipar = Cint[] 72 | iout = 0 73 | idid = 0 74 | itol = 0 75 | rtol = collect(reltol) 76 | atol = collect(abstol) 77 | ccall((:c_dop853, :libdopri), Void, (Ptr{Cint}, Ptr{Void}, Ptr{Cdouble}, 78 | Ptr{Cdouble}, Ptr{Cdouble}, Ptr{Cdouble}, Ptr{Cdouble}, 79 | Ptr{Cint}, Ptr{Void}, Ptr{Cint}, Ptr{Cdouble}, 80 | Ptr{Cint}, Ptr{Cint}, Ptr{Cint}, Ptr{Cdouble}, 81 | Ptr{Cint}, Ptr{Cint}), 82 | &n, cfcn, &x, y, &xend, rtol, atol, &itol, csolout, &iout, 83 | work, &lwork, iwork, &liwork, rpar, ipar, &idid) 84 | end 85 | -------------------------------------------------------------------------------- /julia/elements.jl: -------------------------------------------------------------------------------- 1 | export elements, benchmark_elements 2 | 3 | function benchmark_elements(times::Int) 4 | r = [8.59072560e+02, -4.13720368e+03, 5.29556871e+03] 5 | v = [7.37289205e+00, 2.08223573e+00, 4.39999794e-01] 6 | mu = 3.986004418e5 7 | worst = -Inf 8 | best = Inf 9 | total = 0.0 10 | elements(r, v, mu) 11 | for i = 1:times 12 | gc_enable(false) 13 | t = @elapsed elements(r, v, mu) 14 | gc_enable(true) 15 | if t > worst 16 | worst = t 17 | end 18 | if t < best 19 | best = t 20 | end 21 | total += t 22 | end 23 | println("[$(total/times),$best,$worst]") 24 | end 25 | 26 | function elements(r::AbstractArray, v::AbstractArray, mu::Float64) 27 | rm = norm(r) 28 | vm = norm(v) 29 | h = cross(r, v) 30 | hm = norm(h) 31 | k = [0.0, 0.0, 1.0] 32 | n = cross(k, h) 33 | nm = norm(n) 34 | xi = vm^2/2 - mu/rm 35 | ec = ((vm^2 - mu/rm)*r - v*dot(r, v))/mu 36 | ecc = norm(ec) 37 | if ecc != 1 38 | sma = -mu/(2*xi) 39 | else 40 | sma = hm^2/mu 41 | end 42 | inc = acos(h[3]/hm) 43 | node = acos(n[1]/nm) 44 | peri = acos(dot(n, ec)/(ecc*nm)) 45 | ano = acos(dot(ec, r)/(ecc*rm)) 46 | if n[2] < 0 47 | node = 2*pi - node 48 | end 49 | if ec[3] < 0 50 | peri = 2*pi - peri 51 | end 52 | if dot(r, v) < 0 53 | ano = 2*pi - ano 54 | end 55 | return sma, ecc, inc, node, peri, ano 56 | end 57 | -------------------------------------------------------------------------------- /julia/kepler.jl: -------------------------------------------------------------------------------- 1 | export meantoecc, benchmark_kepler 2 | 3 | function benchmark_kepler(times::Int) 4 | r = [8.59072560e+02, -4.13720368e+03, 5.29556871e+03] 5 | v = [7.37289205e+00, 2.08223573e+00, 4.39999794e-01] 6 | mu = 3.986004418e5 7 | el = elements(r, v, mu) 8 | worst = -Inf 9 | best = Inf 10 | total = 0.0 11 | meantoecc(pi/2, el[2]) 12 | for i = 1:times 13 | gc_enable(false) 14 | t = @elapsed meantoecc(pi/2, el[2]) 15 | gc_enable(true) 16 | if t > worst 17 | worst = t 18 | end 19 | if t < best 20 | best = t 21 | end 22 | total += t 23 | end 24 | println("[$(total/times),$best,$worst]") 25 | end 26 | 27 | function period(a::Float64, mu::Float64) 28 | return 2pi*sqrt(a^3/mu) 29 | end 30 | 31 | function newton(x0::Float64, func::Function, derivative::Function, maxiter::Int=50, tol::Float64=sqrt(eps())) 32 | p0 = x0 33 | for i = 1:maxiter 34 | p = p0 - func(p0)/derivative(p0) 35 | if abs(p - p0) < tol 36 | return p 37 | end 38 | p0 = p 39 | end 40 | error("Not converged.") 41 | end 42 | 43 | function meantoecc(M::Float64, ecc::Float64) 44 | kepler(E::Float64) = E - ecc*sin(E) - M 45 | kepler_der(E::Float64) = 1 - ecc*cos(E) 46 | return newton(M, kepler, kepler_der) 47 | end 48 | -------------------------------------------------------------------------------- /julia/lambert.jl: -------------------------------------------------------------------------------- 1 | export lambert, benchmark_lambert 2 | 3 | function benchmark_lambert(times::Int) 4 | r0 = [5000.0, 10000.0, 2100.0] 5 | r = [-14600.0, 2500.0, 7000.0] 6 | tof = 3600.0 7 | mu = 3.986004418e5 8 | worst = -Inf 9 | best = Inf 10 | total = 0.0 11 | lambert(mu, r0, r, tof) 12 | for i = 1:times 13 | gc_enable(false) 14 | t = @elapsed lambert(mu, r0, r, tof) 15 | gc_enable(true) 16 | if t > worst 17 | worst = t 18 | end 19 | if t < best 20 | best = t 21 | end 22 | total += t 23 | end 24 | println("[$(total/times),$best,$worst]") 25 | end 26 | 27 | function lambert(k::Float64, r0::Vector{Float64}, r::Vector{Float64}, tof::Float64, short::Bool=true, numiter::Int=35, rtol::Float64=1e-8) 28 | if short 29 | t_m = 1 30 | else 31 | t_m = -1 32 | end 33 | 34 | norm_r0 = norm(r0) 35 | norm_r = norm(r) 36 | cos_dnu = dot(r0, r) / (norm_r0 * norm_r) 37 | 38 | A = t_m * sqrt(norm_r * norm_r0 * (1 + cos_dnu)) 39 | 40 | if A == 0.0 41 | error("Cannot compute orbit, phase angle is 180 degrees") 42 | end 43 | 44 | psi = 0.0 45 | psi_low = -4*pi 46 | psi_up = 4*pi 47 | 48 | count = 0 49 | converged = false 50 | y = 0.0 51 | while count < numiter 52 | y = norm_r0 + norm_r + A * (psi * c3(psi) - 1) / sqrt(c2(psi)) 53 | if A > 0.0 && y < 0.0 54 | while y < 0.0 55 | psi_low = psi 56 | psi = (0.8 * (1.0 / c3(psi)) * 57 | (1.0 - (norm_r0 + norm_r) * sqrt(c2(psi)) / A)) 58 | y = norm_r0 + norm_r + A * (psi * c3(psi) - 1) / sqrt(c2(psi)) 59 | end 60 | end 61 | xi = sqrt(y / c2(psi)) 62 | tof_new = (xi^3 * c3(psi) + A * sqrt(y)) / sqrt(k) 63 | 64 | if abs((tof_new - tof) / tof) < rtol 65 | converged = true 66 | break 67 | else 68 | count += 1 69 | if tof_new <= tof 70 | psi_low = psi 71 | else 72 | psi_up = psi 73 | end 74 | psi = (psi_up + psi_low) / 2 75 | end 76 | end 77 | 78 | if !converged 79 | error("Maximum number of iterations reached") 80 | end 81 | 82 | f = 1 - y / norm_r0 83 | g = A * sqrt(y / k) 84 | gdot = 1 - y / norm_r 85 | 86 | v0 = (r - f * r0) / g 87 | v = (gdot * r - r0) / g 88 | return v0, v 89 | end 90 | 91 | function c2(psi::Float64) 92 | eps = 1.0 93 | if psi > eps 94 | res = (1 - cos(sqrt(psi))) / psi 95 | elseif psi < -eps 96 | res = (cosh(sqrt(-psi)) - 1) / (-psi) 97 | else 98 | res = 1.0 / 2.0 99 | delta = (-psi) / gamma(2 + 2 + 1) 100 | k = 1 101 | while res + delta != res 102 | res += delta 103 | k += 1 104 | delta = (-psi)^k / gamma(2*k + 2 + 1) 105 | end 106 | end 107 | return res 108 | end 109 | 110 | function c3(psi::Float64) 111 | eps = 1.0 112 | if psi > eps 113 | res = (sqrt(psi) - sin(sqrt(psi))) / (psi * sqrt(psi)) 114 | elseif psi < -eps 115 | res = (sinh(sqrt(-psi)) - sqrt(-psi)) / (-psi * sqrt(-psi)) 116 | else 117 | res = 1.0 / 6.0 118 | delta = (-psi) / gamma(2 + 3 + 1) 119 | k = 1 120 | while res + delta != res 121 | res += delta 122 | k += 1 123 | delta = (-psi)^k / gamma(2*k + 3 + 1) 124 | end 125 | end 126 | return res 127 | end 128 | -------------------------------------------------------------------------------- /julia/main.jl: -------------------------------------------------------------------------------- 1 | # Account for non-standard library and code locations 2 | push!(LOAD_PATH, abspath(splitdir(@__FILE__)[1])) 3 | push!(Libdl.DL_LOAD_PATH, abspath(joinpath(splitdir(@__FILE__)[1], "..", "lib", "dopri", "build"))) 4 | 5 | using ICATT 6 | 7 | n = 100000 8 | benchmark_elements(n) 9 | benchmark_kepler(n) 10 | benchmark_lambert(n) 11 | benchmark_dopri(n) 12 | -------------------------------------------------------------------------------- /lib/dopri/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 3.3) 2 | 3 | project(dopri Fortran) 4 | enable_language(Fortran) 5 | 6 | set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -cpp -O3") 7 | 8 | set(SOURCE_FILES 9 | dopri.f90 10 | dop853.f 11 | dopri5.f) 12 | 13 | add_library(dopri SHARED ${SOURCE_FILES}) 14 | add_library(dopri_static STATIC ${SOURCE_FILES}) 15 | -------------------------------------------------------------------------------- /lib/dopri/dopri.f90: -------------------------------------------------------------------------------- 1 | module dopri 2 | 3 | use iso_c_binding, only: c_double, c_int, c_funptr, c_f_procpointer 4 | 5 | implicit none 6 | 7 | abstract interface 8 | subroutine dopfcn(n, x, y, f, rpar, ipar) 9 | integer, intent(inout) :: n 10 | integer, dimension(:),intent(inout) :: ipar 11 | double precision, intent(inout) :: x 12 | double precision, dimension(n), intent(inout) :: y 13 | double precision, dimension(:), intent(inout) :: rpar 14 | double precision, dimension(n), intent(inout) :: f 15 | end subroutine dopfcn 16 | subroutine dopsolout(nr, xold, x, y, n, con, icomp,& 17 | nd, rpar, ipar, irtrn, xout) 18 | integer, intent(inout) :: n 19 | integer, intent(inout) :: nr 20 | integer, intent(inout) :: nd 21 | integer, intent(inout) :: irtrn 22 | integer, dimension(:), intent(inout) :: ipar 23 | integer, dimension(nd), intent(inout) :: icomp 24 | double precision, intent(inout) :: xold 25 | double precision, intent(inout) :: x 26 | double precision, dimension(n), intent(inout) :: y 27 | double precision, dimension(8*nd), intent(inout) :: con 28 | double precision, dimension(:), intent(inout) :: rpar 29 | double precision, intent(inout) :: xout 30 | end subroutine dopsolout 31 | end interface 32 | 33 | interface 34 | subroutine dop853(n, fcn, x, y, xend, rtol, atol,& 35 | itol, solout, iout, work, lwork, iwork,& 36 | liwork, rpar, ipar, idid) 37 | interface 38 | subroutine fcn(n, x, y, f, rpar, ipar) 39 | integer, intent(inout) :: n 40 | integer, dimension(:),intent(inout) :: ipar 41 | double precision, intent(inout) :: x 42 | double precision, dimension(n), intent(inout) :: y 43 | double precision, dimension(:), intent(inout) :: rpar 44 | double precision, dimension(n), intent(inout) :: f 45 | end subroutine fcn 46 | subroutine solout(nr, xold, x, y, n, con, icomp,& 47 | nd, rpar, ipar, irtrn, xout) 48 | integer, intent(inout) :: n 49 | integer, intent(inout) :: nr 50 | integer, intent(inout) :: nd 51 | integer, intent(inout) :: irtrn 52 | integer, dimension(:), intent(inout) :: ipar 53 | integer, dimension(nd), intent(inout) :: icomp 54 | double precision, intent(inout) :: xold 55 | double precision, intent(inout) :: x 56 | double precision, dimension(n), intent(inout) :: y 57 | double precision, dimension(8*nd), intent(inout) :: con 58 | double precision, dimension(:), intent(inout) :: rpar 59 | double precision, intent(inout) :: xout 60 | end subroutine solout 61 | end interface 62 | integer, intent(inout) :: n 63 | integer, intent(inout) :: itol 64 | integer, intent(inout) :: iout 65 | integer, intent(inout) :: lwork 66 | integer, intent(inout) :: liwork 67 | integer, dimension(:),intent(inout) :: ipar 68 | integer, intent(inout) :: idid 69 | double precision, intent(inout) :: xend 70 | double precision, dimension(n), intent(inout) :: rtol 71 | double precision, dimension(n), intent(inout) :: atol 72 | double precision, dimension(:), intent(inout) :: rpar 73 | double precision, dimension(lwork), intent(inout) :: work 74 | integer, dimension(liwork), intent(inout) :: iwork 75 | double precision, intent(inout) :: x 76 | double precision, dimension(n), intent(inout) :: y 77 | end subroutine dop853 78 | 79 | double precision function contd8(ii, x, con, icomp, nd) 80 | integer, intent(inout) :: ii 81 | double precision, intent(inout) :: x 82 | double precision, dimension(8*nd), intent(inout) :: con 83 | integer, dimension(nd), intent(inout) :: icomp 84 | integer, intent(inout) :: nd 85 | end function contd8 86 | 87 | subroutine dopri5(n, fcn, x, y, xend, rtol, atol,& 88 | itol, solout, iout, work, lwork, iwork,& 89 | liwork, rpar, ipar, idid) 90 | interface 91 | subroutine fcn(n, x, y, f, rpar, ipar) 92 | integer, intent(inout) :: n 93 | integer, dimension(:),intent(inout) :: ipar 94 | double precision, intent(inout) :: x 95 | double precision, dimension(n), intent(inout) :: y 96 | double precision, dimension(:), intent(inout) :: rpar 97 | double precision, dimension(n), intent(inout) :: f 98 | end subroutine fcn 99 | subroutine solout(nr, xold, x, y, n, con, icomp,& 100 | nd, rpar, ipar, irtrn, xout) 101 | integer, intent(inout) :: n 102 | integer, intent(inout) :: nr 103 | integer, intent(inout) :: nd 104 | integer, intent(inout) :: irtrn 105 | integer, dimension(:), intent(inout) :: ipar 106 | integer, dimension(nd), intent(inout) :: icomp 107 | double precision, intent(inout) :: xold 108 | double precision, intent(inout) :: x 109 | double precision, dimension(n), intent(inout) :: y 110 | double precision, dimension(8*nd), intent(inout) :: con 111 | double precision, dimension(:), intent(inout) :: rpar 112 | double precision, intent(inout) :: xout 113 | end subroutine solout 114 | end interface 115 | integer, intent(inout) :: n 116 | integer, intent(inout) :: itol 117 | integer, intent(inout) :: iout 118 | integer, intent(inout) :: lwork 119 | integer, intent(inout) :: liwork 120 | integer, dimension(:),intent(inout) :: ipar 121 | integer, intent(inout) :: idid 122 | double precision, intent(inout) :: xend 123 | double precision, dimension(n), intent(inout) :: rtol 124 | double precision, dimension(n), intent(inout) :: atol 125 | double precision, dimension(:), intent(inout) :: rpar 126 | double precision, dimension(lwork), intent(inout) :: work 127 | integer, dimension(liwork), intent(inout) :: iwork 128 | double precision, intent(inout) :: x 129 | double precision, dimension(n), intent(inout) :: y 130 | end subroutine dopri5 131 | 132 | double precision function contd5(ii, x, con, icomp, nd) 133 | integer, intent(inout) :: ii 134 | double precision, intent(inout) :: x 135 | double precision, dimension(5*nd), intent(inout) :: con 136 | integer, dimension(nd), intent(inout) :: icomp 137 | integer, intent(inout) :: nd 138 | end function contd5 139 | end interface 140 | 141 | abstract interface 142 | subroutine c_fcn(n, x, y, f, rpar, ipar) 143 | import :: c_int 144 | import :: c_double 145 | integer(c_int), intent(inout) :: n 146 | integer(c_int), dimension(:),intent(inout) :: ipar 147 | real(c_double), intent(inout) :: x 148 | real(c_double), dimension(n), intent(inout) :: y 149 | real(c_double), dimension(:), intent(inout) :: rpar 150 | real(c_double), dimension(n), intent(inout) :: f 151 | end subroutine c_fcn 152 | subroutine c_solout(nr, xold, x, y, n, con, icomp,& 153 | nd, rpar, ipar, irtrn, xout) 154 | import :: c_int 155 | import :: c_double 156 | integer(c_int), intent(inout) :: n 157 | integer(c_int), intent(inout) :: nr 158 | integer(c_int), intent(inout) :: nd 159 | integer(c_int), intent(inout) :: irtrn 160 | integer(c_int), dimension(:), intent(inout) :: ipar 161 | integer(c_int), dimension(nd), intent(inout) :: icomp 162 | real(c_double), intent(inout) :: xold 163 | real(c_double), intent(inout) :: x 164 | real(c_double), dimension(n), intent(inout) :: y 165 | real(c_double), dimension(8*nd), intent(inout) :: con 166 | real(c_double), dimension(:), intent(inout) :: rpar 167 | real(c_double), intent(inout) :: xout 168 | end subroutine c_solout 169 | end interface 170 | 171 | contains 172 | 173 | subroutine c_dop853(n, cfcn, x, y, xend, rtol, atol,& 174 | itol, csolout, iout, work, lwork, iwork,& 175 | liwork, rpar, ipar, idid) bind(c) 176 | integer(c_int), intent(inout) :: n 177 | type(c_funptr), intent(in), value :: cfcn 178 | real(c_double), intent(inout) :: x 179 | real(c_double), dimension(n), intent(inout) :: y 180 | real(c_double), intent(inout) :: xend 181 | real(c_double), dimension(n), intent(inout) :: rtol 182 | real(c_double), dimension(n), intent(inout) :: atol 183 | integer(c_int), intent(inout) :: itol 184 | type(c_funptr), intent(in), value :: csolout 185 | integer(c_int), intent(inout) :: iout 186 | real(c_double), dimension(lwork), intent(inout) :: work 187 | integer(c_int), intent(inout) :: lwork 188 | integer(c_int), dimension(liwork), intent(inout) :: iwork 189 | integer(c_int), intent(inout) :: liwork 190 | real(c_double), dimension(:), intent(inout) :: rpar 191 | integer(c_int), dimension(:),intent(inout) :: ipar 192 | integer(c_int), intent(inout) :: idid 193 | 194 | procedure(c_fcn), pointer :: fcn 195 | procedure(c_solout), pointer :: solout 196 | 197 | real(c_double), dimension(n) :: f 198 | 199 | call c_f_procpointer(cfcn, fcn) 200 | call c_f_procpointer(csolout, solout) 201 | 202 | call dop853(n, fcn, x, y, xend, rtol, atol,& 203 | itol, solout, iout, work, lwork, iwork,& 204 | liwork, rpar, ipar, idid) 205 | end subroutine c_dop853 206 | 207 | function c_contd8(ii, x, con, icomp, nd) result(ret) bind(c) 208 | real(c_double) :: ret 209 | integer(c_int), intent(inout) :: ii 210 | real(c_double), intent(inout) :: x 211 | real(c_double), dimension(8*nd), intent(inout) :: con 212 | integer(c_int), dimension(nd), intent(inout) :: icomp 213 | integer(c_int), intent(inout) :: nd 214 | ret = contd8(ii, x, con, icomp, nd) 215 | end function c_contd8 216 | 217 | subroutine c_dopri5(n, cfcn, x, y, xend, rtol, atol,& 218 | itol, csolout, iout, work, lwork, iwork,& 219 | liwork, rpar, ipar, idid) bind(c) 220 | type(c_funptr), intent(in), value :: cfcn 221 | type(c_funptr), intent(in), value :: csolout 222 | integer(c_int), intent(inout) :: n 223 | integer(c_int), intent(inout) :: itol 224 | integer(c_int), intent(inout) :: iout 225 | integer(c_int), intent(inout) :: lwork 226 | integer(c_int), intent(inout) :: liwork 227 | integer(c_int), dimension(:),intent(inout) :: ipar 228 | integer(c_int), intent(inout) :: idid 229 | real(c_double), intent(inout) :: xend 230 | real(c_double), dimension(n), intent(inout) :: rtol 231 | real(c_double), dimension(n), intent(inout) :: atol 232 | real(c_double), dimension(:), intent(inout) :: rpar 233 | real(c_double), dimension(lwork), intent(inout) :: work 234 | integer(c_int), dimension(liwork), intent(inout) :: iwork 235 | real(c_double), intent(inout) :: x 236 | real(c_double), dimension(n), intent(inout) :: y 237 | 238 | procedure(c_fcn), pointer :: fcn 239 | procedure(c_solout), pointer :: solout 240 | 241 | call c_f_procpointer(cfcn, fcn) 242 | call c_f_procpointer(csolout, solout) 243 | call dopri5(n, fcn, x, y, xend, rtol, atol,& 244 | itol, solout, iout, work, lwork, iwork,& 245 | liwork, rpar, ipar, idid) 246 | end subroutine c_dopri5 247 | 248 | function c_contd5(ii, x, con, icomp, nd) result(ret) bind(c) 249 | real(c_double) :: ret 250 | integer(c_int), intent(inout) :: ii 251 | real(c_double), intent(inout) :: x 252 | real(c_double), dimension(5*nd), intent(inout) :: con 253 | integer(c_int), dimension(nd), intent(inout) :: icomp 254 | integer(c_int), intent(inout) :: nd 255 | ret = contd5(ii, x, con, icomp, nd) 256 | end function c_contd5 257 | 258 | end module 259 | -------------------------------------------------------------------------------- /lib/dopri/dopri.h: -------------------------------------------------------------------------------- 1 | #ifdef __cplusplus 2 | extern "C" 3 | { 4 | #endif 5 | 6 | void c_dop853( 7 | int *n, 8 | void (*fcn)(int *n, double *x, double *y, double *f, double *rpar, int *ipar), 9 | double *x, 10 | double *y, 11 | double *xend, 12 | double *rtol, 13 | double *atol, 14 | int *itol, 15 | void (*solout)(int *nr, double *xold, double *x, double *y, int *n, double *con, 16 | int *icomp, int *nd, double *rpar, int *ipar, int *irtrn, double *xout), 17 | int *iout, 18 | double *work, 19 | int *lwork, 20 | int *iwork, 21 | int *liwork, 22 | double *rpar, 23 | int *ipar, 24 | int *idid); 25 | 26 | void c_dopri5( 27 | int *n, 28 | void (*fcn)(int *n, double *x, double *y, double *f, double *rpar, int *ipar), 29 | double *x, 30 | double *y, 31 | double *xend, 32 | double *rtol, 33 | double *atol, 34 | int *itol, 35 | void (*solout)(int *nr, double *xold, double *x, double *y, int *n, double *con, 36 | int *icomp, int *nd, double *rpar, int *ipar, int *irtrn, double *xout), 37 | int *iout, 38 | double *work, 39 | int *lwork, 40 | int *iwork, 41 | int *liwork, 42 | double *rpar, 43 | int *ipar, 44 | int *idid); 45 | 46 | double c_contd8(int *ii, double *x, double *con, int *icomp, int *nd); 47 | double c_contd5(int *ii, double *x, double *con, int *icomp, int *nd); 48 | 49 | #ifdef __cplusplus 50 | } 51 | #endif 52 | -------------------------------------------------------------------------------- /lib/dopri/dopri5.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE DOPRI5(N,FCN,X,Y,XEND, 2 | & RTOL,ATOL,ITOL, 3 | & SOLOUT,IOUT, 4 | & WORK,LWORK,IWORK,LIWORK,RPAR,IPAR,IDID) 5 | C ---------------------------------------------------------- 6 | C NUMERICAL SOLUTION OF A SYSTEM OF FIRST 0RDER 7 | C ORDINARY DIFFERENTIAL EQUATIONS Y'=F(X,Y). 8 | C THIS IS AN EXPLICIT RUNGE-KUTTA METHOD OF ORDER (4)5 9 | C DUE TO DORMAND & PRINCE (WITH STEPSIZE CONTROL AND 10 | C DENSE OUTPUT). 11 | C 12 | C AUTHORS: E. HAIRER AND G. WANNER 13 | C UNIVERSITE DE GENEVE, DEPT. DE MATHEMATIQUES 14 | C CH-1211 GENEVE 24, SWITZERLAND 15 | C E-MAIL: Ernst.Hairer@math.unige.ch 16 | C Gerhard.Wanner@math.unige.ch 17 | C 18 | C THIS CODE IS DESCRIBED IN: 19 | C E. HAIRER, S.P. NORSETT AND G. WANNER, SOLVING ORDINARY 20 | C DIFFERENTIAL EQUATIONS I. NONSTIFF PROBLEMS. 2ND EDITION. 21 | C SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS, 22 | C SPRINGER-VERLAG (1993) 23 | C 24 | C VERSION OF APRIL 25, 1996 25 | C (latest correction of a small bug: August 8, 2005) 26 | C 27 | C INPUT PARAMETERS 28 | C ---------------- 29 | C N DIMENSION OF THE SYSTEM 30 | C 31 | C FCN NAME (EXTERNAL) OF SUBROUTINE COMPUTING THE 32 | C VALUE OF F(X,Y): 33 | C SUBROUTINE FCN(N,X,Y,F,RPAR,IPAR) 34 | C DOUBLE PRECISION X,Y(N),F(N) 35 | C F(1)=... ETC. 36 | C 37 | C X INITIAL X-VALUE 38 | C 39 | C Y(N) INITIAL VALUES FOR Y 40 | C 41 | C XEND FINAL X-VALUE (XEND-X MAY BE POSITIVE OR NEGATIVE) 42 | C 43 | C RTOL,ATOL RELATIVE AND ABSOLUTE ERROR TOLERANCES. THEY 44 | C CAN BE BOTH SCALARS OR ELSE BOTH VECTORS OF LENGTH N. 45 | C 46 | C ITOL SWITCH FOR RTOL AND ATOL: 47 | C ITOL=0: BOTH RTOL AND ATOL ARE SCALARS. 48 | C THE CODE KEEPS, ROUGHLY, THE LOCAL ERROR OF 49 | C Y(I) BELOW RTOL*ABS(Y(I))+ATOL 50 | C ITOL=1: BOTH RTOL AND ATOL ARE VECTORS. 51 | C THE CODE KEEPS THE LOCAL ERROR OF Y(I) BELOW 52 | C RTOL(I)*ABS(Y(I))+ATOL(I). 53 | C 54 | C SOLOUT NAME (EXTERNAL) OF SUBROUTINE PROVIDING THE 55 | C NUMERICAL SOLUTION DURING INTEGRATION. 56 | C IF IOUT.GE.1, IT IS CALLED AFTER EVERY SUCCESSFUL STEP. 57 | C SUPPLY A DUMMY SUBROUTINE IF IOUT=0. 58 | C IT MUST HAVE THE FORM 59 | C SUBROUTINE SOLOUT (NR,XOLD,X,Y,N,CON,ICOMP,ND, 60 | C RPAR,IPAR,IRTRN) 61 | C DIMENSION Y(N),CON(5*ND),ICOMP(ND) 62 | C .... 63 | C SOLOUT FURNISHES THE SOLUTION "Y" AT THE NR-TH 64 | C GRID-POINT "X" (THEREBY THE INITIAL VALUE IS 65 | C THE FIRST GRID-POINT). 66 | C "XOLD" IS THE PRECEEDING GRID-POINT. 67 | C "IRTRN" SERVES TO INTERRUPT THE INTEGRATION. IF IRTRN 68 | C IS SET <0, DOPRI5 WILL RETURN TO THE CALLING PROGRAM. 69 | C IF THE NUMERICAL SOLUTION IS ALTERED IN SOLOUT, 70 | C SET IRTRN = 2 71 | C 72 | C ----- CONTINUOUS OUTPUT: ----- 73 | C DURING CALLS TO "SOLOUT", A CONTINUOUS SOLUTION 74 | C FOR THE INTERVAL [XOLD,X] IS AVAILABLE THROUGH 75 | C THE FUNCTION 76 | C >>> CONTD5(I,S,CON,ICOMP,ND) <<< 77 | C WHICH PROVIDES AN APPROXIMATION TO THE I-TH 78 | C COMPONENT OF THE SOLUTION AT THE POINT S. THE VALUE 79 | C S SHOULD LIE IN THE INTERVAL [XOLD,X]. 80 | C 81 | C IOUT SWITCH FOR CALLING THE SUBROUTINE SOLOUT: 82 | C IOUT=0: SUBROUTINE IS NEVER CALLED 83 | C IOUT=1: SUBROUTINE IS USED FOR OUTPUT. 84 | C IOUT=2: DENSE OUTPUT IS PERFORMED IN SOLOUT 85 | C (IN THIS CASE WORK(5) MUST BE SPECIFIED) 86 | C 87 | C WORK ARRAY OF WORKING SPACE OF LENGTH "LWORK". 88 | C WORK(1),...,WORK(20) SERVE AS PARAMETERS FOR THE CODE. 89 | C FOR STANDARD USE, SET THEM TO ZERO BEFORE CALLING. 90 | C "LWORK" MUST BE AT LEAST 8*N+5*NRDENS+21 91 | C WHERE NRDENS = IWORK(5) 92 | C 93 | C LWORK DECLARED LENGHT OF ARRAY "WORK". 94 | C 95 | C IWORK INTEGER WORKING SPACE OF LENGHT "LIWORK". 96 | C IWORK(1),...,IWORK(20) SERVE AS PARAMETERS FOR THE CODE. 97 | C FOR STANDARD USE, SET THEM TO ZERO BEFORE CALLING. 98 | C "LIWORK" MUST BE AT LEAST NRDENS+21 . 99 | C 100 | C LIWORK DECLARED LENGHT OF ARRAY "IWORK". 101 | C 102 | C RPAR, IPAR REAL AND INTEGER PARAMETERS (OR PARAMETER ARRAYS) WHICH 103 | C CAN BE USED FOR COMMUNICATION BETWEEN YOUR CALLING 104 | C PROGRAM AND THE FCN, JAC, MAS, SOLOUT SUBROUTINES. 105 | C 106 | C----------------------------------------------------------------------- 107 | C 108 | C SOPHISTICATED SETTING OF PARAMETERS 109 | C ----------------------------------- 110 | C SEVERAL PARAMETERS (WORK(1),...,IWORK(1),...) ALLOW 111 | C TO ADAPT THE CODE TO THE PROBLEM AND TO THE NEEDS OF 112 | C THE USER. FOR ZERO INPUT, THE CODE CHOOSES DEFAULT VALUES. 113 | C 114 | C WORK(1) UROUND, THE ROUNDING UNIT, DEFAULT 2.3D-16. 115 | C 116 | C WORK(2) THE SAFETY FACTOR IN STEP SIZE PREDICTION, 117 | C DEFAULT 0.9D0. 118 | C 119 | C WORK(3), WORK(4) PARAMETERS FOR STEP SIZE SELECTION 120 | C THE NEW STEP SIZE IS CHOSEN SUBJECT TO THE RESTRICTION 121 | C WORK(3) <= HNEW/HOLD <= WORK(4) 122 | C DEFAULT VALUES: WORK(3)=0.2D0, WORK(4)=10.D0 123 | C 124 | C WORK(5) IS THE "BETA" FOR STABILIZED STEP SIZE CONTROL 125 | C (SEE SECTION IV.2). LARGER VALUES OF BETA ( <= 0.1 ) 126 | C MAKE THE STEP SIZE CONTROL MORE STABLE. DOPRI5 NEEDS 127 | C A LARGER BETA THAN HIGHAM & HALL. NEGATIVE WORK(5) 128 | C PROVOKE BETA=0. 129 | C DEFAULT 0.04D0. 130 | C 131 | C WORK(6) MAXIMAL STEP SIZE, DEFAULT XEND-X. 132 | C 133 | C WORK(7) INITIAL STEP SIZE, FOR WORK(7)=0.D0 AN INITIAL GUESS 134 | C IS COMPUTED WITH HELP OF THE FUNCTION HINIT 135 | C 136 | C IWORK(1) THIS IS THE MAXIMAL NUMBER OF ALLOWED STEPS. 137 | C THE DEFAULT VALUE (FOR IWORK(1)=0) IS 100000. 138 | C 139 | C IWORK(2) SWITCH FOR THE CHOICE OF THE COEFFICIENTS 140 | C IF IWORK(2).EQ.1 METHOD DOPRI5 OF DORMAND AND PRINCE 141 | C (TABLE 5.2 OF SECTION II.5). 142 | C AT THE MOMENT THIS IS THE ONLY POSSIBLE CHOICE. 143 | C THE DEFAULT VALUE (FOR IWORK(2)=0) IS IWORK(2)=1. 144 | C 145 | C IWORK(3) SWITCH FOR PRINTING ERROR MESSAGES 146 | C IF IWORK(3).LT.0 NO MESSAGES ARE BEING PRINTED 147 | C IF IWORK(3).GT.0 MESSAGES ARE PRINTED WITH 148 | C WRITE (IWORK(3),*) ... 149 | C DEFAULT VALUE (FOR IWORK(3)=0) IS IWORK(3)=6 150 | C 151 | C IWORK(4) TEST FOR STIFFNESS IS ACTIVATED AFTER STEP NUMBER 152 | C J*IWORK(4) (J INTEGER), PROVIDED IWORK(4).GT.0. 153 | C FOR NEGATIVE IWORK(4) THE STIFFNESS TEST IS 154 | C NEVER ACTIVATED; DEFAULT VALUE IS IWORK(4)=1000 155 | C 156 | C IWORK(5) = NRDENS = NUMBER OF COMPONENTS, FOR WHICH DENSE OUTPUT 157 | C IS REQUIRED; DEFAULT VALUE IS IWORK(5)=0; 158 | C FOR 0 < NRDENS < N THE COMPONENTS (FOR WHICH DENSE 159 | C OUTPUT IS REQUIRED) HAVE TO BE SPECIFIED IN 160 | C IWORK(21),...,IWORK(NRDENS+20); 161 | C FOR NRDENS=N THIS IS DONE BY THE CODE. 162 | C 163 | C---------------------------------------------------------------------- 164 | C 165 | C OUTPUT PARAMETERS 166 | C ----------------- 167 | C X X-VALUE FOR WHICH THE SOLUTION HAS BEEN COMPUTED 168 | C (AFTER SUCCESSFUL RETURN X=XEND). 169 | C 170 | C Y(N) NUMERICAL SOLUTION AT X 171 | C 172 | C H PREDICTED STEP SIZE OF THE LAST ACCEPTED STEP 173 | C 174 | C IDID REPORTS ON SUCCESSFULNESS UPON RETURN: 175 | C IDID= 1 COMPUTATION SUCCESSFUL, 176 | C IDID= 2 COMPUT. SUCCESSFUL (INTERRUPTED BY SOLOUT) 177 | C IDID=-1 INPUT IS NOT CONSISTENT, 178 | C IDID=-2 LARGER NMAX IS NEEDED, 179 | C IDID=-3 STEP SIZE BECOMES TOO SMALL. 180 | C IDID=-4 PROBLEM IS PROBABLY STIFF (INTERRUPTED). 181 | C 182 | C IWORK(17) NFCN NUMBER OF FUNCTION EVALUATIONS 183 | C IWORK(18) NSTEP NUMBER OF COMPUTED STEPS 184 | C IWORK(19) NACCPT NUMBER OF ACCEPTED STEPS 185 | C IWORK(20) NREJCT NUMBER OF REJECTED STEPS (DUE TO ERROR TEST), 186 | C (STEP REJECTIONS IN THE FIRST STEP ARE NOT COUNTED) 187 | C----------------------------------------------------------------------- 188 | C *** *** *** *** *** *** *** *** *** *** *** *** *** 189 | C DECLARATIONS 190 | C *** *** *** *** *** *** *** *** *** *** *** *** *** 191 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 192 | DIMENSION Y(N),ATOL(*),RTOL(*),WORK(LWORK),IWORK(LIWORK) 193 | DIMENSION RPAR(*),IPAR(*) 194 | LOGICAL ARRET 195 | EXTERNAL FCN,SOLOUT 196 | C *** *** *** *** *** *** *** 197 | C SETTING THE PARAMETERS 198 | C *** *** *** *** *** *** *** 199 | NFCN=0 200 | NSTEP=0 201 | NACCPT=0 202 | NREJCT=0 203 | ARRET=.FALSE. 204 | C -------- IPRINT FOR MONITORING THE PRINTING 205 | IF(IWORK(3).EQ.0)THEN 206 | IPRINT=6 207 | ELSE 208 | IPRINT=IWORK(3) 209 | END IF 210 | C -------- NMAX , THE MAXIMAL NUMBER OF STEPS ----- 211 | IF(IWORK(1).EQ.0)THEN 212 | NMAX=100000 213 | ELSE 214 | NMAX=IWORK(1) 215 | IF(NMAX.LE.0)THEN 216 | IF (IPRINT.GT.0) WRITE(IPRINT,*) 217 | & ' WRONG INPUT IWORK(1)=',IWORK(1) 218 | ARRET=.TRUE. 219 | END IF 220 | END IF 221 | C -------- METH COEFFICIENTS OF THE METHOD 222 | IF(IWORK(2).EQ.0)THEN 223 | METH=1 224 | ELSE 225 | METH=IWORK(2) 226 | IF(METH.LE.0.OR.METH.GE.4)THEN 227 | IF (IPRINT.GT.0) WRITE(IPRINT,*) 228 | & ' CURIOUS INPUT IWORK(2)=',IWORK(2) 229 | ARRET=.TRUE. 230 | END IF 231 | END IF 232 | C -------- NSTIFF PARAMETER FOR STIFFNESS DETECTION 233 | NSTIFF=IWORK(4) 234 | IF (NSTIFF.EQ.0) NSTIFF=1000 235 | IF (NSTIFF.LT.0) NSTIFF=NMAX+10 236 | C -------- NRDENS NUMBER OF DENSE OUTPUT COMPONENTS 237 | NRDENS=IWORK(5) 238 | IF(NRDENS.LT.0.OR.NRDENS.GT.N)THEN 239 | IF (IPRINT.GT.0) WRITE(IPRINT,*) 240 | & ' CURIOUS INPUT IWORK(5)=',IWORK(5) 241 | ARRET=.TRUE. 242 | ELSE 243 | IF(NRDENS.GT.0.AND.IOUT.LT.2)THEN 244 | IF (IPRINT.GT.0) WRITE(IPRINT,*) 245 | & ' WARNING: PUT IOUT=2 FOR DENSE OUTPUT ' 246 | END IF 247 | IF (NRDENS.EQ.N) THEN 248 | DO 16 I=1,NRDENS 249 | 16 IWORK(20+I)=I 250 | END IF 251 | END IF 252 | C -------- UROUND SMALLEST NUMBER SATISFYING 1.D0+UROUND>1.D0 253 | IF(WORK(1).EQ.0.D0)THEN 254 | UROUND=2.3D-16 255 | ELSE 256 | UROUND=WORK(1) 257 | IF(UROUND.LE.1.D-35.OR.UROUND.GE.1.D0)THEN 258 | IF (IPRINT.GT.0) WRITE(IPRINT,*) 259 | & ' WHICH MACHINE DO YOU HAVE? YOUR UROUND WAS:',WORK(1) 260 | ARRET=.TRUE. 261 | END IF 262 | END IF 263 | C ------- SAFETY FACTOR ------------- 264 | IF(WORK(2).EQ.0.D0)THEN 265 | SAFE=0.9D0 266 | ELSE 267 | SAFE=WORK(2) 268 | IF(SAFE.GE.1.D0.OR.SAFE.LE.1.D-4)THEN 269 | IF (IPRINT.GT.0) WRITE(IPRINT,*) 270 | & ' CURIOUS INPUT FOR SAFETY FACTOR WORK(2)=',WORK(2) 271 | ARRET=.TRUE. 272 | END IF 273 | END IF 274 | C ------- FAC1,FAC2 PARAMETERS FOR STEP SIZE SELECTION 275 | IF(WORK(3).EQ.0.D0)THEN 276 | FAC1=0.2D0 277 | ELSE 278 | FAC1=WORK(3) 279 | END IF 280 | IF(WORK(4).EQ.0.D0)THEN 281 | FAC2=10.D0 282 | ELSE 283 | FAC2=WORK(4) 284 | END IF 285 | C --------- BETA FOR STEP CONTROL STABILIZATION ----------- 286 | IF(WORK(5).EQ.0.D0)THEN 287 | BETA=0.04D0 288 | ELSE 289 | IF(WORK(5).LT.0.D0)THEN 290 | BETA=0.D0 291 | ELSE 292 | BETA=WORK(5) 293 | IF(BETA.GT.0.2D0)THEN 294 | IF (IPRINT.GT.0) WRITE(IPRINT,*) 295 | & ' CURIOUS INPUT FOR BETA: WORK(5)=',WORK(5) 296 | ARRET=.TRUE. 297 | END IF 298 | END IF 299 | END IF 300 | C -------- MAXIMAL STEP SIZE 301 | IF(WORK(6).EQ.0.D0)THEN 302 | HMAX=XEND-X 303 | ELSE 304 | HMAX=WORK(6) 305 | END IF 306 | C -------- INITIAL STEP SIZE 307 | H=WORK(7) 308 | C ------- PREPARE THE ENTRY-POINTS FOR THE ARRAYS IN WORK ----- 309 | IEY1=21 310 | IEK1=IEY1+N 311 | IEK2=IEK1+N 312 | IEK3=IEK2+N 313 | IEK4=IEK3+N 314 | IEK5=IEK4+N 315 | IEK6=IEK5+N 316 | IEYS=IEK6+N 317 | IECO=IEYS+N 318 | C ------ TOTAL STORAGE REQUIREMENT ----------- 319 | ISTORE=IEYS+5*NRDENS-1 320 | IF(ISTORE.GT.LWORK)THEN 321 | IF (IPRINT.GT.0) WRITE(IPRINT,*) 322 | & ' INSUFFICIENT STORAGE FOR WORK, MIN. LWORK=',ISTORE 323 | ARRET=.TRUE. 324 | END IF 325 | ICOMP=21 326 | ISTORE=ICOMP+NRDENS-1 327 | IF(ISTORE.GT.LIWORK)THEN 328 | IF (IPRINT.GT.0) WRITE(IPRINT,*) 329 | & ' INSUFFICIENT STORAGE FOR IWORK, MIN. LIWORK=',ISTORE 330 | ARRET=.TRUE. 331 | END IF 332 | C ------ WHEN A FAIL HAS OCCURED, WE RETURN WITH IDID=-1 333 | IF (ARRET) THEN 334 | IDID=-1 335 | RETURN 336 | END IF 337 | C -------- CALL TO CORE INTEGRATOR ------------ 338 | CALL DOPCOR(N,FCN,X,Y,XEND,HMAX,H,RTOL,ATOL,ITOL,IPRINT, 339 | & SOLOUT,IOUT,IDID,NMAX,UROUND,METH,NSTIFF,SAFE,BETA,FAC1,FAC2, 340 | & WORK(IEY1),WORK(IEK1),WORK(IEK2),WORK(IEK3),WORK(IEK4), 341 | & WORK(IEK5),WORK(IEK6),WORK(IEYS),WORK(IECO),IWORK(ICOMP), 342 | & NRDENS,RPAR,IPAR,NFCN,NSTEP,NACCPT,NREJCT) 343 | WORK(7)=H 344 | IWORK(17)=NFCN 345 | IWORK(18)=NSTEP 346 | IWORK(19)=NACCPT 347 | IWORK(20)=NREJCT 348 | C ----------- RETURN ----------- 349 | RETURN 350 | END 351 | C 352 | C 353 | C 354 | C ----- ... AND HERE IS THE CORE INTEGRATOR ---------- 355 | C 356 | SUBROUTINE DOPCOR(N,FCN,X,Y,XEND,HMAX,H,RTOL,ATOL,ITOL,IPRINT, 357 | & SOLOUT,IOUT,IDID,NMAX,UROUND,METH,NSTIFF,SAFE,BETA,FAC1,FAC2, 358 | & Y1,K1,K2,K3,K4,K5,K6,YSTI,CONT,ICOMP,NRD,RPAR,IPAR, 359 | & NFCN,NSTEP,NACCPT,NREJCT) 360 | C ---------------------------------------------------------- 361 | C CORE INTEGRATOR FOR DOPRI5 362 | C PARAMETERS SAME AS IN DOPRI5 WITH WORKSPACE ADDED 363 | C ---------------------------------------------------------- 364 | C DECLARATIONS 365 | C ---------------------------------------------------------- 366 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 367 | DOUBLE PRECISION K1(N),K2(N),K3(N),K4(N),K5(N),K6(N) 368 | DIMENSION Y(N),Y1(N),YSTI(N),ATOL(*),RTOL(*),RPAR(*),IPAR(*) 369 | DIMENSION CONT(5*NRD),ICOMP(NRD) 370 | LOGICAL REJECT,LAST 371 | EXTERNAL FCN 372 | COMMON /CONDO5/XOLD,HOUT 373 | C *** *** *** *** *** *** *** 374 | C INITIALISATIONS 375 | C *** *** *** *** *** *** *** 376 | IF (METH.EQ.1) CALL CDOPRI(C2,C3,C4,C5,E1,E3,E4,E5,E6,E7, 377 | & A21,A31,A32,A41,A42,A43,A51,A52,A53,A54, 378 | & A61,A62,A63,A64,A65,A71,A73,A74,A75,A76, 379 | & D1,D3,D4,D5,D6,D7) 380 | FACOLD=1.D-4 381 | EXPO1=0.2D0-BETA*0.75D0 382 | FACC1=1.D0/FAC1 383 | FACC2=1.D0/FAC2 384 | POSNEG=SIGN(1.D0,XEND-X) 385 | C --- INITIAL PREPARATIONS 386 | ATOLI=ATOL(1) 387 | RTOLI=RTOL(1) 388 | LAST=.FALSE. 389 | HLAMB=0.D0 390 | IASTI=0 391 | CALL FCN(N,X,Y,K1,RPAR,IPAR) 392 | HMAX=ABS(HMAX) 393 | IORD=5 394 | IF (H.EQ.0.D0) H=HINIT5(N,FCN,X,Y,XEND,POSNEG,K1,K2,K3,IORD, 395 | & HMAX,ATOL,RTOL,ITOL,RPAR,IPAR) 396 | NFCN=NFCN+2 397 | REJECT=.FALSE. 398 | XOLD=X 399 | IF (IOUT.NE.0) THEN 400 | IRTRN=1 401 | HOUT=H 402 | CALL SOLOUT(NACCPT+1,XOLD,X,Y,N,CONT,ICOMP,NRD, 403 | & RPAR,IPAR,IRTRN) 404 | IF (IRTRN.LT.0) GOTO 79 405 | ELSE 406 | IRTRN=0 407 | END IF 408 | C --- BASIC INTEGRATION STEP 409 | 1 CONTINUE 410 | IF (NSTEP.GT.NMAX) GOTO 78 411 | IF (0.1D0*ABS(H).LE.ABS(X)*UROUND)GOTO 77 412 | IF ((X+1.01D0*H-XEND)*POSNEG.GT.0.D0) THEN 413 | H=XEND-X 414 | LAST=.TRUE. 415 | END IF 416 | NSTEP=NSTEP+1 417 | C --- THE FIRST 6 STAGES 418 | IF (IRTRN.GE.2) THEN 419 | CALL FCN(N,X,Y,K1,RPAR,IPAR) 420 | END IF 421 | DO 22 I=1,N 422 | 22 Y1(I)=Y(I)+H*A21*K1(I) 423 | CALL FCN(N,X+C2*H,Y1,K2,RPAR,IPAR) 424 | DO 23 I=1,N 425 | 23 Y1(I)=Y(I)+H*(A31*K1(I)+A32*K2(I)) 426 | CALL FCN(N,X+C3*H,Y1,K3,RPAR,IPAR) 427 | DO 24 I=1,N 428 | 24 Y1(I)=Y(I)+H*(A41*K1(I)+A42*K2(I)+A43*K3(I)) 429 | CALL FCN(N,X+C4*H,Y1,K4,RPAR,IPAR) 430 | DO 25 I=1,N 431 | 25 Y1(I)=Y(I)+H*(A51*K1(I)+A52*K2(I)+A53*K3(I)+A54*K4(I)) 432 | CALL FCN(N,X+C5*H,Y1,K5,RPAR,IPAR) 433 | DO 26 I=1,N 434 | 26 YSTI(I)=Y(I)+H*(A61*K1(I)+A62*K2(I)+A63*K3(I)+A64*K4(I)+A65*K5(I)) 435 | XPH=X+H 436 | CALL FCN(N,XPH,YSTI,K6,RPAR,IPAR) 437 | DO 27 I=1,N 438 | 27 Y1(I)=Y(I)+H*(A71*K1(I)+A73*K3(I)+A74*K4(I)+A75*K5(I)+A76*K6(I)) 439 | CALL FCN(N,XPH,Y1,K2,RPAR,IPAR) 440 | IF (IOUT.GE.2) THEN 441 | DO 40 J=1,NRD 442 | I=ICOMP(J) 443 | CONT(4*NRD+J)=H*(D1*K1(I)+D3*K3(I)+D4*K4(I)+D5*K5(I) 444 | & +D6*K6(I)+D7*K2(I)) 445 | 40 CONTINUE 446 | END IF 447 | DO 28 I=1,N 448 | 28 K4(I)=(E1*K1(I)+E3*K3(I)+E4*K4(I)+E5*K5(I)+E6*K6(I)+E7*K2(I))*H 449 | NFCN=NFCN+6 450 | C --- ERROR ESTIMATION 451 | ERR=0.D0 452 | IF (ITOL.EQ.0) THEN 453 | DO 41 I=1,N 454 | SK=ATOLI+RTOLI*MAX(ABS(Y(I)),ABS(Y1(I))) 455 | 41 ERR=ERR+(K4(I)/SK)**2 456 | ELSE 457 | DO 42 I=1,N 458 | SK=ATOL(I)+RTOL(I)*MAX(ABS(Y(I)),ABS(Y1(I))) 459 | 42 ERR=ERR+(K4(I)/SK)**2 460 | END IF 461 | ERR=SQRT(ERR/N) 462 | C --- COMPUTATION OF HNEW 463 | FAC11=ERR**EXPO1 464 | C --- LUND-STABILIZATION 465 | FAC=FAC11/FACOLD**BETA 466 | C --- WE REQUIRE FAC1 <= HNEW/H <= FAC2 467 | FAC=MAX(FACC2,MIN(FACC1,FAC/SAFE)) 468 | HNEW=H/FAC 469 | IF(ERR.LE.1.D0)THEN 470 | C --- STEP IS ACCEPTED 471 | FACOLD=MAX(ERR,1.0D-4) 472 | NACCPT=NACCPT+1 473 | C ------- STIFFNESS DETECTION 474 | IF (MOD(NACCPT,NSTIFF).EQ.0.OR.IASTI.GT.0) THEN 475 | STNUM=0.D0 476 | STDEN=0.D0 477 | DO 64 I=1,N 478 | STNUM=STNUM+(K2(I)-K6(I))**2 479 | STDEN=STDEN+(Y1(I)-YSTI(I))**2 480 | 64 CONTINUE 481 | IF (STDEN.GT.0.D0) HLAMB=H*SQRT(STNUM/STDEN) 482 | IF (HLAMB.GT.3.25D0) THEN 483 | NONSTI=0 484 | IASTI=IASTI+1 485 | IF (IASTI.EQ.15) THEN 486 | IF (IPRINT.GT.0) WRITE (IPRINT,*) 487 | & ' THE PROBLEM SEEMS TO BECOME STIFF AT X = ',X 488 | IF (IPRINT.LE.0) GOTO 76 489 | END IF 490 | ELSE 491 | NONSTI=NONSTI+1 492 | IF (NONSTI.EQ.6) IASTI=0 493 | END IF 494 | END IF 495 | IF (IOUT.GE.2) THEN 496 | DO 43 J=1,NRD 497 | I=ICOMP(J) 498 | YD0=Y(I) 499 | YDIFF=Y1(I)-YD0 500 | BSPL=H*K1(I)-YDIFF 501 | CONT(J)=Y(I) 502 | CONT(NRD+J)=YDIFF 503 | CONT(2*NRD+J)=BSPL 504 | CONT(3*NRD+J)=-H*K2(I)+YDIFF-BSPL 505 | 43 CONTINUE 506 | END IF 507 | DO 44 I=1,N 508 | K1(I)=K2(I) 509 | 44 Y(I)=Y1(I) 510 | XOLD=X 511 | X=XPH 512 | IF (IOUT.NE.0) THEN 513 | HOUT=H 514 | CALL SOLOUT(NACCPT+1,XOLD,X,Y,N,CONT,ICOMP,NRD, 515 | & RPAR,IPAR,IRTRN) 516 | IF (IRTRN.LT.0) GOTO 79 517 | END IF 518 | C ------- NORMAL EXIT 519 | IF (LAST) THEN 520 | H=HNEW 521 | IDID=1 522 | RETURN 523 | END IF 524 | IF(ABS(HNEW).GT.HMAX)HNEW=POSNEG*HMAX 525 | IF(REJECT)HNEW=POSNEG*MIN(ABS(HNEW),ABS(H)) 526 | REJECT=.FALSE. 527 | ELSE 528 | C --- STEP IS REJECTED 529 | HNEW=H/MIN(FACC1,FAC11/SAFE) 530 | REJECT=.TRUE. 531 | IF(NACCPT.GE.1)NREJCT=NREJCT+1 532 | LAST=.FALSE. 533 | END IF 534 | H=HNEW 535 | GOTO 1 536 | C --- FAIL EXIT 537 | 76 CONTINUE 538 | IDID=-4 539 | RETURN 540 | 77 CONTINUE 541 | IF (IPRINT.GT.0) WRITE(IPRINT,979)X 542 | IF (IPRINT.GT.0) WRITE(IPRINT,*)' STEP SIZE T0O SMALL, H=',H 543 | IDID=-3 544 | RETURN 545 | 78 CONTINUE 546 | IF (IPRINT.GT.0) WRITE(IPRINT,979)X 547 | IF (IPRINT.GT.0) WRITE(IPRINT,*) 548 | & ' MORE THAN NMAX =',NMAX,'STEPS ARE NEEDED' 549 | IDID=-2 550 | RETURN 551 | 79 CONTINUE 552 | IF (IPRINT.GT.0) WRITE(IPRINT,979)X 553 | 979 FORMAT(' EXIT OF DOPRI5 AT X=',E18.4) 554 | IDID=2 555 | RETURN 556 | END 557 | C 558 | FUNCTION HINIT5(N,FCN,X,Y,XEND,POSNEG,F0,F1,Y1,IORD, 559 | & HMAX,ATOL,RTOL,ITOL,RPAR,IPAR) 560 | C ---------------------------------------------------------- 561 | C ---- COMPUTATION OF AN INITIAL STEP SIZE GUESS 562 | C ---------------------------------------------------------- 563 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 564 | DIMENSION Y(N),Y1(N),F0(N),F1(N),ATOL(*),RTOL(*) 565 | DIMENSION RPAR(*),IPAR(*) 566 | C ---- COMPUTE A FIRST GUESS FOR EXPLICIT EULER AS 567 | C ---- H = 0.01 * NORM (Y0) / NORM (F0) 568 | C ---- THE INCREMENT FOR EXPLICIT EULER IS SMALL 569 | C ---- COMPARED TO THE SOLUTION 570 | DNF=0.0D0 571 | DNY=0.0D0 572 | ATOLI=ATOL(1) 573 | RTOLI=RTOL(1) 574 | IF (ITOL.EQ.0) THEN 575 | DO 10 I=1,N 576 | SK=ATOLI+RTOLI*ABS(Y(I)) 577 | DNF=DNF+(F0(I)/SK)**2 578 | 10 DNY=DNY+(Y(I)/SK)**2 579 | ELSE 580 | DO 11 I=1,N 581 | SK=ATOL(I)+RTOL(I)*ABS(Y(I)) 582 | DNF=DNF+(F0(I)/SK)**2 583 | 11 DNY=DNY+(Y(I)/SK)**2 584 | END IF 585 | IF (DNF.LE.1.D-10.OR.DNY.LE.1.D-10) THEN 586 | H=1.0D-6 587 | ELSE 588 | H=SQRT(DNY/DNF)*0.01D0 589 | END IF 590 | H=MIN(H,HMAX) 591 | H=SIGN(H,POSNEG) 592 | C ---- PERFORM AN EXPLICIT EULER STEP 593 | DO 12 I=1,N 594 | 12 Y1(I)=Y(I)+H*F0(I) 595 | CALL FCN(N,X+H,Y1,F1,RPAR,IPAR) 596 | C ---- ESTIMATE THE SECOND DERIVATIVE OF THE SOLUTION 597 | DER2=0.0D0 598 | IF (ITOL.EQ.0) THEN 599 | DO 15 I=1,N 600 | SK=ATOLI+RTOLI*ABS(Y(I)) 601 | 15 DER2=DER2+((F1(I)-F0(I))/SK)**2 602 | ELSE 603 | DO 16 I=1,N 604 | SK=ATOL(I)+RTOL(I)*ABS(Y(I)) 605 | 16 DER2=DER2+((F1(I)-F0(I))/SK)**2 606 | END IF 607 | DER2=SQRT(DER2)/H 608 | C ---- STEP SIZE IS COMPUTED SUCH THAT 609 | C ---- H**IORD * MAX ( NORM (F0), NORM (DER2)) = 0.01 610 | DER12=MAX(ABS(DER2),SQRT(DNF)) 611 | IF (DER12.LE.1.D-15) THEN 612 | H1=MAX(1.0D-6,ABS(H)*1.0D-3) 613 | ELSE 614 | H1=(0.01D0/DER12)**(1.D0/IORD) 615 | END IF 616 | H=MIN(100*ABS(H),H1,HMAX) 617 | HINIT5=SIGN(H,POSNEG) 618 | RETURN 619 | END 620 | C 621 | FUNCTION CONTD5(II,X,CON,ICOMP,ND) 622 | C ---------------------------------------------------------- 623 | C THIS FUNCTION CAN BE USED FOR CONTINUOUS OUTPUT IN CONNECTION 624 | C WITH THE OUTPUT-SUBROUTINE FOR DOPRI5. IT PROVIDES AN 625 | C APPROXIMATION TO THE II-TH COMPONENT OF THE SOLUTION AT X. 626 | C ---------------------------------------------------------- 627 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 628 | DIMENSION CON(5*ND),ICOMP(ND) 629 | COMMON /CONDO5/XOLD,H 630 | C ----- COMPUTE PLACE OF II-TH COMPONENT 631 | I=0 632 | DO 5 J=1,ND 633 | IF (ICOMP(J).EQ.II) I=J 634 | 5 CONTINUE 635 | IF (I.EQ.0) THEN 636 | WRITE (6,*) ' NO DENSE OUTPUT AVAILABLE FOR COMP.',II 637 | RETURN 638 | END IF 639 | THETA=(X-XOLD)/H 640 | THETA1=1.D0-THETA 641 | CONTD5=CON(I)+THETA*(CON(ND+I)+THETA1*(CON(2*ND+I)+THETA* 642 | & (CON(3*ND+I)+THETA1*CON(4*ND+I)))) 643 | RETURN 644 | END 645 | C 646 | SUBROUTINE CDOPRI(C2,C3,C4,C5,E1,E3,E4,E5,E6,E7, 647 | & A21,A31,A32,A41,A42,A43,A51,A52,A53,A54, 648 | & A61,A62,A63,A64,A65,A71,A73,A74,A75,A76, 649 | & D1,D3,D4,D5,D6,D7) 650 | C ---------------------------------------------------------- 651 | C RUNGE-KUTTA COEFFICIENTS OF DORMAND AND PRINCE (1980) 652 | C ---------------------------------------------------------- 653 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 654 | C2=0.2D0 655 | C3=0.3D0 656 | C4=0.8D0 657 | C5=8.D0/9.D0 658 | A21=0.2D0 659 | A31=3.D0/40.D0 660 | A32=9.D0/40.D0 661 | A41=44.D0/45.D0 662 | A42=-56.D0/15.D0 663 | A43=32.D0/9.D0 664 | A51=19372.D0/6561.D0 665 | A52=-25360.D0/2187.D0 666 | A53=64448.D0/6561.D0 667 | A54=-212.D0/729.D0 668 | A61=9017.D0/3168.D0 669 | A62=-355.D0/33.D0 670 | A63=46732.D0/5247.D0 671 | A64=49.D0/176.D0 672 | A65=-5103.D0/18656.D0 673 | A71=35.D0/384.D0 674 | A73=500.D0/1113.D0 675 | A74=125.D0/192.D0 676 | A75=-2187.D0/6784.D0 677 | A76=11.D0/84.D0 678 | E1=71.D0/57600.D0 679 | E3=-71.D0/16695.D0 680 | E4=71.D0/1920.D0 681 | E5=-17253.D0/339200.D0 682 | E6=22.D0/525.D0 683 | E7=-1.D0/40.D0 684 | C ---- DENSE OUTPUT OF SHAMPINE (1986) 685 | D1=-12715105075.D0/11282082432.D0 686 | D3=87487479700.D0/32700410799.D0 687 | D4=-10690763975.D0/1880347072.D0 688 | D5=701980252875.D0/199316789632.D0 689 | D6=-1453857185.D0/822651844.D0 690 | D7=69997945.D0/29380423.D0 691 | RETURN 692 | END 693 | 694 | -------------------------------------------------------------------------------- /matlab/.gitignore: -------------------------------------------------------------------------------- 1 | propagator.mexmaci64 2 | -------------------------------------------------------------------------------- /matlab/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 3.3) 2 | project(ICATT Fortran) 3 | 4 | enable_language(CXX) 5 | enable_testing() 6 | 7 | set(MATLAB_ADDITIONAL_VERSIONS "R2016b=9.1") 8 | 9 | set(Matlab_ROOT_DIR /home/helge/MATLAB/R2016b) 10 | find_package(Matlab REQUIRED COMPONENTS MX_LIBRARY MAIN_PROGRAM) 11 | 12 | set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include) 13 | set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -cpp -fPIC -g") 14 | 15 | add_subdirectory(../lib/dopri ${CMAKE_BINARY_DIR}/dopri) 16 | 17 | matlab_add_mex(NAME propagator 18 | SRC propagator.f90 propagator_module.f90 19 | LINK_TO dopri_static) 20 | matlab_add_unit_test(NAME proptest 21 | ADDITIONAL_PATH ${CMAKE_SOURCE_DIR} 22 | UNITTEST_FILE ${CMAKE_SOURCE_DIR}/proptest.m 23 | NO_UNITTEST_FRAMEWORK) 24 | 25 | install(TARGETS propagator DESTINATION ${CMAKE_SOURCE_DIR}) 26 | -------------------------------------------------------------------------------- /matlab/benchmark.m: -------------------------------------------------------------------------------- 1 | function benchmark(times) 2 | 3 | r = [8.59072560e+02, -4.13720368e+03, 5.29556871e+03]; 4 | v = [7.37289205e+00, 2.08223573e+00, 4.39999794e-01]; 5 | mu = 3.986004418e5; 6 | rlam0 = [5000.0, 10000.0, 2100.0]; 7 | rlam = [-14600.0, 2500.0, 7000.0]; 8 | tof = 3600.0; 9 | 10 | el = elements(r, v, mu); 11 | tend = period(el(1), mu); 12 | 13 | worst = -inf; 14 | best = inf; 15 | total = 0; 16 | for ii = 1:times 17 | tic; 18 | elements(r, v, mu); 19 | t = toc; 20 | 21 | total = total + t; 22 | if t > worst 23 | worst = t; 24 | end 25 | if t < best 26 | best = t; 27 | end 28 | end 29 | 30 | disp(['[',num2str(total/times),',',num2str(best),',',num2str(worst),']']) 31 | 32 | worst = -inf; 33 | best = inf; 34 | total = 0; 35 | for ii = 1:times 36 | tic; 37 | mean2ecc(pi/2, el(2)); 38 | t = toc; 39 | 40 | total = total + t; 41 | if t > worst 42 | worst = t; 43 | end 44 | if t < best 45 | best = t; 46 | end 47 | end 48 | 49 | disp(['[',num2str(total/times),',',num2str(best),',',num2str(worst),']']) 50 | 51 | worst = -inf; 52 | best = inf; 53 | total = 0; 54 | for ii = 1:times 55 | tic; 56 | lambert(mu, rlam0, rlam, tof, true, 35, 1e-8); 57 | t = toc; 58 | 59 | total = total + t; 60 | if t > worst 61 | worst = t; 62 | end 63 | if t < best 64 | best = t; 65 | end 66 | end 67 | 68 | disp(['[',num2str(total/times),',',num2str(best),',',num2str(worst),']']) 69 | 70 | worst = -inf; 71 | best = inf; 72 | total = 0; 73 | % Lock MEX file 74 | propagator(1); 75 | for ii = 1:times 76 | tic; 77 | rv1 = propagator('gravity', [r,v], 0, tend, mu); 78 | t = toc; 79 | 80 | total = total + t; 81 | if t > worst 82 | worst = t; 83 | end 84 | if t < best 85 | best = t; 86 | end 87 | end 88 | % Unlock MEX file 89 | propagator(0); 90 | 91 | disp(['[',num2str(total/times),',',num2str(best),',',num2str(worst),']']) 92 | 93 | -------------------------------------------------------------------------------- /matlab/c2.m: -------------------------------------------------------------------------------- 1 | function res = c2(psi) 2 | eps = 1.0; 3 | if psi > eps 4 | res = (1 - cos(sqrt(psi))) / psi; 5 | elseif psi < -eps 6 | res = (cosh(sqrt(-psi)) - 1) / (-psi); 7 | else 8 | res = 1.0 / 2.0; 9 | delta = (-psi) / gamma(2 + 2 + 1); 10 | k = 1; 11 | while res + delta ~= res 12 | res = res + delta; 13 | k = k + 1; 14 | delta = (-psi)^k / gamma(2*k + 2 + 1); 15 | end 16 | end -------------------------------------------------------------------------------- /matlab/c3.m: -------------------------------------------------------------------------------- 1 | function res = c3(psi) 2 | eps = 1.0; 3 | if psi > eps 4 | res = (sqrt(psi) - sin(sqrt(psi))) / (psi * sqrt(psi)); 5 | elseif psi < -eps 6 | res = (sinh(sqrt(-psi)) - sqrt(-psi)) / (-psi * sqrt(-psi)); 7 | else 8 | res = 1.0 / 6.0; 9 | delta = (-psi) / gamma(2 + 3 + 1); 10 | k = 1; 11 | while res + delta ~= res 12 | res = res + delta; 13 | k = k + 1; 14 | delta = (-psi)^k / gamma(2*k + 3 + 1); 15 | end 16 | end -------------------------------------------------------------------------------- /matlab/cmake/MatlabTestsRedirect.cmake: -------------------------------------------------------------------------------- 1 | # This is an undocumented internal helper for the FindMatlab 2 | # module ``matlab_add_unit_test`` command. 3 | 4 | #============================================================================= 5 | # Copyright 2014-2015 Raffi Enficiaud, Max Planck Society 6 | # 7 | # Distributed under the OSI-approved BSD License (the "License"); 8 | # see accompanying file Copyright.txt for details. 9 | # 10 | # This software is distributed WITHOUT ANY WARRANTY; without even the 11 | # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 12 | # See the License for more information. 13 | #============================================================================= 14 | # (To distribute this file outside of CMake, substitute the full 15 | # License text for the above reference.) 16 | 17 | 18 | # Usage: cmake 19 | # -Dtest_timeout=180 20 | # -Doutput_directory= 21 | # -Dadditional_paths="" 22 | # -Dno_unittest_framework="" 23 | # -DMatlab_PROGRAM=matlab_exe_location 24 | # -DMatlab_ADDITIONNAL_STARTUP_OPTIONS="" 25 | # -Dtest_name=name_of_the_test 26 | # -Dcmd_to_run_before_test="" 27 | # -Dunittest_file_to_run 28 | # -P FindMatlab_TestsRedirect.cmake 29 | 30 | set(Matlab_UNIT_TESTS_CMD -nosplash -nojvm -nodesktop -nodisplay ${Matlab_ADDITIONNAL_STARTUP_OPTIONS}) 31 | if(WIN32) 32 | set(Matlab_UNIT_TESTS_CMD ${Matlab_UNIT_TESTS_CMD} -wait) 33 | endif() 34 | 35 | if(NOT test_timeout) 36 | set(test_timeout 180) 37 | endif() 38 | 39 | if(NOT cmd_to_run_before_test) 40 | set(cmd_to_run_before_test) 41 | endif() 42 | 43 | get_filename_component(unittest_file_directory "${unittest_file_to_run}" DIRECTORY) 44 | get_filename_component(unittest_file_to_run_name "${unittest_file_to_run}" NAME_WE) 45 | 46 | set(concat_string '${unittest_file_directory}') 47 | foreach(s IN LISTS additional_paths) 48 | if(NOT "${s}" STREQUAL "") 49 | set(concat_string "${concat_string}, '${s}'") 50 | endif() 51 | endforeach() 52 | 53 | set(unittest_to_run "runtests('${unittest_file_to_run_name}'), exit(max([ans(1,:).Failed]))") 54 | if(no_unittest_framework) 55 | set(unittest_to_run "try, ${unittest_file_to_run_name}, catch err, disp('An exception has been thrown during the execution'), disp(err), disp(err.stack), exit(1), end, exit(0)") 56 | endif() 57 | 58 | set(Matlab_SCRIPT_TO_RUN 59 | "addpath(${concat_string}), path, ${cmd_to_run_before_test}, ${unittest_to_run}" 60 | ) 61 | 62 | set(Matlab_LOG_FILE "${output_directory}/${test_name}.log") 63 | 64 | set(devnull) 65 | if(UNIX) 66 | set(devnull INPUT_FILE /dev/null) 67 | elseif(WIN32) 68 | set(devnull INPUT_FILE NUL) 69 | endif() 70 | 71 | execute_process( 72 | COMMAND "${Matlab_PROGRAM}" ${Matlab_UNIT_TESTS_CMD} -logfile "${test_name}.log" -r "${Matlab_SCRIPT_TO_RUN}" 73 | RESULT_VARIABLE res 74 | TIMEOUT ${test_timeout} 75 | OUTPUT_QUIET # we do not want the output twice 76 | WORKING_DIRECTORY "${output_directory}" 77 | ${devnull} 78 | ) 79 | 80 | if(NOT EXISTS ${Matlab_LOG_FILE}) 81 | message( FATAL_ERROR "[MATLAB] ERROR: cannot find the log file ${Matlab_LOG_FILE}") 82 | endif() 83 | 84 | # print the output in any case. 85 | file(READ ${Matlab_LOG_FILE} matlab_log_content) 86 | message("Matlab test ${name_of_the_test} output:\n${matlab_log_content}") # if we put FATAL_ERROR here, the file is indented. 87 | 88 | 89 | if(NOT (res EQUAL 0)) 90 | message( FATAL_ERROR "[MATLAB] TEST FAILED" ) 91 | endif() 92 | -------------------------------------------------------------------------------- /matlab/elements.m: -------------------------------------------------------------------------------- 1 | function el = elements(r, v, mu) 2 | rm = norm(r); 3 | vm = norm(v); 4 | h = cross(r, v); 5 | hm = norm(h); 6 | k = [0.0, 0.0, 1.0]; 7 | n = cross(k, h); 8 | nm = norm(n); 9 | xi = vm^2/2 - mu/rm; 10 | ec = ((vm^2 - mu/rm)*r - v*dot(r,v))/mu; 11 | ecc = norm(ec); 12 | if ecc ~= 1.0 13 | sma = -mu/(2*xi); 14 | else 15 | sma = hm^2/mu; 16 | end 17 | inc = acos(h(3)/hm); 18 | node = acos(n(1)/nm); 19 | peri = acos(dot(n,ec)/(ecc*nm)); 20 | ano = acos(dot(ec,r)/(ecc*rm)); 21 | if n(2) < 0 22 | node = 2*pi - node; 23 | end 24 | if ec(3) < 0 25 | peri = 2*pi - peri; 26 | end 27 | if dot(r,v) < 0 28 | ano = 2*pi - ano; 29 | end 30 | el = [sma, ecc, inc, node, peri, ano]; 31 | -------------------------------------------------------------------------------- /matlab/gravity.m: -------------------------------------------------------------------------------- 1 | function f = gravity(y, mu) 2 | r = norm(y(1:3)); 3 | f(1:3) = y(4:6); 4 | f(4:6) = -mu * y(1:3) / r^3; 5 | end 6 | -------------------------------------------------------------------------------- /matlab/icatt_matlab/icatt_matlab.xcodeproj/project.pbxproj: -------------------------------------------------------------------------------- 1 | // !$*UTF8*$! 2 | { 3 | archiveVersion = 1; 4 | classes = { 5 | }; 6 | objectVersion = 46; 7 | objects = { 8 | 9 | /* Begin PBXFileReference section */ 10 | E8B6F8071DC4DCB1008A6983 /* propagator_module.f90 */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.fortran.f90; name = propagator_module.f90; path = ../propagator_module.f90; sourceTree = ""; }; 11 | E8B6F8081DC4DCB1008A6983 /* propagator.f90 */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.fortran.f90; name = propagator.f90; path = ../propagator.f90; sourceTree = ""; }; 12 | /* End PBXFileReference section */ 13 | 14 | /* Begin PBXGroup section */ 15 | E8B6F8001DC4DC95008A6983 = { 16 | isa = PBXGroup; 17 | children = ( 18 | E8B6F8071DC4DCB1008A6983 /* propagator_module.f90 */, 19 | E8B6F8081DC4DCB1008A6983 /* propagator.f90 */, 20 | ); 21 | sourceTree = ""; 22 | }; 23 | /* End PBXGroup section */ 24 | 25 | /* Begin PBXProject section */ 26 | E8B6F8011DC4DC95008A6983 /* Project object */ = { 27 | isa = PBXProject; 28 | attributes = { 29 | LastUpgradeCheck = 0800; 30 | }; 31 | buildConfigurationList = E8B6F8041DC4DC95008A6983 /* Build configuration list for PBXProject "icatt_matlab" */; 32 | compatibilityVersion = "Xcode 3.2"; 33 | developmentRegion = English; 34 | hasScannedForEncodings = 0; 35 | knownRegions = ( 36 | en, 37 | ); 38 | mainGroup = E8B6F8001DC4DC95008A6983; 39 | projectDirPath = ""; 40 | projectRoot = ""; 41 | targets = ( 42 | ); 43 | }; 44 | /* End PBXProject section */ 45 | 46 | /* Begin XCBuildConfiguration section */ 47 | E8B6F8051DC4DC95008A6983 /* Debug */ = { 48 | isa = XCBuildConfiguration; 49 | buildSettings = { 50 | }; 51 | name = Debug; 52 | }; 53 | E8B6F8061DC4DC95008A6983 /* Release */ = { 54 | isa = XCBuildConfiguration; 55 | buildSettings = { 56 | }; 57 | name = Release; 58 | }; 59 | /* End XCBuildConfiguration section */ 60 | 61 | /* Begin XCConfigurationList section */ 62 | E8B6F8041DC4DC95008A6983 /* Build configuration list for PBXProject "icatt_matlab" */ = { 63 | isa = XCConfigurationList; 64 | buildConfigurations = ( 65 | E8B6F8051DC4DC95008A6983 /* Debug */, 66 | E8B6F8061DC4DC95008A6983 /* Release */, 67 | ); 68 | defaultConfigurationIsVisible = 0; 69 | defaultConfigurationName = Release; 70 | }; 71 | /* End XCConfigurationList section */ 72 | }; 73 | rootObject = E8B6F8011DC4DC95008A6983 /* Project object */; 74 | } 75 | -------------------------------------------------------------------------------- /matlab/icatt_matlab/icatt_matlab.xcodeproj/project.xcworkspace/contents.xcworkspacedata: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /matlab/icatt_matlab/icatt_matlab.xcodeproj/project.xcworkspace/xcuserdata/helge.xcuserdatad/UserInterfaceState.xcuserstate: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OpenAstrodynamics/benchmarks/0fb1012b3639a6d6c53d80cd00b43b72a67b8022/matlab/icatt_matlab/icatt_matlab.xcodeproj/project.xcworkspace/xcuserdata/helge.xcuserdatad/UserInterfaceState.xcuserstate -------------------------------------------------------------------------------- /matlab/icatt_matlab/icatt_matlab.xcodeproj/xcuserdata/helge.xcuserdatad/xcdebugger/Breakpoints_v2.xcbkptlist: -------------------------------------------------------------------------------- 1 | 2 | 5 | 6 | 8 | 14 | 15 | 17 | 19 | 20 | 21 | 23 | 25 | 26 | 27 | 28 | 29 | 37 | 38 | 39 | 40 | 41 | 43 | 53 | 54 | 68 | 69 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | -------------------------------------------------------------------------------- /matlab/icatt_matlab/icatt_matlab.xcodeproj/xcuserdata/helge.xcuserdatad/xcschemes/debug.xcscheme: -------------------------------------------------------------------------------- 1 | 2 | 5 | 8 | 9 | 14 | 15 | 16 | 17 | 18 | 19 | 29 | 32 | 33 | 34 | 35 | 36 | 42 | 43 | 45 | 46 | 49 | 50 | 51 | -------------------------------------------------------------------------------- /matlab/icatt_matlab/icatt_matlab.xcodeproj/xcuserdata/helge.xcuserdatad/xcschemes/xcschememanagement.plist: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | SchemeUserState 6 | 7 | debug.xcscheme 8 | 9 | orderHint 10 | 0 11 | 12 | 13 | 14 | 15 | -------------------------------------------------------------------------------- /matlab/lambert.m: -------------------------------------------------------------------------------- 1 | function [v, v0] = lambert(k, r0, r, tof, short, numiter, rtol) 2 | if short == true 3 | t_m = 1; 4 | else 5 | t_m = -1; 6 | end 7 | 8 | norm_r0 = norm(r0); 9 | norm_r = norm(r); 10 | cos_dnu = dot(r0, r) / (norm_r0 * norm_r); 11 | 12 | A = t_m * sqrt(norm_r * norm_r0 * (1 + cos_dnu)); 13 | 14 | if A == 0 15 | error('Cannot compute orbit, phase angle is 180 degrees'); 16 | end 17 | 18 | psi = 0; 19 | psi_low = -4 * pi; 20 | psi_up = 4 * pi; 21 | 22 | count = 0; 23 | converged = false; 24 | while count < numiter 25 | y = norm_r0 + norm_r + A * (psi * c3(psi) - 1) / sqrt(c2(psi)); 26 | if A > 0 && y < 0 27 | while y < 0 28 | psi_low = psi; 29 | psi = (0.8 * (1.0 / c3(psi)) * ... 30 | (1.0 - (norm_r0 + norm_r) * sqrt(c2(psi)) / A)); 31 | y = norm_r0 + norm_r + A * (psi * c3(psi) - 1) / sqrt(c2(psi)); 32 | end 33 | end 34 | 35 | xi = sqrt(y / c2(psi)); 36 | tof_new = (xi^3 * c3(psi) + A * sqrt(y)) / sqrt(k); 37 | 38 | if abs((tof_new - tof) / tof) < rtol 39 | converged = true; 40 | break 41 | else 42 | count = count + 1; 43 | if tof_new <= tof 44 | psi_low = psi; 45 | else 46 | psi_up = psi; 47 | end 48 | psi = (psi_up + psi_low) / 2; 49 | end 50 | end 51 | 52 | if ~converged 53 | error('Maximum number of iterations reached'); 54 | end 55 | 56 | f = 1 - y / norm_r0; 57 | g = A * sqrt(y / k); 58 | gdot = 1 - y / norm_r; 59 | 60 | v0 = (r - f * r0) / g; 61 | v = (gdot * r - r0) / g; -------------------------------------------------------------------------------- /matlab/mean2ecc.m: -------------------------------------------------------------------------------- 1 | function E = mean2ecc(M, ecc) 2 | keplereq = @(x) x - ecc*sin(x) - M; 3 | keplerderiv = @(x) 1 - ecc*cos(x); 4 | E = newton(M, keplereq, keplerderiv); 5 | -------------------------------------------------------------------------------- /matlab/newton.m: -------------------------------------------------------------------------------- 1 | function p = newton(x0, func, deriv, varargin) 2 | 3 | switch nargin 4 | case 3 5 | maxiter = 50; 6 | tol = 1e-8; 7 | case 4 8 | maxiter = varargin{1}; 9 | tol = 1e-8; 10 | case 5 11 | maxiter = varargin{1}; 12 | tol = varargin{2}; 13 | end 14 | 15 | p0 = x0; 16 | for ii = 1:maxiter 17 | p = p0 - func(p0)/deriv(p0); 18 | if abs(p - p0) < tol 19 | return 20 | end 21 | p0 = p; 22 | end 23 | error('Not converged.'); 24 | -------------------------------------------------------------------------------- /matlab/period.m: -------------------------------------------------------------------------------- 1 | function p = period(sma, mu) 2 | p = 2*pi*sqrt(sma^3/mu); -------------------------------------------------------------------------------- /matlab/propagator.f90: -------------------------------------------------------------------------------- 1 | #include "fintrf.h" 2 | 3 | subroutine mexFunction(nlhs, plhs, nrhs, prhs) 4 | use dopri 5 | use propagator_module 6 | 7 | implicit none 8 | 9 | integer, intent(in) :: nlhs 10 | integer, intent(in) :: nrhs 11 | mwpointer, dimension(*), intent(inout) :: plhs 12 | mwpointer, dimension(*), intent(inout) :: prhs 13 | 14 | mwpointer :: mxGetPr 15 | mwpointer :: mxcreatedoublematrix 16 | integer :: mxIsNumeric 17 | mwpointer :: mxGetM, mxGetN 18 | mwpointer :: mxgetstring 19 | mwpointer :: strlen 20 | mwpointer :: ret 21 | integer :: mxischar 22 | mwsize :: m 23 | mwsize :: n 24 | mwsize :: m_rpar 25 | mwsize :: n_rpar 26 | mwpointer :: out_pr 27 | mwpointer :: y_pr 28 | mwpointer :: t_pr 29 | mwpointer :: tend_pr 30 | mwpointer :: rpar_pr 31 | mwpointer :: locked_pr 32 | integer :: mexislocked 33 | 34 | mwsize, parameter :: one = 1 35 | 36 | integer :: n_ 37 | integer :: lwork 38 | integer :: liwork 39 | integer :: iout 40 | integer :: idid 41 | integer :: itol 42 | integer, dimension(:), allocatable :: iwork 43 | integer, dimension(:), allocatable :: ipar 44 | integer :: lipar 45 | double precision, dimension(:), allocatable :: rtol 46 | double precision, dimension(:), allocatable :: rpar 47 | double precision, dimension(:), allocatable :: atol 48 | double precision, dimension(:), allocatable :: work 49 | double precision, dimension(:), allocatable :: y0 50 | double precision :: tend 51 | double precision :: t 52 | integer :: locked 53 | 54 | if (nrhs == 1) then 55 | locked_pr = mxgetpr(prhs(1)) 56 | call mxcopyptrtointeger4(locked_pr, locked, one) 57 | if (locked == 1 .and. mexislocked() == 0) then 58 | call mexlock() 59 | elseif (locked == 0 .and. mexislocked() == 1) then 60 | call mexunlock() 61 | end if 62 | return 63 | end if 64 | 65 | if (nrhs /= 5) then 66 | call mexErrMsgIdAndTxt ('ICATT:propagator:WrongInput', 'Five inputs required.') 67 | end if 68 | 69 | if (mxischar(prhs(1)) /= 1) then 70 | call mexErrMsgIdAndTxt ('ICATT:propagator:WrongInput', 'First argument must be a function handle.') 71 | end if 72 | strlen = mxGetM(prhs(1))*mxGetN(prhs(1)) 73 | if (strlen > maxhandle) then 74 | call mexErrMsgIdAndTxt ('ICATT:propagator:maxhandle', 'Max string length 32.') 75 | endif 76 | ret = mxgetstring(prhs(1), handle, maxhandle) 77 | 78 | if (mxisnumeric(prhs(2)) /= 1 .and. (mxgetm(prhs(1)) == 1 .and. mxgetn(prhs(1)) == 1)) then 79 | call mexErrMsgIdAndTxt ('ICATT:propagator:WrongInput', 'Second argument must be an array.') 80 | end if 81 | m = mxgetm(prhs(2)) 82 | n = mxgetn(prhs(2)) 83 | y_pr = mxgetpr(prhs(2)) 84 | allocate(y0(m*n)) 85 | call mxcopyptrtoreal8(y_pr, y0, m*n) 86 | 87 | if (mxisnumeric(prhs(3)) /= 1 .and. (mxgetm(prhs(1)) /= 1 .and. mxgetn(prhs(1)) /= 1)) then 88 | call mexErrMsgIdAndTxt ('ICATT:propagator:WrongInput', 'Third argument must be a scalar.') 89 | end if 90 | t_pr = mxgetpr(prhs(3)) 91 | call mxcopyptrtoreal8(t_pr, t, one) 92 | 93 | if (mxisnumeric(prhs(4)) /= 1 .and. (mxgetm(prhs(1)) /= 1 .and. mxgetn(prhs(1)) /= 1)) then 94 | call mexErrMsgIdAndTxt ('ICATT:propagator:WrongInput', 'Fourth argument must be a scalar.') 95 | end if 96 | tend_pr = mxgetpr(prhs(4)) 97 | call mxcopyptrtoreal8(tend_pr, t, one) 98 | 99 | if (mxisnumeric(prhs(5)) /= 1 .and. (mxgetm(prhs(1)) == 1 .and. mxgetn(prhs(1)) == 1)) then 100 | call mexErrMsgIdAndTxt ('ICATT:propagator:WrongInput', 'Fifth argument must be an array.') 101 | end if 102 | m_rpar = mxgetm(prhs(5)) 103 | n_rpar = mxgetn(prhs(5)) 104 | rpar_pr = mxgetpr(prhs(5)) 105 | allocate(rpar(m_rpar*n_rpar)) 106 | call mxcopyptrtoreal8(rpar_pr, rpar, m_rpar*n_rpar) 107 | 108 | n_ = n 109 | lwork = 11*n_ + 8*n_ + 21 110 | liwork = n_ + 21 111 | allocate(work(lwork)) 112 | work = 0d0 113 | allocate(iwork(liwork)) 114 | iwork = 0 115 | allocate(rtol(n_)) 116 | rtol = 1e-6 117 | allocate(atol(n_)) 118 | atol = 1e-8 119 | allocate(ipar(1)) 120 | 121 | call dop853(n_, gravity, t, y0, tend, rtol, atol,& 122 | itol, soldummy, iout, work, lwork, iwork,& 123 | liwork, rpar, ipar, idid) 124 | 125 | if (nlhs == 1) then 126 | plhs(1) = mxcreatedoublematrix(m, n, 0) 127 | out_pr = mxgetpr(plhs(1)) 128 | call mxcopyreal8toptr(y0, out_pr, m*n) 129 | else 130 | call mexErrMsgIdAndTxt ('ICATT:propagator:WrongOutput', 'Wrong number of output arguments.') 131 | end if 132 | end subroutine mexFunction 133 | -------------------------------------------------------------------------------- /matlab/propagator_module.f90: -------------------------------------------------------------------------------- 1 | module propagator_module 2 | 3 | #include "fintrf.h" 4 | 5 | implicit none 6 | 7 | integer, parameter :: maxhandle = 32 8 | character(len=maxhandle) :: handle 9 | 10 | contains 11 | 12 | ! subroutine gravity(n, t, y, f, rpar, ipar) 13 | ! integer, intent(inout) :: n 14 | ! double precision, intent(inout) :: t 15 | ! double precision, dimension(n), intent(inout) :: y 16 | ! double precision, dimension(n), intent(inout) :: f 17 | ! double precision, dimension(:), intent(inout) :: rpar 18 | ! integer, dimension(:),intent(inout) :: ipar 19 | ! 20 | ! double precision :: r 21 | ! 22 | ! r = sqrt(y(1)**2 + y(2)**2 + y(3)**2) 23 | ! f(1) = y(4) 24 | ! f(2) = y(5) 25 | ! f(3) = y(6) 26 | ! 27 | ! f(4) = -rpar(1) * y(1) / r**3 28 | ! f(5) = -rpar(1) * y(2) / r**3 29 | ! f(6) = -rpar(1) * y(3) / r**3 30 | ! end subroutine gravity 31 | 32 | subroutine gravity(n, t, y, f, rpar, ipar) 33 | integer, intent(inout) :: n 34 | double precision, intent(inout) :: t 35 | double precision, dimension(n), intent(inout) :: y 36 | double precision, dimension(n), intent(inout) :: f 37 | double precision, dimension(:), intent(inout) :: rpar 38 | integer, dimension(:),intent(inout) :: ipar 39 | 40 | integer :: ret 41 | integer, parameter :: nlhs = 1 42 | integer, parameter :: nrhs = 2 43 | mwpointer, dimension(nlhs) :: plhs 44 | mwpointer, dimension(nrhs) :: prhs 45 | integer :: mexcallmatlab 46 | mwpointer :: mxcreatedoublematrix 47 | mwpointer :: mxgetpr 48 | mwpointer :: pr 49 | mwsize :: m_ 50 | mwsize :: n_ 51 | mwsize :: mxgetm 52 | mwsize :: mxgetn 53 | 54 | m_ = 1 55 | n_ = n 56 | prhs(1) = mxcreatedoublematrix(m_, n_, 0) 57 | pr = mxgetpr(prhs(1)) 58 | call mxcopyreal8toptr(y, pr, m_*n_) 59 | n_ = 1 60 | prhs(2) = mxcreatedoublematrix(m_, n_, 0) 61 | pr = mxgetpr(prhs(2)) 62 | call mxcopyreal8toptr(rpar(1), pr, m_*n_) 63 | ret = mexcallmatlab(nlhs, plhs, nrhs, prhs, handle) 64 | pr = mxgetpr(plhs(1)) 65 | m_ = mxgetm(plhs(1)) 66 | n_ = mxgetn(plhs(1)) 67 | call mxcopyptrtoreal8(pr, f, m_*n_) 68 | end subroutine gravity 69 | 70 | subroutine soldummy(nr, xold, x, y, n, con, icomp,& 71 | nd, rpar, ipar, irtrn, xout) 72 | integer, intent(inout) :: n 73 | integer, intent(inout) :: nr 74 | integer, intent(inout) :: nd 75 | integer, intent(inout) :: irtrn 76 | integer, dimension(:), intent(inout) :: ipar 77 | integer, dimension(nd), intent(inout) :: icomp 78 | double precision, intent(inout) :: xold 79 | double precision, intent(inout) :: x 80 | double precision, dimension(n), intent(inout) :: y 81 | double precision, dimension(8*nd), intent(inout) :: con 82 | double precision, dimension(:), intent(inout) :: rpar 83 | double precision, intent(inout) :: xout 84 | xout = 0d0 85 | end subroutine soldummy 86 | 87 | end module propagator_module 88 | -------------------------------------------------------------------------------- /matlab/proptest.m: -------------------------------------------------------------------------------- 1 | r = [8.59072560e+02, -4.13720368e+03, 5.29556871e+03]; 2 | v = [7.37289205e+00, 2.08223573e+00, 4.39999794e-01]; 3 | mu = 3.986004418e5; 4 | el = elements(r, v, mu); 5 | tend = period(el(1), mu); 6 | propagator(1) 7 | rv1 = propagator('gravity', [r,v], 0, tend, mu); 8 | propagator(0) 9 | 10 | format long; 11 | disp(rv1) 12 | % exit(0) 13 | -------------------------------------------------------------------------------- /python/icatt/__init__.py: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OpenAstrodynamics/benchmarks/0fb1012b3639a6d6c53d80cd00b43b72a67b8022/python/icatt/__init__.py -------------------------------------------------------------------------------- /python/icatt/build_dopri.py: -------------------------------------------------------------------------------- 1 | from cffi import FFI 2 | import os.path 3 | 4 | libpath = os.path.abspath(os.path.join("..","..","lib","dopri","build")) 5 | includepath = os.path.abspath(os.path.join("..","..","lib","dopri")) 6 | 7 | ffi = FFI() 8 | 9 | ffi.cdef(""" 10 | extern "Python" void solout(int *, double *, double *, double *, int *, double *, 11 | int *, int *, double *, int *, int *, double *); 12 | 13 | void c_dop853( 14 | int *n, 15 | void (*fcn)(int *n, double *x, double *y, double *f, double *rpar, int *ipar), 16 | double *x, 17 | double *y, 18 | double *xend, 19 | double *rtol, 20 | double *atol, 21 | int *itol, 22 | void (*solout)(int *nr, double *xold, double *x, double *y, int *n, double *con, 23 | int *icomp, int *nd, double *rpar, int *ipar, int *irtrn, double *xout), 24 | int *iout, 25 | double *work, 26 | int *lwork, 27 | int *iwork, 28 | int *liwork, 29 | double *rpar, 30 | int *ipar, 31 | int *idid); 32 | """) 33 | 34 | if __name__ == "__main__": 35 | ffi.compile() 36 | -------------------------------------------------------------------------------- /python/icatt/dopri.py: -------------------------------------------------------------------------------- 1 | import sys 2 | import numpy as np 3 | from icatt._dopri import ffi, lib 4 | import icatt.kepler as kepler 5 | import icatt.elements as elements 6 | import time 7 | from numba import cfunc, types, farray 8 | 9 | def benchmark(times): 10 | y = np.array([8.59072560e+02, -4.13720368e+03, 5.29556871e+03, 7.37289205e+00, 2.08223573e+00, 4.39999794e-01]) 11 | y0 = y.copy() 12 | x = 0.0 13 | mu = 3.986004418e5 14 | rpar = np.array([mu]) 15 | el = elements.elements(y[0:3], y[3:], mu) 16 | tp = kepler.period(el[0], mu) 17 | dopri(numba_gravity.cffi, x, y, tp, rpar) 18 | 19 | best = np.inf 20 | worst = -np.inf 21 | total = 0.0 22 | for _ in range(times): 23 | t0 = time.clock() 24 | dopri(numba_gravity.cffi, x, y, tp, rpar) 25 | t1 = time.clock() 26 | x = 0.0 27 | y = y0.copy() 28 | current = t1 - t0 29 | if current < best: 30 | best = current 31 | if current > worst: 32 | worst = current 33 | total += current 34 | print("[",total/times,",",best,",",worst,"]") 35 | 36 | c_sig = types.void( 37 | types.CPointer(types.intc), 38 | types.CPointer(types.double), 39 | types.CPointer(types.double), 40 | types.CPointer(types.double), 41 | types.CPointer(types.double), 42 | types.CPointer(types.intc), 43 | ) 44 | 45 | @cfunc(c_sig) 46 | def numba_gravity(_n, _x, _y, _f, _rpar, _ipar): 47 | n = _n[0] 48 | x = _x[0] 49 | y = farray(_y, 6) 50 | f = farray(_f, 6) 51 | mu = _rpar[0] 52 | 53 | r = np.sqrt(y[0]*y[0]+y[1]*y[1]+y[2]*y[2]) 54 | r3 = r*r*r 55 | f[0] = y[3] 56 | f[1] = y[4] 57 | f[2] = y[5] 58 | f[3] = -mu*y[0]/r3 59 | f[4] = -mu*y[1]/r3 60 | f[5] = -mu*y[2]/r3 61 | 62 | @ffi.def_extern() 63 | def solout(nr, xold, x, y, n, con, icomp, nd, rpar, ipar, irtrn, xout): 64 | pass 65 | 66 | def dopri(func, x, y, xend, rpar, reltol=1e-6, abstol=1e-8): 67 | n = len(y) 68 | lwork = 11*n + 8*n + 21 69 | liwork = n + 21 70 | lwork_ = ffi.new("int *", lwork) 71 | liwork_ = ffi.new("int *", liwork) 72 | work = np.zeros(lwork) 73 | iwork = np.zeros(liwork, dtype=np.int32) 74 | rtol = np.array([reltol]) 75 | atol = np.array([abstol]) 76 | 77 | _n = ffi.new("int *", n) 78 | _x = ffi.new('double *', x) 79 | _xend = ffi.new('double *', xend) 80 | _iout = ffi.new("int *", 0) 81 | _idid = ffi.new("int *", 0) 82 | _itol = ffi.new("int *", 0) 83 | _lwork = ffi.new("int *", lwork) 84 | _liwork = ffi.new("int *", liwork) 85 | _ipar = ffi.new("int []", []) 86 | _y = ffi.cast('double *', y.ctypes.data) 87 | _work = ffi.cast('double *', work.ctypes.data) 88 | _iwork = ffi.cast('int *', iwork.ctypes.data) 89 | _rtol = ffi.cast('double *', rtol.ctypes.data) 90 | _atol = ffi.cast('double *', atol.ctypes.data) 91 | _rpar = ffi.cast('double *', rpar.ctypes.data) 92 | lib.c_dop853(_n, func, _x, _y, _xend, _rtol, _atol, _itol, lib.solout, _iout, _work, _lwork, _iwork, _liwork, _rpar, _ipar, _idid) 93 | -------------------------------------------------------------------------------- /python/icatt/elements.py: -------------------------------------------------------------------------------- 1 | import numpy as np 2 | from numba import njit, jit 3 | import time 4 | 5 | def benchmark(times): 6 | r = np.array([8.59072560e+02, -4.13720368e+03, 5.29556871e+03]) 7 | v = np.array([7.37289205e+00, 2.08223573e+00, 4.39999794e-01]) 8 | mu = 3.986004418e5 9 | el = elements(r, v, mu) 10 | 11 | best = np.inf 12 | worst = -np.inf 13 | total = 0.0 14 | for _ in range(times): 15 | t0 = time.clock() 16 | el = elements(r, v, mu) 17 | t1 = time.clock() 18 | current = t1 - t0 19 | if current < best: 20 | best = current 21 | if current > worst: 22 | worst = current 23 | total += current 24 | print("[",total/times,",",best,",",worst,"]") 25 | 26 | @njit 27 | def elements(r, v, mu): 28 | k = np.zeros(3) 29 | k[2] = 1.0 30 | el = np.empty(6) 31 | r_mag = np.dot(r, r)**(1/2) 32 | v_mag = np.dot(v, v)**(1/2) 33 | h = cross(r, v) 34 | h_mag = np.dot(h, h)**(1/2) 35 | n = cross(k, h) 36 | n_mag = np.dot(n, n)**(1/2) 37 | xi = v_mag ** 2 / 2 - mu / r_mag 38 | e = ((v_mag ** 2 - mu / r_mag) * r - v * np.dot(r, v)) / mu 39 | el[1] = np.dot(e, e)**(1/2) 40 | if not el[1] == 1: 41 | el[0] = - mu / (2 * xi) 42 | else: 43 | el[0] = h_mag ** 2 / mu 44 | el[2] = np.arccos(h[2] / h_mag) 45 | el[3] = np.arctan2(n[1]/h_mag, n[0]/h_mag) 46 | el[4] = np.arccos(np.dot(n, e) / (el[1] * n_mag)) 47 | el[5] = np.arccos(np.dot(e, r) / (el[1] * r_mag)) 48 | # Quadrant checks 49 | if n[1] < 0: 50 | el[3] = 2*np.pi - el[3] 51 | if e[2] < 0: 52 | el[4] = 2*np.pi - el[4] 53 | if np.dot(r, v) < 0: 54 | el[5] = 2*np.pi - el[5] 55 | return el 56 | 57 | @njit 58 | def cross(a, b): 59 | c = np.zeros(3) 60 | c[0] = a[1] * b[2] - a[2] * b[1] 61 | c[1] = a[2] * b[0] - a[0] * b[2] 62 | c[2] = a[0] * b[1] - a[1] * b[0] 63 | return c 64 | -------------------------------------------------------------------------------- /python/icatt/kepler.py: -------------------------------------------------------------------------------- 1 | import numpy as np 2 | from numba import jit, njit 3 | import time 4 | from icatt import elements 5 | 6 | def benchmark(times): 7 | r = np.array([8.59072560e+02, -4.13720368e+03, 5.29556871e+03]) 8 | v = np.array([7.37289205e+00, 2.08223573e+00, 4.39999794e-01]) 9 | tof = 3600.0 10 | mu = 3.986004418e5 11 | el = elements.elements(r, v, mu) 12 | mean2ecc(np.pi/2, el[1]) 13 | 14 | best = np.inf 15 | worst = -np.inf 16 | total = 0.0 17 | for _ in range(times): 18 | t0 = time.clock() 19 | mean2ecc(np.pi/2, el[1]) 20 | t1 = time.clock() 21 | current = t1 - t0 22 | if current < best: 23 | best = current 24 | if current > worst: 25 | worst = current 26 | total += current 27 | print("[",total/times,",",best,",",worst,"]") 28 | 29 | # @jit 30 | def newton(x0, func, derivative, maxiter=50, tol=1e-8): 31 | p0 = x0 32 | for _ in range(maxiter): 33 | p = p0 - func(p0)/derivative(p0) 34 | if np.abs(p - p0) < tol: 35 | return p 36 | p0 = p 37 | raise RuntimeError("Not converged.") 38 | 39 | # @jit 40 | def mean2ecc(M, ecc): 41 | def keplereq(E): 42 | return E - ecc*np.sin(E) - M 43 | def keplerderiv(E): 44 | return 1 - ecc*np.cos(E) 45 | return newton(M, keplereq, keplerderiv) 46 | 47 | @njit 48 | def period(a, mu): 49 | return 2*np.pi*np.sqrt(a**3/mu) 50 | 51 | -------------------------------------------------------------------------------- /python/icatt/lambert.py: -------------------------------------------------------------------------------- 1 | import time 2 | import numpy as np 3 | from math import gamma 4 | 5 | from numba import jit, njit 6 | 7 | def benchmark(times): 8 | r0 = np.array([5000.0, 10000.0, 2100.0]) 9 | r = np.array([-14600.0, 2500.0, 7000.0]) 10 | tof = 3600.0 11 | mu = 3.986004418e5 12 | lambert(mu, r0, r, tof) 13 | 14 | best = np.inf 15 | worst = -np.inf 16 | total = 0.0 17 | for _ in range(times): 18 | t0 = time.clock() 19 | lambert(mu, r0, r, tof) 20 | t1 = time.clock() 21 | current = t1 - t0 22 | if current < best: 23 | best = current 24 | if current > worst: 25 | worst = current 26 | total += current 27 | print("[",total/times,",",best,",",worst,"]") 28 | 29 | @njit 30 | def lambert(k, r0, r, tof, short=True, numiter=35, rtol=1e-8): 31 | if short: 32 | t_m = +1 33 | else: 34 | t_m = -1 35 | 36 | norm_r0 = np.dot(r0, r0)**.5 37 | norm_r = np.dot(r, r)**.5 38 | cos_dnu = np.dot(r0, r) / (norm_r0 * norm_r) 39 | 40 | A = t_m * (norm_r * norm_r0 * (1 + cos_dnu))**.5 41 | 42 | if A == 0.0: 43 | raise RuntimeError("Cannot compute orbit, phase angle is 180 degrees") 44 | 45 | psi = 0.0 46 | psi_low = -4 * np.pi 47 | psi_up = 4 * np.pi 48 | 49 | count = 0 50 | while count < numiter: 51 | y = norm_r0 + norm_r + A * (psi * c3(psi) - 1) / c2(psi)**.5 52 | if A > 0.0 and y < 0.0: 53 | # Readjust xi_low until y > 0.0 54 | # Translated directly from Vallado 55 | while y < 0.0: 56 | psi_low = psi 57 | psi = (0.8 * (1.0 / c3(psi)) * 58 | (1.0 - (norm_r0 + norm_r) * np.sqrt(c2(psi)) / A)) 59 | y = norm_r0 + norm_r + A * (psi * c3(psi) - 1) / c2(psi)**.5 60 | 61 | xi = np.sqrt(y / c2(psi)) 62 | tof_new = (xi**3 * c3(psi) + A * np.sqrt(y)) / np.sqrt(k) 63 | 64 | # Convergence check 65 | if np.abs((tof_new - tof) / tof) < rtol: 66 | break 67 | else: 68 | count += 1 69 | # Bisection check 70 | if tof_new <= tof: 71 | psi_low = psi 72 | else: 73 | psi_up = psi 74 | psi = (psi_up + psi_low) / 2 75 | else: 76 | raise RuntimeError("Maximum number of iterations reached") 77 | 78 | f = 1 - y / norm_r0 79 | g = A * np.sqrt(y / k) 80 | 81 | gdot = 1 - y / norm_r 82 | 83 | v0 = (r - f * r0) / g 84 | v = (gdot * r - r0) / g 85 | 86 | return v0, v 87 | 88 | @njit('f8(f8)') 89 | def c2(psi): 90 | r"""Second Stumpff function. 91 | For positive arguments: 92 | .. math:: 93 | c_2(\psi) = \frac{1 - \cos{\sqrt{\psi}}}{\psi} 94 | """ 95 | eps = 1.0 96 | if psi > eps: 97 | res = (1 - np.cos(np.sqrt(psi))) / psi 98 | elif psi < -eps: 99 | res = (np.cosh(np.sqrt(-psi)) - 1) / (-psi) 100 | else: 101 | res = 1.0 / 2.0 102 | delta = (-psi) / gamma(2 + 2 + 1) 103 | k = 1 104 | while res + delta != res: 105 | res = res + delta 106 | k += 1 107 | delta = (-psi) ** k / gamma(2 * k + 2 + 1) 108 | 109 | return res 110 | 111 | 112 | @njit('f8(f8)') 113 | def c3(psi): 114 | r"""Third Stumpff function. 115 | For positive arguments: 116 | .. math:: 117 | c_3(\psi) = \frac{\sqrt{\psi} - \sin{\sqrt{\psi}}}{\sqrt{\psi^3}} 118 | """ 119 | eps = 1.0 120 | if psi > eps: 121 | res = (np.sqrt(psi) - np.sin(np.sqrt(psi))) / (psi * np.sqrt(psi)) 122 | elif psi < -eps: 123 | res = (np.sinh(np.sqrt(-psi)) - np.sqrt(-psi)) / (-psi * np.sqrt(-psi)) 124 | else: 125 | res = 1.0 / 6.0 126 | delta = (-psi) / gamma(2 + 3 + 1) 127 | k = 1 128 | while res + delta != res: 129 | res = res + delta 130 | k += 1 131 | delta = (-psi) ** k / gamma(2 * k + 3 + 1) 132 | 133 | return res 134 | -------------------------------------------------------------------------------- /python/main.py: -------------------------------------------------------------------------------- 1 | import icatt.elements 2 | import icatt.kepler 3 | import icatt.lambert 4 | import icatt.dopri 5 | 6 | times = 100000 7 | 8 | if __name__ == "__main__": 9 | icatt.elements.benchmark(times) 10 | icatt.kepler.benchmark(times) 11 | icatt.lambert.benchmark(times) 12 | icatt.dopri.benchmark(times) 13 | --------------------------------------------------------------------------------