diff --git a/.gitmodules b/.gitmodules index 48b9f92d72..3e62f206d3 100644 --- a/.gitmodules +++ b/.gitmodules @@ -37,3 +37,7 @@ [submodule "external/spdlog"] path = external/spdlog url = https://github.com/gabime/spdlog.git +[submodule "external/sundials"] + path = external/sundials + url = https://github.com/neuronsimulator/sundials.git + branch = hines/hoc_pow diff --git a/CMakeLists.txt b/CMakeLists.txt index 8fc7484313..d379908872 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -596,6 +596,24 @@ cpp_cc_git_submodule(CLI11 BUILD PACKAGE CLI11 REQUIRED) # coreneuron targets will get propagated down from the subdirectory +# ============================================================================= +# Enable NRN_DIGEST +# ============================================================================= +if(NRN_ENABLE_DIGEST) + set(NRN_DIGEST 1) +else() + set(NRN_DIGEST 0) +endif() + +# ============================================================================= +# Enable NRN_ARCH_INDEP_EXP_POW +# ============================================================================= +if(NRN_ENABLE_ARCH_INDEP_EXP_POW) + set(NRN_ARCH_INDEP_EXP_POW 1) +else() + set(NRN_ARCH_INDEP_EXP_POW 0) +endif() + # ============================================================================= # Enable NMODL code-generator support # ============================================================================= @@ -949,21 +967,42 @@ add_custom_target( COMMAND ${PROJECT_SOURCE_DIR}/external/coding-conventions/bin/format WORKING_DIRECTORY ${PROJECT_SOURCE_DIR}) -# Prepare a shell script to format only files modified with respect to master branch +# Prepare a shell script to format only files modified with respect to master/main branch that still +# exist on disk (filters out deleted files). file( WRITE ${CMAKE_CURRENT_BINARY_DIR}/format-pr.sh - "\ -#!bash\n\ -set -e\n\ -cmd='cd ${PROJECT_SOURCE_DIR} && external/coding-conventions/bin/format `git diff --name-only master`'\n\ -echo $cmd\n\ -cd ${PROJECT_SOURCE_DIR} && external/coding-conventions/bin/format `git diff --name-only master`\n\ + "#!/bin/bash +set -euo pipefail + +# Try 'main' first, then fall back to 'master' +for base in main master; do + if git rev-parse --verify \"\$base\" >/dev/null 2>&1; then + BASE_BRANCH=\"\$base\" + break + fi +done + +if [ -z \"\${BASE_BRANCH:-}\" ]; then + echo \"Error: Neither 'main' nor 'master' branch found.\" >&2 + exit 1 +fi + +echo \"Formatting changes vs '\$BASE_BRANCH' (existing files only)...\" >&2 + +# Get changed files, but only pass files that still exist +git diff --name-only \"\$BASE_BRANCH\" | \\ +while read -r file; do + if [ -e \"\$file\" ]; then + printf '%s\\n' \"\$file\" + fi +done | \\ +xargs --no-run-if-empty external/coding-conventions/bin/format \"\$@\" ") add_custom_target( format-pr COMMAND bash ${CMAKE_CURRENT_BINARY_DIR}/format-pr.sh - COMMENT "Format only files modified with respect to master branch." + COMMENT "Format only files modified with respect to main/master (existing files only)" WORKING_DIRECTORY ${PROJECT_SOURCE_DIR}) # ============================================================================= diff --git a/cmake/ConfigFileSetting.cmake b/cmake/ConfigFileSetting.cmake index 2c42b0a722..2423bca552 100644 --- a/cmake/ConfigFileSetting.cmake +++ b/cmake/ConfigFileSetting.cmake @@ -156,8 +156,6 @@ configure_file("${PROJECT_SOURCE_DIR}/src/nrnoc/nrnconfigargs.h.in" "${PROJECT_BINARY_DIR}/src/nrnoc/nrnconfigargs.h" @ONLY) configure_file("${PROJECT_SOURCE_DIR}/src/nrncvode/nrnneosm.h.in" "${PROJECT_BINARY_DIR}/src/nrncvode/nrnneosm.h" @ONLY) -configure_file("${PROJECT_SOURCE_DIR}/src/sundials/sundials_config.h.in" - "${PROJECT_BINARY_DIR}/src/sundials/sundials_config.h" @ONLY) configure_file("${PROJECT_SOURCE_DIR}/share/lib/nrn.defaults.in" "${PROJECT_BINARY_DIR}/share/nrn/lib/nrn.defaults" @ONLY) diff --git a/cmake/NeuronFileLists.cmake b/cmake/NeuronFileLists.cmake index ca60833d2e..40a8ffe708 100644 --- a/cmake/NeuronFileLists.cmake +++ b/cmake/NeuronFileLists.cmake @@ -266,45 +266,6 @@ set(NRNCVODE_FILE_LIST occvode.cpp tqueue.cpp) -# ============================================================================= -# Files in sundials directory -# ============================================================================= -nrn_create_file_list( - SUNDIALS_CVODES - "${PROJECT_SOURCE_DIR}/src/sundials/cvodes" - cvband.c - cvbandpre.c - cvbbdpre.c - cvdense.c - cvdiag.c - cvodea.c - cvodes.c - cvodesio.c - cvspgmr.c) - -nrn_create_file_list( - SUNDIALS_IDA - "${PROJECT_SOURCE_DIR}/src/sundials/ida" - idaband.c - idabbdpre.c - ida.c - idadense.c - idaic.c - idaio.c - idaspgmr.c) -nrn_create_file_list( - SUNDIALS_SHARED - "${PROJECT_SOURCE_DIR}/src/sundials/shared" - band.c - dense.c - iterative.c - nvector.c - nvector_serial.c - smalldense.c - spgmr.c - sundialsmath.c) -set(NRN_SUNDIALS_SRC_FILES ${SUNDIALS_CVODES} ${SUNDIALS_IDA} ${SUNDIALS_SHARED}) - set(SPARSE_FILES_LIST bksub.cpp getelm.cpp lineq.cpp prmat.cpp subrows.cpp) # scopmath sources @@ -446,9 +407,7 @@ nrn_create_file_list(NRN_NRNIV_SRC_FILES ${NRN_NRNIV_SRC_DIR} ${NRNIV_FILE_LIST} nrn_create_file_list(NRN_PARALLEL_SRC_FILES ${NRN_PARALLEL_SRC_DIR} ${NRN_PARALLEL_FILES_LIST}) if(NRN_ENABLE_MPI) nrn_create_file_list(NRN_PARALLEL_SRC_FILES ${PROJECT_SOURCE_DIR}/src/nrniv - nvector_nrnparallel_ld.cpp) - nrn_create_file_list(NRN_PARALLEL_SRC_FILES ${PROJECT_SOURCE_DIR}/src/sundials/shared - nvector_parallel.c) + nvector_nrnparallel_ld.cpp nvector_parallel.cpp) endif() nrn_create_file_list(NRN_SPARSE_SRC_FILES ${PROJECT_SOURCE_DIR}/src/sparse ${SPARSE_FILES_LIST}) nrn_create_file_list(NRN_SCOPMATH_SRC_FILES ${PROJECT_SOURCE_DIR}/src/scopmath diff --git a/cmake/modules/FindSUNDIALS.cmake b/cmake/modules/FindSUNDIALS.cmake new file mode 100644 index 0000000000..f166cbe05a --- /dev/null +++ b/cmake/modules/FindSUNDIALS.cmake @@ -0,0 +1,54 @@ +# cmake/modules/FindSUNDIALS.cmake + +set(SUNDIALS_SOURCE_DIR "${PROJECT_SOURCE_DIR}/external/sundials") + +# Use the same pattern as other submodules in NEURON +if(NOT EXISTS "${SUNDIALS_SOURCE_DIR}/CMakeLists.txt") + message(STATUS "SUNDIALS submodule not found.") + include(${PROJECT_SOURCE_DIR}/cmake/ExternalProjectHelper.cmake) + nrn_initialize_submodule(external/sundials) +endif() + +if(NOT EXISTS "${SUNDIALS_SOURCE_DIR}/CMakeLists.txt") + message(FATAL_ERROR "Failed to initialize SUNDIALS submodule") +endif() + +set(SUNDIALS_PREFIX "${CMAKE_BINARY_DIR}/external/sundials") +set(SUNDIALS_INCLUDE_DIR "${SUNDIALS_PREFIX}/include") +set(SUNDIALS_LIB_DIR "${SUNDIALS_PREFIX}/lib") + +include(ExternalProject) +ExternalProject_Add( + sundials + SOURCE_DIR "${SUNDIALS_SOURCE_DIR}" + PREFIX "${SUNDIALS_PREFIX}" + CMAKE_ARGS -DCMAKE_INSTALL_PREFIX= + -DCMAKE_C_COMPILER=${CMAKE_C_COMPILER} + -DCMAKE_CXX_COMPILER=${CMAKE_CXX_COMPILER} + -DCMAKE_BUILD_TYPE=${CMAKE_BUILD_TYPE} + -DCMAKE_POSITION_INDEPENDENT_CODE=ON + -DBUILD_SHARED_LIBS=OFF + -DEXAMPLES_ENABLE_C=OFF + -DEXAMPLES_INSTALL=OFF + -DBUILD_ARKODE=OFF + -DBUILD_CVODES=OFF + -DBUILD_IDAS=OFF + -DBUILD_KINSOL=OFF + -DMPI_ENABLE=OFF + -DPTHREAD_ENABLE=ON + -DSUNDIALS_PRECISION=double + -DUSE_GENERIC_MATH=ON + BUILD_BYPRODUCTS + /lib/libsundials_cvode.a /lib/libsundials_ida.a + /lib/libsundials_nvecserial.a /lib/libsundials_nvecpthreads.a + INSTALL_DIR "${SUNDIALS_PREFIX}") + +add_library(SUNDIALS INTERFACE IMPORTED) +add_dependencies(SUNDIALS sundials) + +set(SUNDIALS_INCLUDE_DIR + "${SUNDIALS_INCLUDE_DIR}" + PARENT_SCOPE) +set(SUNDIALS_LIB_DIR + "${SUNDIALS_LIB_DIR}" + PARENT_SCOPE) diff --git a/cmake_nrnconf.h.in b/cmake_nrnconf.h.in index 3c7851c6d5..44bbd0682d 100644 --- a/cmake_nrnconf.h.in +++ b/cmake_nrnconf.h.in @@ -88,12 +88,6 @@ /* Define to the version of this package. */ #cmakedefine PACKAGE_VERSION @PACKAGE_VERSION@ -/* Define SUNDIALS data type 'realtype' as 'long double' */ -#cmakedefine SUNDIALS_DOUBLE_PRECISION @SUNDIALS_DOUBLE_PRECISION@ - -/* Use generic math functions */ -#cmakedefine SUNDIALS_USE_GENERIC_MATH @SUNDIALS_USE_GENERIC_MATH@ - /* Version number of package */ #cmakedefine VERSION @VERSION@ diff --git a/docs/install/debug.md b/docs/install/debug.md index e3ae5fb877..e6dc67c8c8 100644 --- a/docs/install/debug.md +++ b/docs/install/debug.md @@ -241,6 +241,27 @@ NMODL supports the sanitizers in a similar way, but this has to be enabled explicitly: `-DNRN_SANITIZERS=undefined` will also compile NMODL code with UBSan enabled. +#### Updating rxd test data for new versions of CVode + +Updates to new versions of SUNDIALS integrators produce different, +but presumably as accurate, results. These differences can cause CI failures. +A method to update rxd test data is, from the top level nrn folder: +``` +nrnivmodl test/rxd/*.mod +PYTHONPATH=./test/rxd:$PYTHONPATH pytest -s ./test/rxd/ --save ./test/rxd/testdata/tests +python share/lib/python/neuron/rxdtests/run_all.py +cp -r ./share/lib/python/neuron/rxdtests/test_data/* ./test/rxd/testdata/rxdtests/ +cp -r ./test/rxd/testdata/tests/* ./test/rxd/testdata/test +rm -r -f ./test/rxd/testdata/tests +(cd share/lib/python/neuron/tests; python test_rxd.py --save test_rxd.json) +``` +When everything is working again, cd to test/rxd/testdata, start a new branch, +commit, and push to ``https://github.com/neuronsimulator/rxdtestdata``. +Individual rxd tests can be run, e.g., by +``` +PYTHONPATH=./test/rxd:$PYTHONPATH pytest -s ./test/rxd/3d/test_ics_currents.py +``` + Profiling and performance benchmarking -------------------------------------- diff --git a/docs/progref/simctrl/cvode.rst b/docs/progref/simctrl/cvode.rst index 09f7982c33..19c46d73f5 100644 --- a/docs/progref/simctrl/cvode.rst +++ b/docs/progref/simctrl/cvode.rst @@ -273,6 +273,34 @@ CVode +.. method:: CVode.version + + .. tab:: Python + + + Syntax: + ``"major.minor.patch" = cvode.version()`` + + + Description: + Returns the version string. Eg. "3.2.1" + + + .. tab:: HOC + + + Syntax: + ``"major.minor.patch" = cvode.version()`` + + + Description: + Returns the version string. Eg. "3.2.1" + + +---- + + + .. method:: CVode.spike_stat .. tab:: Python diff --git a/external/coding-conventions b/external/coding-conventions index f1915f5d4f..bb6e9a773d 160000 --- a/external/coding-conventions +++ b/external/coding-conventions @@ -1 +1 @@ -Subproject commit f1915f5d4f169569de9144c13d58afe20a1ea73e +Subproject commit bb6e9a773d75d0d05118568db7e1136703be7bf9 diff --git a/external/sundials b/external/sundials new file mode 160000 index 0000000000..71b3daec18 --- /dev/null +++ b/external/sundials @@ -0,0 +1 @@ +Subproject commit 71b3daec18ce66a7c011be9501a31567aa5c09b6 diff --git a/share/lib/python/neuron/rxdtests/tests/hybrid/bistable_hybrid.py b/share/lib/python/neuron/rxdtests/tests/hybrid/bistable_hybrid.py index 32480d98bb..f8a984f524 100644 --- a/share/lib/python/neuron/rxdtests/tests/hybrid/bistable_hybrid.py +++ b/share/lib/python/neuron/rxdtests/tests/hybrid/bistable_hybrid.py @@ -28,10 +28,12 @@ ca = rxd.Species( r, d=diff_constant, - initial=lambda node: 1 - if (0.8 < node.x and node.segment in dend1) - or (node.x < 0.2 and node.segment in dend2) - else 0, + initial=lambda node: ( + 1 + if (0.8 < node.x and node.segment in dend1) + or (node.x < 0.2 and node.segment in dend2) + else 0 + ), ) bistable_reaction = rxd.Rate(ca, -ca * (1 - ca) * (0.01 - ca)) h.finitialize() diff --git a/share/lib/python/neuron/rxdtests/tests/hybrid/bistable_hybrid_change_nthread.py b/share/lib/python/neuron/rxdtests/tests/hybrid/bistable_hybrid_change_nthread.py index 651f6cde2f..8287c9ccfd 100644 --- a/share/lib/python/neuron/rxdtests/tests/hybrid/bistable_hybrid_change_nthread.py +++ b/share/lib/python/neuron/rxdtests/tests/hybrid/bistable_hybrid_change_nthread.py @@ -28,10 +28,12 @@ ca = rxd.Species( r, d=diff_constant, - initial=lambda node: 1 - if (0.8 < node.x and node.segment in dend1) - or (node.x < 0.2 and node.segment in dend2) - else 0, + initial=lambda node: ( + 1 + if (0.8 < node.x and node.segment in dend1) + or (node.x < 0.2 and node.segment in dend2) + else 0 + ), ) bistable_reaction = rxd.Rate(ca, -ca * (1 - ca) * (0.01 - ca)) h.finitialize() diff --git a/share/lib/python/neuron/rxdtests/tests/hybrid/bistable_hybrid_cvode.py b/share/lib/python/neuron/rxdtests/tests/hybrid/bistable_hybrid_cvode.py index 5048d8fc9b..cf7a1c19fd 100644 --- a/share/lib/python/neuron/rxdtests/tests/hybrid/bistable_hybrid_cvode.py +++ b/share/lib/python/neuron/rxdtests/tests/hybrid/bistable_hybrid_cvode.py @@ -28,10 +28,12 @@ r, d=diff_constant, atolscale=0.1, - initial=lambda node: 1 - if (0.8 < node.x and node.segment in dend1) - or (node.x < 0.2 and node.segment in dend2) - else 0, + initial=lambda node: ( + 1 + if (0.8 < node.x and node.segment in dend1) + or (node.x < 0.2 and node.segment in dend2) + else 0 + ), ) bistable_reaction = rxd.Rate(ca, -ca * (1 - ca) * (0.01 - ca)) h.finitialize() diff --git a/share/lib/python/neuron/rxdtests/tests/hybrid/bistable_hybrid_cvode_change_nthread.py b/share/lib/python/neuron/rxdtests/tests/hybrid/bistable_hybrid_cvode_change_nthread.py index adc7bc98e5..00cbe89341 100644 --- a/share/lib/python/neuron/rxdtests/tests/hybrid/bistable_hybrid_cvode_change_nthread.py +++ b/share/lib/python/neuron/rxdtests/tests/hybrid/bistable_hybrid_cvode_change_nthread.py @@ -28,10 +28,12 @@ r, d=diff_constant, atolscale=0.1, - initial=lambda node: 1 - if (0.8 < node.x and node.segment in dend1) - or (node.x < 0.2 and node.segment in dend2) - else 0, + initial=lambda node: ( + 1 + if (0.8 < node.x and node.segment in dend1) + or (node.x < 0.2 and node.segment in dend2) + else 0 + ), ) bistable_reaction = rxd.Rate(ca, -ca * (1 - ca) * (0.01 - ca)) h.finitialize() diff --git a/share/lib/python/neuron/rxdtests/tests/hybrid/pure_diffusion_hybrid.py b/share/lib/python/neuron/rxdtests/tests/hybrid/pure_diffusion_hybrid.py index 4f707c23dc..46d0ab30bc 100644 --- a/share/lib/python/neuron/rxdtests/tests/hybrid/pure_diffusion_hybrid.py +++ b/share/lib/python/neuron/rxdtests/tests/hybrid/pure_diffusion_hybrid.py @@ -34,10 +34,12 @@ ca = rxd.Species( r, d=diff_constant, - initial=lambda node: 1 - if (0.8 < node.x and node.segment in dend1) - or (node.x < 0.2 and node.segment in dend2) - else 0, + initial=lambda node: ( + 1 + if (0.8 < node.x and node.segment in dend1) + or (node.x < 0.2 and node.segment in dend2) + else 0 + ), ) h.finitialize() initial_amount = ( diff --git a/share/lib/python/neuron/rxdtests/tests/hybrid/pure_diffusion_hybrid_cvode.py b/share/lib/python/neuron/rxdtests/tests/hybrid/pure_diffusion_hybrid_cvode.py index 3aa76f3f25..012f7aca4e 100644 --- a/share/lib/python/neuron/rxdtests/tests/hybrid/pure_diffusion_hybrid_cvode.py +++ b/share/lib/python/neuron/rxdtests/tests/hybrid/pure_diffusion_hybrid_cvode.py @@ -34,10 +34,12 @@ ca = rxd.Species( r, d=diff_constant, - initial=lambda node: 1 - if (0.8 < node.x and node.segment in dend1) - or (node.x < 0.2 and node.segment in dend2) - else 0, + initial=lambda node: ( + 1 + if (0.8 < node.x and node.segment in dend1) + or (node.x < 0.2 and node.segment in dend2) + else 0 + ), ) h.finitialize() initial_amount = ( diff --git a/share/lib/python/neuron/tests/test_all.py b/share/lib/python/neuron/tests/test_all.py index 7af6d620e0..53eb052a6e 100644 --- a/share/lib/python/neuron/tests/test_all.py +++ b/share/lib/python/neuron/tests/test_all.py @@ -4,7 +4,6 @@ $Id$ """ - # import your specific test here # and add it to the "suite" function below from neuron.tests import test_vector, test_neuron diff --git a/share/lib/python/neuron/tests/test_rxd.json b/share/lib/python/neuron/tests/test_rxd.json index 85e041f995..b4977848d7 100644 --- a/share/lib/python/neuron/tests/test_rxd.json +++ b/share/lib/python/neuron/tests/test_rxd.json @@ -108,205 +108,228 @@ 1.0, 1.0, 0.9999999999993757, - 0.999999999994894, - 0.9999999999684935, - 0.9999999997476527, - 0.9999999928933891, - 0.9999999611564773, - 0.9999998797767268, - 0.9999996998881439, - 0.9999993374567407, - 0.9999984853833065, - 0.9999969740580187, - 0.9999944882384337, - 0.999990631594901, - 0.9999849509581288, - 0.9999769206381163, - 0.9999582122018839, - 0.99992971528816, - 0.9998885520830331, - 0.9998315279906315, - 0.9996818635176349, - 0.9994522087548297, - 0.9991215537513378, - 0.9986688188931263, - 0.9980737640971887, - 0.9973169807956457, - 0.9963810719470815, - 0.9952501731851596, - 0.9939108695612834, - 0.9923517494757513, - 0.990563762843154, - 0.9885402079277492, - 0.9862765182500737, - 0.9837701825347182, - 0.9810207339245086, - 0.9780291325294735, - 0.9747989764631944, - 0.9713343413786614, - 0.9676399370120405, - 0.961066451151739, - 0.9539287981955907, - 0.9462557577841545, - 0.9380908351574285, - 0.9295048630248105, - 0.9272938750656939, - 0.9250579717836777, - 0.9227970935562565, - 0.916466538640017, - 0.9099911643714976, - 0.903362145740033, - 0.896607665570261, - 0.8897506341029571, - 0.882783639668767, - 0.875743025331908, - 0.8686235564310014, - 0.8614266253277882, - 0.8541863694353786, - 0.8468993821613305, - 0.8395705411269264, - 0.8322240727536439, - 0.8248512178576504, - 0.8174717412783322, - 0.8101012803420092, - 0.8027295128162794, - 0.795382570912665, - 0.7880520562862553, - 0.7807347758418224, - 0.7734449586662135, - 0.7661975818043348, - 0.7589799271016704, - 0.7518171027828684, - 0.7446977692713531, - 0.7376160661849058, - 0.7305954685552188, - 0.7236266087584206, - 0.7167068363521265, - 0.7140993659873981, - 0.7115003569088247, - 0.7053989759513706, - 0.6937157033260776, - 0.6892286429757224, - 0.6847738597616794, - 0.680346043973446, - 0.6736943892225341, - 0.6671180984407125, - 0.662236424428377, - 0.6573969190546712, - 0.6525933206930011, - 0.6478347503609198, - 0.6431166994074956, - 0.6384369406609263, - 0.629051615757503, - 0.6198222188768284, - 0.6175428046075583, - 0.6152735586037428, - 0.6111170811525735, - 0.6031212235932468, - 0.5952593537962105, - 0.5921305073271925, - 0.589021543706074, - 0.5843049292559478, - 0.5796335964525046, - 0.57501603797955, - 0.5704420014938749, - 0.5659178448897603, - 0.5614455517225058, - 0.5591788147005415, - 0.5569248277948933, - 0.5506074431348664, - 0.5478382336692825, - 0.5450878675432425, - 0.5387888979259772, - 0.5362404522913171, - 0.5337094641249713, - 0.5282374991063938, - 0.5259248453123049, - 0.5236262813729924, - 0.5182614252948405, - 0.5158555311460749, - 0.5134660721175922, - 0.5077709278071862, - 0.5053179819941784, - 0.5028817741460606, - 0.49744076421889366, - 0.49520127183112733, - 0.4929770110029178, - 0.4880637158772831, - 0.4859684631915766, - 0.4838861487508862, - 0.4790294757925702, - 0.47687065162757547, - 0.47472669028331466, - 0.4696849124713687, - 0.4675266379954105, - 0.4653827515472591, - 0.46059622403775785, - 0.45860850681188087, - 0.4566341643290534, - 0.45222826180913167, - 0.4503369914749967, - 0.4484573582920104, - 0.4440766399353272, - 0.44214365209440704, - 0.4402239033393764, - 0.4357529446107943, - 0.4338466468246234, - 0.4319526748954548, - 0.42771940093115685, - 0.4259480291636831, - 0.42418839478752657, - 0.4202300998323772, - 0.4185239107729718, - 0.4168280791675472, - 0.4128821813954716, - 0.411151841187283, - 0.40943320175716824, - 0.4054591322631254, - 0.4037685048216922, - 0.40208843869666, - 0.39832558823662206, - 0.39674079574945603, - 0.3951663234845347, - 0.3916025661247801, - 0.3900627879465062, - 0.38853217065630374, - 0.3849784483231059, - 0.38342810283841006, - 0.38188806435279576, - 0.3783453864065237, - 0.37683971858666915, - 0.3753431215943966, - 0.37198272430919915, - 0.3705596473205069, - 0.369145673011817, - 0.36593017118156906, - 0.36453932880580625, - 0.363156559348617, - 0.35995389116692217, - 0.358562523467025, - 0.3571802314864285, - 0.35401195406372227, - 0.3526654576925955, - 0.35132677928092004, - 0.34831289231094187, - 0.34703074630323383, - 0.3457566587383628, - 0.3428492728160761, - 0.34159142512656304, - 0.34034067750180974, - 0.3374508889913977, - 0.33619956600663337, - 0.3349562466940476, - 0.33211336362253635, - 0.3309044582410871, - 0.3297023177069934, - 0.32698870975793815, - 0.32583004833643353, - 0.3246785486149972, - 0.322044467574018, - 0.3209052709390766, - 0.31977231337146067 + 0.9999999999894409, + 0.9999999999550113, + 0.9999999997280682, + 0.9999999932594862, + 0.999999963565181, + 0.999999879051457, + 0.9999996903731311, + 0.9999993269056797, + 0.9999986938393194, + 0.9999976700341591, + 0.9999961065733645, + 0.9999938259203998, + 0.9999885916124751, + 0.9999804962834329, + 0.9999685894625532, + 0.9999379930833431, + 0.9998887533451937, + 0.9998147574682218, + 0.9997092567862199, + 0.9995650490373857, + 0.9993746598975806, + 0.9991305059716021, + 0.9988250363541501, + 0.9984507880853333, + 0.9975710053720631, + 0.9964010628233997, + 0.9949057829287157, + 0.9930561570820573, + 0.9908299893607008, + 0.9882110125393375, + 0.9851895645044806, + 0.9817614536615098, + 0.9779280048093564, + 0.9736949470943007, + 0.9690722122610816, + 0.9640729984163102, + 0.9587132800443576, + 0.9530111935391532, + 0.9469864984165428, + 0.9406602255450501, + 0.9340541823498337, + 0.9234107722688943, + 0.9122388200147565, + 0.9093727821993881, + 0.9064799631540225, + 0.9035615810540444, + 0.900618623411361, + 0.8976523593935569, + 0.8946638289754341, + 0.8916542714105095, + 0.8886247094042927, + 0.8855762986426554, + 0.8825100464335266, + 0.8794270279807733, + 0.8763282542446145, + 0.8732147169782779, + 0.8700874344716201, + 0.8669473048234805, + 0.8637953552076854, + 0.8606323844566668, + 0.8574594326414777, + 0.854277196659432, + 0.8510867326970226, + 0.847888633527462, + 0.844683973470979, + 0.8414732398876719, + 0.8382575268730721, + 0.8350372162015343, + 0.831813423075091, + 0.8285864243050303, + 0.8253573571339858, + 0.8221263946474449, + 0.8188946967433766, + 0.8156623345615928, + 0.8124304910245961, + 0.8091991375529438, + 0.8059694802495337, + 0.8027413933919186, + 0.7995161062371356, + 0.7962933987707094, + 0.7930745232279782, + 0.7898591683644874, + 0.7866486090948065, + 0.7834424461611658, + 0.7802419767567521, + 0.7770467169336364, + 0.7738579856804328, + 0.7706752177481925, + 0.7674997533714563, + 0.7643309494211415, + 0.7595807910223255, + 0.7548499367778632, + 0.7501369044668418, + 0.7454450801056614, + 0.7407725145905353, + 0.7361235906031054, + 0.7314972896997558, + 0.7268936773240117, + 0.7166644654649464, + 0.7124439398193461, + 0.7082449033010847, + 0.7040700022716785, + 0.6974752508013684, + 0.6909446584092569, + 0.684475223525038, + 0.6780653915909749, + 0.6680495423746597, + 0.6582030250229305, + 0.6485133310323026, + 0.6461178055133383, + 0.6437329219273948, + 0.6413593176991734, + 0.6350942631643639, + 0.6289014677925738, + 0.6227783731749321, + 0.6202459147506362, + 0.6177260716426496, + 0.6117764100343577, + 0.6014943668897104, + 0.596852649195879, + 0.5922607323628465, + 0.5877109016270946, + 0.5832079881039486, + 0.5787531334794377, + 0.5763792895922142, + 0.5740186610503705, + 0.5671353971274441, + 0.5642882519034906, + 0.5614601728463949, + 0.5552698205401126, + 0.5527527503053927, + 0.5502517287653009, + 0.5446590059104928, + 0.5421844303522867, + 0.5397253513389786, + 0.5338023306757704, + 0.531175705867907, + 0.5285677173311546, + 0.52255742059651, + 0.5200641795131425, + 0.517587605766493, + 0.5121738721589579, + 0.5099231955528721, + 0.5076871271963469, + 0.5025961883448008, + 0.5003519010532279, + 0.498121960761272, + 0.4928249727541886, + 0.49050203778117296, + 0.4881955723498932, + 0.4829271663623152, + 0.4807329002870988, + 0.47855304055042147, + 0.4737451336120313, + 0.4717235784123499, + 0.4697152252773881, + 0.46511570335211755, + 0.4630933989381916, + 0.4610840044572855, + 0.456354741870763, + 0.45429790061401976, + 0.45225546190188926, + 0.447614553010703, + 0.44567419524325214, + 0.4437462514281827, + 0.43946153460107723, + 0.43764473200141657, + 0.4358397537421065, + 0.4316902803351281, + 0.4298714554059677, + 0.42806408092955944, + 0.4238421041234398, + 0.4220168809377468, + 0.4202042001765231, + 0.41609699958801927, + 0.41437312442505475, + 0.41265995148212237, + 0.4088277578691601, + 0.40719270969483357, + 0.40556820871988003, + 0.4018254599465339, + 0.4001902279805889, + 0.39856506630096644, + 0.3947919182746304, + 0.39316754725168696, + 0.391554097021319, + 0.38790259480842737, + 0.38636416441353744, + 0.38483498216562084, + 0.38139568074652896, + 0.37992167084766876, + 0.37845705634646, + 0.3750792805997506, + 0.3736082022582504, + 0.37214593879497115, + 0.3687677048686968, + 0.3673173504500331, + 0.36587652674581467, + 0.36261585461139745, + 0.36123717254341925, + 0.3598665074746937, + 0.35676992897783166, + 0.35543864152075505, + 0.3541157258770801, + 0.3510641952957206, + 0.3497391369800572, + 0.3484217773771157, + 0.3453901393507723, + 0.34409072710338073, + 0.3427996637157965, + 0.33987589625171893, + 0.33863565348176256, + 0.33740238414699697, + 0.3346062384691772, + 0.3334016005815133, + 0.3322044321587043, + 0.3294439519603068, + 0.32824844087034877, + 0.3270596496077177, + 0.3243320628784107, + 0.32316391351744533, + 0.3220031110961517 ], "1e-05": [ 1.0, @@ -318,246 +341,232 @@ 1.0, 1.0, 0.9999999999999994, - 0.999999999999973, - 0.9999999999998286, - 0.9999999999994353, - 0.9999999999985202, - 0.9999999999965848, - 0.999999999991421, - 0.9999999999815654, - 0.999999999964278, - 0.999999999935795, - 0.9999999998244792, - 0.9999999995977931, - 0.9999999987558622, - 0.9999999969054565, - 0.9999999933717028, - 0.9999999871894636, - 0.9999999770945371, - 0.9999999615055236, - 0.9999999384936957, - 0.9999999057511308, - 0.9999998222204166, - 0.9999996889877318, - 0.9999994874837334, - 0.999999195494715, - 0.9999987869759616, - 0.9999978778927708, - 0.9999965094234947, - 0.9999945377974364, - 0.9999917976154723, - 0.9999881018395208, - 0.9999832421044165, - 0.99997698930736, - 0.9999690944252602, - 0.9999592894154012, - 0.9999401848217758, - 0.9999149868024333, - 0.9998825523031787, - 0.9998416677700266, - 0.999791059592578, - 0.9997294043566004, - 0.9996553389790277, - 0.9995674703998882, - 0.9994643850266823, - 0.9993446578768971, - 0.9992068613209312, - 0.9990495732666511, - 0.9988713847468418, - 0.9986709069017091, - 0.9984467774205655, - 0.9981976664057219, - 0.9979222816860815, - 0.9976193735297934, - 0.9972877388223238, - 0.9969262246908328, - 0.996533731653732, - 0.9961092162614316, - 0.9956516933112639, - 0.995160237588464, - 0.9946339852522628, - 0.9940721347820276, - 0.9934739476576494, - 0.9928387486094244, - 0.9921659257088754, - 0.9914549300102379, - 0.9907052751690002, - 0.9899165365563947, - 0.9890883505202034, - 0.9882204130405648, - 0.9873124787416938, - 0.9863643591450846, - 0.9853759215363472, - 0.9843470868598637, - 0.9832778285393545, - 0.9821681700454686, - 0.9810181837632249, - 0.9798279882523508, - 0.9785977472498147, - 0.9773276666315711, - 0.9760179936337368, - 0.9746690135138534, - 0.973281049070232, - 0.9718544574226932, - 0.970389628347756, - 0.9688869823638351, - 0.9662560899384262, - 0.9635203094788997, - 0.9606821993780256, - 0.9577444920812167, - 0.9547100690683178, - 0.9515819411366752, - 0.9483632227757351, - 0.9450571205495613, - 0.9416669020994433, - 0.9381959000999215, - 0.9346474739514014, - 0.9310250019996876, - 0.9273318651890746, - 0.9235714575523157, - 0.9197471440736972, - 0.9158622774695346, - 0.9119201741117782, - 0.9079241163948638, - 0.9038773101093882, - 0.8997829152661703, - 0.8956440506833048, - 0.8914637634703556, - 0.8872450198182428, - 0.8829907105064231, - 0.8787036576202755, - 0.8707492329414495, - 0.8687467372991504, - 0.8667391782827082, - 0.8647268018964069, - 0.862709850134354, - 0.8585978518713738, - 0.8544698540373321, - 0.8503277143424198, - 0.8461732532162092, - 0.8420082064910313, - 0.8378342644221053, - 0.8336530592192254, - 0.8294661713938566, - 0.8252750957253966, - 0.8210812732955917, - 0.8168861005800381, - 0.8126909232910099, - 0.808497028390498, - 0.801870527941527, - 0.7952548736200997, - 0.7886543612287468, - 0.7820730076362225, - 0.775514525626251, - 0.7689823476263041, - 0.76247965836786, - 0.756009378236416, - 0.749574210390875, - 0.743176642418555, - 0.7368189633320615, - 0.7305032399754438, - 0.724231346521673, - 0.7180049651772312, - 0.7118256478753264, - 0.7056948259233441, - 0.7032583360819944, - 0.700829860418756, - 0.6984094703765288, - 0.6959972339923495, - 0.6935932151265922, - 0.6889317429731345, - 0.6817668349582598, - 0.6746798126979188, - 0.6676718056770632, - 0.6607437321602112, - 0.6538963342916061, - 0.6471301405555971, - 0.6404455882961573, - 0.638787241606903, - 0.6371340113764097, - 0.6354859019485614, - 0.632317967018681, - 0.6291691359121044, - 0.624349241554268, - 0.619574789517913, - 0.614845708115443, - 0.6101619207501211, - 0.6055232995513015, - 0.6009296921089062, - 0.5963809255909179, - 0.5884265027887375, - 0.5806112287452613, - 0.5729337321697969, - 0.5653924576034643, - 0.5579857024960585, - 0.5561548262393686, - 0.5543322220611878, - 0.5525178614766851, - 0.5497619522652349, - 0.5470251014903538, - 0.5421958421956508, - 0.5374261214848611, - 0.5327153071436265, - 0.5280627574430141, - 0.5234678232476324, - 0.518929844460602, - 0.5144481596200524, - 0.5100220936639072, - 0.5056509822652775, - 0.501334134582734, - 0.497070898714232, - 0.492860583575257, - 0.488702496136303, - 0.4845959780644786, - 0.4805403496661883, - 0.4765349345681554, - 0.47257907275051975, - 0.46867209134329857, - 0.46481334795798307, - 0.4610021777856322, - 0.45723791746718145, - 0.4535199242983486, - 0.44984757092630373, - 0.4462202100082472, - 0.44263723745342903, - 0.4390980178177817, - 0.4356019204361891, - 0.43214835473501945, - 0.4287367135374875, - 0.4253663990336738, - 0.4220368326096732, - 0.41874742793163006, - 0.4154976298562691, - 0.41228686587129565, - 0.4091145679414439, - 0.40436315170089987, - 0.3996975358470319, - 0.3951158478239174, - 0.39061627014508404, - 0.3861970390853348, - 0.3841086119821148, - 0.3820380229802458, - 0.37998508572555983, - 0.3779496187417315, - 0.3745426919167079, - 0.3711844376968717, - 0.3678740151003091, - 0.3646106064268745, - 0.36139339169632445, - 0.3582215708412834, - 0.35509431859041374, - 0.35201085923465375, - 0.34897048346845855, - 0.345972428841367, - 0.3430159436132327, - 0.3401003270324417, - 0.3372248854371575, - 0.33438895086942516, - 0.33159183891956634, - 0.32883286088925856, - 0.32611135696096716, - 0.32342673756054513, - 0.320778362376132 + 0.9999999999999728, + 0.9999999999998277, + 0.9999999999993772, + 0.999999999998307, + 0.9999999999961376, + 0.9999999999905597, + 0.9999999999799453, + 0.9999999999614406, + 0.999999999931028, + 0.9999999998146482, + 0.999999999577143, + 0.9999999986603156, + 0.9999999966176489, + 0.9999999926668174, + 0.9999999857125494, + 0.9999999742983664, + 0.999999956593205, + 0.9999999303599443, + 0.999999892920285, + 0.9999997988411504, + 0.99999964922581, + 0.9999994235237898, + 0.9999990971496009, + 0.9999986413161523, + 0.9999980229260169, + 0.9999972044907073, + 0.9999961440721324, + 0.9999947952505274, + 0.9999919581336347, + 0.9999880543480445, + 0.9999828348836003, + 0.99997602439113, + 0.9999673222349675, + 0.9999564037273418, + 0.9999429214744197, + 0.9999265067720575, + 0.9999067712076379, + 0.999883308310826, + 0.9998556952499589, + 0.999823494551708, + 0.9997862558368362, + 0.9997435175498515, + 0.999694808668025, + 0.9996396503838776, + 0.9995775577561429, + 0.9995080413192367, + 0.9994306086404872, + 0.9992973853272029, + 0.9991432251663347, + 0.9989664323556398, + 0.9987653316024684, + 0.9985382771449236, + 0.9982836610071305, + 0.9979999205002076, + 0.9976855449223573, + 0.9973390813667841, + 0.9969591397995449, + 0.996544397402258, + 0.9960936022330019, + 0.9956055762147679, + 0.9950792175071752, + 0.9945135023053794, + 0.9939074861077313, + 0.9932603044873597, + 0.9925711734053961, + 0.9918393891084647, + 0.9910643276519527, + 0.9902454440842826, + 0.988904167255465, + 0.9874575212863792, + 0.9859045789768284, + 0.9842448039075116, + 0.9824780310619308, + 0.9806044473515437, + 0.9786245702598151, + 0.9765392255677656, + 0.9743495247052686, + 0.9720568420457322, + 0.9696627924227786, + 0.9671692090718357, + 0.9645781217689479, + 0.9618917360618483, + 0.959112412414139, + 0.9562426473633301, + 0.9532850546871299, + 0.9502423480546996, + 0.9471173237685626, + 0.9439128457250442, + 0.9406318309268333, + 0.9372772358443523, + 0.9338520436552785, + 0.9281206645690366, + 0.9222224163487193, + 0.9161702479416163, + 0.909976940175771, + 0.9036550287542714, + 0.8972167377344287, + 0.8906739256415018, + 0.884038047001481, + 0.8773201174706787, + 0.8705306885832033, + 0.863679834239645, + 0.8567771466849572, + 0.849831726401635, + 0.8428521770822616, + 0.8358466163654724, + 0.8288226937646042, + 0.8217875909094126, + 0.8147480220357146, + 0.8077102605625822, + 0.8006801725495347, + 0.7936632087804694, + 0.7866644189013376, + 0.7796884825037721, + 0.7727397316800427, + 0.7658221551240811, + 0.7589394112487376, + 0.7520948520087933, + 0.7452915546724809, + 0.7385323332828028, + 0.7318197332269578, + 0.7251560467150642, + 0.718543353367594, + 0.7119835397512431, + 0.7054782823535651, + 0.6990290473085305, + 0.6926371373111495, + 0.6863037267396687, + 0.6800298243501102, + 0.6738162774546392, + 0.6676638121207995, + 0.6615730542001267, + 0.6555445078505263, + 0.6495785464717353, + 0.643675454970533, + 0.6378354652504423, + 0.6320587144923304, + 0.6263452412103643, + 0.6206950188325813, + 0.6151079773614226, + 0.6095839832615416, + 0.6041228232596578, + 0.5987242367366024, + 0.5933879529185092, + 0.5881136621625541, + 0.5829009762465078, + 0.5777494742733178, + 0.5726587283928418, + 0.5676282928495217, + 0.5626576789747532, + 0.5577463626645992, + 0.5528938174724166, + 0.548099517117563, + 0.5433629011023795, + 0.5386833685644575, + 0.5340603228453975, + 0.5294931823681713, + 0.5249813669755107, + 0.5205242548093556, + 0.5161211999120089, + 0.5117715759537061, + 0.5074747670960915, + 0.5032301416344662, + 0.4990370553797829, + 0.49489487858590353, + 0.4908029838206928, + 0.4867607511308237, + 0.4827675507622126, + 0.47882273469861186, + 0.47492566495793864, + 0.471075734211727, + 0.46727233644389754, + 0.463514837229116, + 0.4598026154304416, + 0.45708881581523014, + 0.4543991601851459, + 0.45173340529717265, + 0.44909131353083825, + 0.4461646293474938, + 0.44326690407966335, + 0.4403978060209039, + 0.4375570117038603, + 0.4347442033753941, + 0.4336905773521349, + 0.4326408688450037, + 0.4315950607271938, + 0.430553136482061, + 0.4295150792136113, + 0.42753116045500233, + 0.4255613399584886, + 0.42199661853945175, + 0.41847790466369805, + 0.4150044993132491, + 0.41157571044235397, + 0.4081908579435358, + 0.4048492668581655, + 0.401550276897055, + 0.3982932393193029, + 0.395077511465739, + 0.39190245801181944, + 0.3887674576481655, + 0.3856719016242665, + 0.3826151863619507, + 0.3795967153000603, + 0.376615905873024, + 0.3736721877896451, + 0.37076499543612595, + 0.36789376976640853, + 0.36505796550018366, + 0.36225704934345904, + 0.35949048828279384, + 0.35675776548012783, + 0.35405837344619134, + 0.3529306562295049, + 0.3518087313794431, + 0.3494512548854949, + 0.34530802209788486, + 0.34124398027671876, + 0.33725725654807287, + 0.3333460283377147, + 0.32950851909542855, + 0.3257429980199224, + 0.32420878694729427, + 0.3226864474358309, + 0.3211758647207906, + 0.319676929784771 ] }, "scalar_bistable_data": [ diff --git a/share/lib/python/neuron/tests/test_rxd.py b/share/lib/python/neuron/tests/test_rxd.py index 9f251b82b6..6d8a97f5d7 100644 --- a/share/lib/python/neuron/tests/test_rxd.py +++ b/share/lib/python/neuron/tests/test_rxd.py @@ -98,9 +98,13 @@ def trivial_ecs(scale, lock, path=None): d=2.62, charge=1, atolscale=scale, - initial=lambda nd: 1.0 - if abs(nd.x3d) <= L / 2.0 and abs(nd.y3d) <= L / 2.0 and abs(nd.z3d) <= L / 2.0 - else 0.0, + initial=lambda nd: ( + 1.0 + if abs(nd.x3d) <= L / 2.0 + and abs(nd.y3d) <= L / 2.0 + and abs(nd.z3d) <= L / 2.0 + else 0.0 + ), ) # record the concentration at (0,0,0) diff --git a/src/nrncvode/cvodeobj.cpp b/src/nrncvode/cvodeobj.cpp index 228b7ac2a5..053ad21f56 100644 --- a/src/nrncvode/cvodeobj.cpp +++ b/src/nrncvode/cvodeobj.cpp @@ -1,5 +1,6 @@ #include <../../nrnconf.h> // solver interface to CVode +#include "nonvintblock.h" #include "nrnmpi.h" @@ -24,6 +25,11 @@ extern void (*nrn_multisplit_setup_)(); #include "mymath.h" #include +// #include "cvodes_impl.h" +#include +#include +#include + #if NRN_ENABLE_THREADS static MUTDEC #endif @@ -45,14 +51,26 @@ static void static_mutex_for_at_time(bool b) { // and math.h alone just moves the problem // to these //#include "shared/sundialstypes.h" -//#include "shared/nvector_serial.h" -#include "cvodes/cvodes.h" -#include "cvodes/cvodes_impl.h" -#include "cvodes/cvdense.h" -#include "cvodes/cvdiag.h" -#include "shared/dense.h" -#include "ida/ida.h" -#include "nonvintblock.h" +//#include /* serial N_Vector types, fcts, macros*/ +#include /* prototypes for CVODE fcts, consts*/ +#include /* serial N_Vector types, fcts, macros*/ +#include /* definition of type realtype*/ + +// For Sparse Matrix resolutions +//#include /* prototype for CVSUPERLUMT */ +//#include /* definitions SlsMat */ + +// For Dense Matrix resolutions +#include /* access to CVDls interface */ +#include /* defs. of realtype, sunindextype */ +// #include /* access to dense SUNLinearSolver */ +// #include /* access to dense SUNMatrix */ + +#include +#include +#include +// For Pre-conditioned matrix solvers +#include /*For Approx Diagonal matrix*/ extern double dt, t; #define nt_dt nrn_threads->_dt @@ -70,10 +88,8 @@ extern short* nrn_is_artificial_; extern void nrn2ncs_netcons(); #endif // USENCS #if NRNMPI -extern "C" { -extern N_Vector N_VNew_Parallel(int comm, long int local_length, long int global_length); -extern N_Vector N_VNew_NrnParallelLD(int comm, long int local_length, long int global_length); -} // extern "C" +#include "nvector_parallel.h" +#include "nvector_nrnparallel_ld.h" #endif extern bool nrn_use_fifo_queue_; @@ -574,6 +590,13 @@ static double free_event_queues(void*) { return 0; } +const char** sundials_version(void*) { + static const std::string ver{SUNDIALS_VERSION}; + char** ps = hoc_temp_charptr(); + *ps = (char*) ver.c_str(); + return (const char**) (ps); +} + static Member_func members[] = {{"solve", solve}, {"atol", nrn_atol}, {"rtol", rtol}, @@ -628,6 +651,8 @@ static Member_func members[] = {{"solve", solve}, static Member_ret_obj_func omembers[] = {{"netconlist", netconlist}, {nullptr, nullptr}}; +static Member_ret_str_func smembers[] = {{"version", sundials_version}, {nullptr, nullptr}}; + static void* cons(Object*) { #if 0 NetCvode* d; @@ -651,7 +676,7 @@ static void destruct(void* v) { #endif } void Cvode_reg() { - class2oc("CVode", cons, destruct, members, omembers, nullptr); + class2oc("CVode", cons, destruct, members, omembers, smembers); net_cvode_instance = new NetCvode(1); Daspk::dteps_ = 1e-9; // change with cvode.dae_init_dteps(newval) } @@ -659,6 +684,7 @@ void Cvode_reg() { /* Functions Called by the CVODE Solver */ static int minit(CVodeMem cv_mem); +#if 0 // unused static int msetup(CVodeMem cv_mem, int convfail, N_Vector ypred, @@ -667,15 +693,15 @@ static int msetup(CVodeMem cv_mem, N_Vector vtemp, N_Vector vtemp2, N_Vector vtemp3); +#endif // unused static int msolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur); static int msolve_lvardt(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur); -static void mfree(CVodeMem cv_mem); -static void f_gvardt(realtype t, N_Vector y, N_Vector ydot, void* f_data); -static void f_lvardt(realtype t, N_Vector y, N_Vector ydot, void* f_data); +static int f_gvardt(realtype t, N_Vector y, N_Vector ydot, void* f_data); +static int f_lvardt(realtype t, N_Vector y, N_Vector ydot, void* f_data); static CVRhsFn pf_; static void msolve_thread(neuron::model_sorted_token const&, NrnThread&); @@ -843,7 +869,7 @@ Cvode::~Cvode() { N_VDestroy(atolnvec_); } if (mem_) { - CVodeFree(mem_); + CVodeFree((void**) (&mem_)); } if (maxstate_) { N_VDestroy(maxstate_); @@ -869,11 +895,11 @@ void Cvode::init_prepare() { y_ = nullptr; } if (mem_) { - CVodeFree(mem_); + CVodeFree((void**) (&mem_)); mem_ = nullptr; } if (atolnvec_) { - N_VDestroy(atolnvec_); + N_VDestroy_Serial(atolnvec_); atolnvec_ = nullptr; } if (daspk_) { @@ -1030,7 +1056,7 @@ void Cvode::maxstep(double x) { void Cvode::free_cvodemem() { if (mem_) { - CVodeFree(mem_); + CVodeFree((void**) (&mem_)); mem_ = nullptr; } } @@ -1061,7 +1087,8 @@ int Cvode::cvode_init(double) { // TODO: this needs changed if want to support more than one thread or local variable timestep nrn_nonvint_block_ode_reinit(neq_, N_VGetArrayPointer(y_), 0); if (mem_) { - err = CVodeReInit(mem_, pf_, t0_, y_, CV_SV, &ncv_->rtol_, atolnvec_); + err = CVodeReInit(mem_, t0_, y_); + err = CVodeSetUserData(mem_, (void*) this); // printf("CVodeReInit\n"); if (err != SUCCESS) { Printf("Cvode %p %s CVReInit error %d\n", @@ -1071,14 +1098,20 @@ int Cvode::cvode_init(double) { return err; } } else { - mem_ = CVodeCreate(CV_BDF, ncv_->stiff() ? CV_NEWTON : CV_FUNCTIONAL); + mem_ = (CVodeMem) CVodeCreate(CV_BDF, ncv_->stiff() ? CV_NEWTON : CV_FUNCTIONAL); if (!mem_) { hoc_execerror("CVodeCreate error", 0); } maxorder(ncv_->maxorder()); // Memory Leak if changed after CVodeMalloc minstep(ncv_->minstep()); maxstep(ncv_->maxstep()); - CVodeMalloc(mem_, pf_, t0_, y_, CV_SV, &ncv_->rtol_, atolnvec_); + // CVodeMalloc was replaced by CVodeCreate/CVodeInit + // CVodeInit allocates and initializes memory for a problem + err = CVodeInit(mem_, pf_, t0_, y_); + // atolnvec_ set by Cvode::init_eqn + err = CVodeSVtolerances(mem_, ncv_->rtol_, atolnvec_); + + err = CVodeSetUserData(mem_, (void*) this); if (err != SUCCESS) { Printf("Cvode %p %s CVodeMalloc error %d\n", fmt::ptr(this), @@ -1308,17 +1341,21 @@ int Cvode::cvode_advance_tn(neuron::model_sorted_token const& sorted_token) { } #endif std::pair opaque{this, sorted_token}; - CVodeSetFdata(mem_, &opaque); + CVodeSetUserData(mem_, &opaque); CVodeSetStopTime(mem_, tstop_); + /* Note: CV_ONE_STEP_TSTOP is removed, now CV_ONE_STEP does the + * same. From documentation: If tstop is enabled (through a call + * to CVodeSetStopTime), then CVode returns the solution at tstop. + */ // printf("cvode_advance_tn begin t0_=%g t_=%g tn_=%g tstop=%g\n", t0_, t_, tn_, tstop_); - int err = CVode(mem_, tstop_, y_, &t_, CV_ONE_STEP_TSTOP); - CVodeSetFdata(mem_, nullptr); + int err = CVode(mem_, tstop_, y_, &t_, CV_ONE_STEP); + CVodeSetUserData(mem_, nullptr); #if PRINT_EVENT if (net_cvode_instance->print_event_ > 1) { Printf("t_=%.20g\n", t_); } #endif - if (err < 0) { + if (err != CV_SUCCESS && err != CV_TSTOP_RETURN) { Printf("CVode %p %s advance_tn failed, err=%d.\n", fmt::ptr(this), secname(cv_rootsec(this)), @@ -1352,10 +1389,10 @@ int Cvode::cvode_interpolate(double tout) { // is this really necessary anymore. Maybe NORMAL mode ignores tstop auto const sorted_token = nrn_ensure_model_data_are_sorted(); std::pair opaque{this, sorted_token}; - CVodeSetFdata(mem_, &opaque); + CVodeSetUserData(mem_, &opaque); CVodeSetStopTime(mem_, tstop_ + tstop_); int err = CVode(mem_, tout, y_, &t_, CV_NORMAL); - CVodeSetFdata(mem_, nullptr); + CVodeSetUserData(mem_, nullptr); #if PRINT_EVENT if (net_cvode_instance->print_event_ > 1) { Printf("%.20g\n", t_); @@ -1440,37 +1477,51 @@ void Cvode::statistics() { void Cvode::matmeth() { switch (ncv_->jacobian()) { - case 1: - CVDense(mem_, neq_); + case 1: { + /* Create dense SUNMatrix for use in linear solver */ + SUNMatrix A = SUNDenseMatrix(neq_, neq_); + assert(A); + + /* Create dense SUNLinearSolver object for use by CVode */ + SUNLinearSolver LS = SUNDenseLinearSolver(y_, A); + assert(LS); + + /* attach the matrix and linear solver to CVode */ + int flag = CVDlsSetLinearSolver(mem_, LS, A); + assert(flag == CVDLS_SUCCESS); + + /* Set jacobian and allocate memory */ + /* Null means we wish to use the default internal difference + * quotient function for dense matrices. */ + flag = CVDlsSetJacFn(mem_, NULL); + if (flag != CVDLS_SUCCESS) + throw std::runtime_error("ERROR: can't allocate memory for dense jacobian"); break; + } case 2: CVDiag(mem_); break; - default: - // free previous method - if (((CVodeMem) mem_)->cv_lfree) { - ((CVodeMem) mem_)->cv_lfree((CVodeMem) mem_); - ((CVodeMem) mem_)->cv_lfree = NULL; - } - - ((CVodeMem) mem_)->cv_linit = minit; - ((CVodeMem) mem_)->cv_lsetup = msetup; - ((CVodeMem) mem_)->cv_setupNonNull = TRUE; // but since our's does not do anything... - if (nth_) { // lvardt + default: { + /* CVODES guide chapter 8: Providing Alternate Linear + * Solver Modules: only lsolve function is mandatory + * (non-used functions need to be set to null) */ + ((CVodeMem) mem_)->cv_linit = NULL; + // TODO can the set-up be set to NULL? Comment says it does not do anything! + ((CVodeMem) mem_)->cv_lsetup = NULL; + //((CVodeMem)mem_)->cv_setupNonNull = TRUE; // but since our's does not do anything... + if (nth_) { // lvardt ((CVodeMem) mem_)->cv_lsolve = msolve_lvardt; } else { ((CVodeMem) mem_)->cv_lsolve = msolve; } - ((CVodeMem) mem_)->cv_lfree = mfree; + ((CVodeMem) mem_)->cv_lfree = NULL; break; } + } } -static int minit(CVodeMem) { - // printf("minit\n"); - return CV_NO_FAILURES; -} +#if 0 // unused static int msetup(CVodeMem m, int convfail, N_Vector yp, @@ -1482,9 +1533,10 @@ static int msetup(CVodeMem m, // printf("msetup\n"); *jcurPtr = true; auto* const cv = - static_cast*>(m->cv_f_data)->first; + static_cast*>(m->cv_user_data)->first; return cv->setup(yp, fp); } +#endif // unused static N_Vector msolve_b_; static N_Vector msolve_ycur_; @@ -1495,7 +1547,7 @@ static int msolve(CVodeMem m, N_Vector b, N_Vector weight, N_Vector ycur, N_Vect // N_VIth(b, 0) /= (1. + m->cv_gammap); // N_VIth(b,0) *= 2./(1. + m->cv_gamrat); auto* const f_typed_data = static_cast*>( - m->cv_f_data); + m->cv_user_data); msolve_cv_ = f_typed_data->first; auto const& sorted_token = f_typed_data->second; Cvode& cv = *msolve_cv_; @@ -1519,7 +1571,7 @@ static int msolve(CVodeMem m, N_Vector b, N_Vector weight, N_Vector ycur, N_Vect } static int msolve_lvardt(CVodeMem m, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur) { auto* const f_typed_data = static_cast*>( - m->cv_f_data); + m->cv_user_data); auto* const cv = f_typed_data->first; auto const& sorted_token = f_typed_data->second; ++cv->mxb_calls_; @@ -1564,15 +1616,11 @@ static void* msolve_thread_part3(NrnThread* nt) { return 0; } -static void mfree(CVodeMem) { - // printf("mfree\n"); -} - static realtype f_t_; static N_Vector f_y_; static N_Vector f_ydot_; static Cvode* f_cv_; -static void f_gvardt(realtype t, N_Vector y, N_Vector ydot, void* f_data) { +static int f_gvardt(realtype t, N_Vector y, N_Vector ydot, void* f_data) { auto* const f_typed_data = static_cast*>( f_data); f_cv_ = f_typed_data->first; @@ -1608,8 +1656,9 @@ static void f_gvardt(realtype t, N_Vector y, N_Vector ydot, void* f_data) { } else { nrn_multithread_job(f_typed_data->second, f_thread); } + return CV_SUCCESS; } -static void f_lvardt(realtype t, N_Vector y, N_Vector ydot, void* f_data) { +static int f_lvardt(realtype t, N_Vector y, N_Vector ydot, void* f_data) { auto* const f_typed_data = static_cast*>( f_data); auto* const cv = f_typed_data->first; @@ -1618,6 +1667,7 @@ static void f_lvardt(realtype t, N_Vector y, N_Vector ydot, void* f_data) { cv->nth_->_vcv = cv; cv->fun_thread(sorted_token, t, cv->n_vector_data(y, 0), cv->n_vector_data(ydot, 0), cv->nth_); cv->nth_->_vcv = 0; + return CV_SUCCESS; } static void f_thread(neuron::model_sorted_token const& sorted_token, NrnThread& ntr) { diff --git a/src/nrncvode/cvodeobj.h b/src/nrncvode/cvodeobj.h index 473f4cf047..7d41551627 100644 --- a/src/nrncvode/cvodeobj.h +++ b/src/nrncvode/cvodeobj.h @@ -2,10 +2,11 @@ #include "nrnmpi.h" #include "nrnneosm.h" -//#include "shared/nvector_serial.h" -#include "shared/nvector.h" +//#include /* serial N_Vector types, fcts, macros*/ #include "membfunc.h" +#include /* serial N_Vector types, fcts, macros*/ #include "netcon.h" +#include #include "tqitem.hpp" #include "htlist.h" @@ -227,7 +228,7 @@ class Cvode { void maxacor(double*); public: - void* mem_; + CVodeMem mem_; N_Vector y_; N_Vector atolnvec_; N_Vector maxstate_; diff --git a/src/nrncvode/netcvode.cpp b/src/nrncvode/netcvode.cpp index 18b2b5fdd4..a8d76e57ce 100644 --- a/src/nrncvode/netcvode.cpp +++ b/src/nrncvode/netcvode.cpp @@ -45,6 +45,8 @@ #include #include #include +#include +#include "netcon.h" #include typedef void (*ReceiveFunc)(Point_process*, double*, double); @@ -1297,6 +1299,7 @@ void NetCvode::del_cv_memb_list() { } } } + void NetCvode::del_cv_memb_list(Cvode* cvode) { if (!cvode) { return; diff --git a/src/nrncvode/nrndaspk.cpp b/src/nrncvode/nrndaspk.cpp index 48fa792ec7..f6836048f4 100644 --- a/src/nrncvode/nrndaspk.cpp +++ b/src/nrncvode/nrndaspk.cpp @@ -13,7 +13,11 @@ #include "netcvode.h" #include "nrn_ansi.h" #include "ida/ida.h" + +#undef MSG_TIME +#undef MSG_TIME_H #include "ida/ida_impl.h" + #include "mymath.h" // the state of the g - d2/dx2 matrix for voltages @@ -32,13 +36,6 @@ extern void nrndae_dkres(double*, double*, double*); extern void nrndae_dkpsol(double); extern void nrn_solve(NrnThread*); void nrn_daspk_init_step(double, double, int); -// this is private in ida.cpp but we want to check if our initialization -// is good. Unfortunately ewt is set on the first call to solve which -// is too late for us. -extern "C" { -extern booleantype IDAEwtSet(IDAMem IDA_mem, N_Vector ycur); -} // extern "C" - // extern double t, dt; #define nt_dt nrn_threads->_dt #define nt_t nrn_threads->_t @@ -49,7 +46,6 @@ static void daspk_nrn_solve(NrnThread* nt) { static int res_gvardt(realtype t, N_Vector y, N_Vector yp, N_Vector delta, void* rdata); -static int minit(IDAMem); static int msetup(IDAMem mem, N_Vector y, @@ -61,8 +57,6 @@ static int msetup(IDAMem mem, static int msolve(IDAMem mem, N_Vector b, N_Vector ycur, N_Vector ypcur, N_Vector deltacur); -static int mfree(IDAMem); - // at least in DARWIN the following is already declared so avoid conflict #define thread_t nrn_thread_t @@ -99,15 +93,10 @@ static int res_gvardt(realtype t, N_Vector y, N_Vector yp, N_Vector delta, void* return thread_ier; } -// linear solver specific allocation and initialization -static int minit(IDAMem) { - return IDA_SUCCESS; -} - // linear solver preparation for subsequent calls to msolve // approximation to jacobian. Everything necessary for solving P*x = b static int msetup(IDAMem mem, N_Vector y, N_Vector yp, N_Vector, N_Vector, N_Vector, N_Vector) { - Cvode* cv = (Cvode*) mem->ida_rdata; + Cvode* cv = (Cvode*) mem->ida_user_data; ++cv->jac_calls_; return 0; } @@ -124,7 +113,7 @@ static void* msolve_thread(NrnThread* nt) { return 0; } static int msolve(IDAMem mem, N_Vector b, N_Vector w, N_Vector ycur, N_Vector, N_Vector) { - thread_cv = (Cvode*) mem->ida_rdata; + thread_cv = (Cvode*) mem->ida_user_data; thread_t = mem->ida_tn; nvec_y = ycur; nvec_yp = b; @@ -133,10 +122,6 @@ static int msolve(IDAMem mem, N_Vector b, N_Vector w, N_Vector ycur, N_Vector, N return thread_ier; } -static int mfree(IDAMem) { - return IDA_SUCCESS; -} - Daspk::Daspk(Cvode* cv, int neq) { // printf("Daspk::Daspk\n"); cv_ = cv; @@ -153,16 +138,15 @@ Daspk::~Daspk() { N_VDestroy(delta_); N_VDestroy(yp_); if (mem_) { - IDAFree((IDAMem) mem_); + IDAFree((void**) &mem_); } } void Daspk::ida_init() { int ier; if (mem_) { - ier = IDAReInit( - mem_, res_gvardt, cv_->t_, cv_->y_, yp_, IDA_SV, &cv_->ncv_->rtol_, cv_->atolnvec_); - if (ier < 0) { + ier = IDAReInit(mem_, cv_->t_, cv_->y_, yp_); + if (ier != IDA_SUCCESS) { hoc_execerror("IDAReInit error", 0); } } else { @@ -170,14 +154,19 @@ void Daspk::ida_init() { if (!mem) { hoc_execerror("IDAMalloc error", 0); } - IDASetRdata(mem, cv_); - ier = IDAMalloc( - mem, res_gvardt, cv_->t_, cv_->y_, yp_, IDA_SV, &cv_->ncv_->rtol_, cv_->atolnvec_); - mem->ida_linit = minit; + ier = IDAInit(mem, res_gvardt, cv_->t_, cv_->y_, yp_); + assert(ier == IDA_SUCCESS); + + ier = IDASetUserData(mem, cv_); + assert(ier == IDA_SUCCESS); + + ier = IDASVtolerances(mem, cv_->ncv_->rtol_, cv_->atolnvec_); + assert(ier == IDA_SUCCESS); + + mem->ida_linit = NULL; mem->ida_lsetup = msetup; mem->ida_lsolve = msolve; - mem->ida_lfree = mfree; - mem->ida_setupNonNull = false; + mem->ida_lfree = NULL; mem_ = mem; } } @@ -277,7 +266,7 @@ cv_->t_, t-cv_->t_, cv_->t0_-cv_->t_); #if 1 // test // printf("test\n"); - if (!IDAEwtSet((IDAMem) mem_, cv_->y_)) { + if (IDAEwtSet(cv_->y_, ((IDAMem) mem_)->ida_ewt, mem_) != IDA_SUCCESS) { hoc_execerror("Bad Ida error weight vector", 0); } use_parasite_ = false; @@ -324,8 +313,9 @@ int Daspk::advance_tn(double tstop) { // printf("Daspk::advance_tn(%g)\n", tstop); double tn = cv_->tn_; IDASetStopTime(mem_, tstop); - int ier = IDASolve(mem_, tstop, &cv_->t_, cv_->y_, yp_, IDA_ONE_STEP_TSTOP); - if (ier < 0) { + int ier = IDASolve(mem_, tstop, &cv_->t_, cv_->y_, yp_, IDA_ONE_STEP); + if (ier != IDA_SUCCESS && ier != IDA_TSTOP_RETURN) { + // printf("DASPK advance_tn error %d\n", ier); // printf("DASPK advance_tn error\n"); return ier; } @@ -349,12 +339,13 @@ int Daspk::advance_tn(double tstop) { int Daspk::interpolate(double tt) { // printf("Daspk::interpolate %.15g\n", tt); assert(tt >= cv_->t0_ && tt <= cv_->tn_); - int ier = IDAGetSolution(mem_, tt, cv_->y_, yp_); - if (ier < 0) { + // do not setIDASetStopTime since tt earlier than tn_ + int ier = IDASolve(mem_, tt, &cv_->t_, cv_->y_, yp_, IDA_NORMAL); + if (ier != IDA_SUCCESS) { Printf("DASPK interpolate error\n"); return ier; } - cv_->t_ = tt; + assert(MyMath::eq(tt, cv_->t_, NetCvode::eps(cv_->t_))); // interpolation does not call res. So we have to. res_gvardt(cv_->t_, cv_->y_, yp_, delta_, cv_); // if(MyMath::eq(t, cv_->t_, NetCvode::eps(cv_->t_))) { diff --git a/src/nrncvode/nrndaspk.h b/src/nrncvode/nrndaspk.h index 6826a25b69..33fb610497 100644 --- a/src/nrncvode/nrndaspk.h +++ b/src/nrncvode/nrndaspk.h @@ -1,6 +1,6 @@ #pragma once -#include "shared/nvector_serial.h" +#include /* serial N_Vector types, fcts, macros*/ #include "nvector_nrnthread.h" #include "nvector_nrnthread_ld.h" #include "nvector_nrnserial_ld.h" diff --git a/src/nrniv/CMakeLists.txt b/src/nrniv/CMakeLists.txt index dfc77e9ea3..228907f1a2 100644 --- a/src/nrniv/CMakeLists.txt +++ b/src/nrniv/CMakeLists.txt @@ -220,8 +220,7 @@ set(NRN_INCLUDE_DIRS ${PROJECT_BINARY_DIR}/src/nrnpython ${PROJECT_BINARY_DIR}/src/oc ${PROJECT_BINARY_DIR}/src/parallel - ${PROJECT_BINARY_DIR}/src/sundials - ${PROJECT_BINARY_DIR}/src/sundials/shared + ${PROJECT_SOURCE_DIR}/external/Random123/include ${PROJECT_SOURCE_DIR}/src ${PROJECT_SOURCE_DIR}/src/gnu ${PROJECT_SOURCE_DIR}/src/nrncvode @@ -230,11 +229,7 @@ set(NRN_INCLUDE_DIRS ${PROJECT_SOURCE_DIR}/src/parallel ${PROJECT_SOURCE_DIR}/src/scopmath ${PROJECT_SOURCE_DIR}/src/sparse - ${PROJECT_SOURCE_DIR}/src/sparse13 - ${PROJECT_SOURCE_DIR}/src/sundials - ${PROJECT_SOURCE_DIR}/src/sundials/cvodes - ${PROJECT_SOURCE_DIR}/src/sundials/ida - ${PROJECT_SOURCE_DIR}/src/sundials/shared) + ${PROJECT_SOURCE_DIR}/src/sparse13) if(NRN_ENABLE_MUSIC) list(APPEND NRN_INCLUDE_DIRS ${NRN_MUSIC_SRC_DIR}) @@ -248,9 +243,6 @@ set(NRN_INCLUDE_DIRS # Helper commands : generate various headers # ============================================================================= -# avoid error with nvector_serial.cpp for #include <../../../nrnconf.h> -file(MAKE_DIRECTORY ${PROJECT_BINARY_DIR}/src/sundials/shared) - # generate hocusr.h add_custom_command( OUTPUT ${PROJECT_BINARY_DIR}/src/oc/hocusr.h @@ -460,6 +452,14 @@ endif() if(NRN_ENABLE_PROFILING) target_link_libraries(nrniv_lib PRIVATE ${likwid_LIBRARIES} ${CALIPER_LIB} ${LIKWID_LIB}) endif() +find_package(SUNDIALS REQUIRED) +add_dependencies(nrniv_lib SUNDIALS) +target_link_libraries( + nrniv_lib + PRIVATE ${SUNDIALS_LIB_DIR}/libsundials_ida.a ${SUNDIALS_LIB_DIR}/libsundials_cvode.a + ${SUNDIALS_LIB_DIR}/libsundials_nvecpthreads.a + ${SUNDIALS_LIB_DIR}/libsundials_nvecserial.a) +target_include_directories(nrniv_lib PRIVATE $) set_target_properties(nrniv_lib PROPERTIES EXPORT_NAME nrniv OUTPUT_NAME nrniv) target_compile_features(nrniv_lib PUBLIC cxx_std_17) diff --git a/src/nrniv/nvector_nrnparallel_ld.cpp b/src/nrniv/nvector_nrnparallel_ld.cpp index ffa410c0fe..079292813e 100644 --- a/src/nrniv/nvector_nrnparallel_ld.cpp +++ b/src/nrniv/nvector_nrnparallel_ld.cpp @@ -15,19 +15,20 @@ * of the NVECTOR package. * ----------------------------------------------------------------- */ + +#define SUNTRUE true +#define SUNFALSE false #include <../../nrnconf.h> #include #include #include -#include -#include -extern int nrnmpi_numprocs; - #include "nvector_nrnparallel_ld.h" -#include "sundialsmath.h" -#include "sundialstypes.h" +#define MPI_Comm int // or perhaps get rid of them all +#include "nrnmpi.h" +#include +#include /* definition of type realtype*/ #define ZERO RCONST(0.0) #define HALF RCONST(0.5) @@ -140,7 +141,7 @@ N_Vector N_VNewEmpty_NrnParallelLD(MPI_Comm comm, long int local_length, long in content->local_length = local_length; content->global_length = global_length; content->comm = comm; - content->own_data = FALSE; + content->own_data = SUNFALSE; content->data = NULL; /* Attach content and ops */ @@ -174,7 +175,7 @@ extern "C" N_Vector N_VNew_NrnParallelLD(MPI_Comm comm, } /* Attach data */ - NV_OWN_DATA_P_LD(v) = TRUE; + NV_OWN_DATA_P_LD(v) = SUNTRUE; NV_DATA_P_LD(v) = data; } @@ -242,7 +243,7 @@ N_Vector N_VCloneEmpty_NrnParallelLD(N_Vector w) { content->local_length = NV_LOCLENGTH_P_LD(w); content->global_length = NV_GLOBLENGTH_P_LD(w); content->comm = NV_COMM_P_LD(w); - content->own_data = FALSE; + content->own_data = SUNFALSE; content->data = NULL; /* Attach content and ops */ @@ -268,7 +269,7 @@ N_Vector N_VMake_NrnParallelLD(MPI_Comm comm, if (local_length > 0) { /* Attach data */ - NV_OWN_DATA_P_LD(v) = FALSE; + NV_OWN_DATA_P_LD(v) = SUNFALSE; NV_DATA_P_LD(v) = v_data; } @@ -391,7 +392,7 @@ N_Vector N_VClone_NrnParallelLD(N_Vector w) { } /* Attach data */ - NV_OWN_DATA_P_LD(v) = TRUE; + NV_OWN_DATA_P_LD(v) = SUNTRUE; NV_DATA_P_LD(v) = data; } @@ -399,18 +400,16 @@ N_Vector N_VClone_NrnParallelLD(N_Vector w) { } void N_VDestroy_NrnParallelLD(N_Vector v) { - if ((NV_OWN_DATA_P_LD(v) == TRUE) && (NV_DATA_P_LD(v) != NULL)) + if ((NV_OWN_DATA_P_LD(v) == SUNTRUE) && (NV_DATA_P_LD(v) != NULL)) free(NV_DATA_P_LD(v)); free(v->content); free(v->ops); free(v); } -void N_VSpace_NrnParallelLD(N_Vector v, long int* lrw, long int* liw) { - MPI_Comm comm; +void N_VSpace_NrnParallelLD(N_Vector v, sunindextype* lrw, sunindextype* liw) { int npes; - comm = NV_COMM_P_LD(v); npes = nrnmpi_numprocs; *lrw = NV_GLOBLENGTH_P_LD(v); @@ -580,7 +579,7 @@ void N_VAbs_NrnParallelLD(N_Vector x, N_Vector z) { zd = NV_DATA_P_LD(z); for (i = 0; i < N; i++, xd++, zd++) - *zd = ABS(*xd); + *zd = SUNRabs(*xd); } void N_VInv_NrnParallelLD(N_Vector x, N_Vector z) { @@ -636,8 +635,8 @@ realtype N_VMaxNorm_NrnParallelLD(N_Vector x) { max = ZERO; for (i = 0; i < N; i++, xd++) { - if (ABS(*xd) > max) - max = ABS(*xd); + if (SUNRabs(*xd) > max) + max = SUNRabs(*xd); } gmax = VAllReduce_NrnParallelLD(max, 2, comm); @@ -665,7 +664,7 @@ realtype N_VWrmsNorm_NrnParallelLD(N_Vector x, N_Vector w) { } auto const gsum = VAllReduce_long_NrnParallelLD(sum, 1, comm); - return RSqrt(gsum / N_global); + return SUNRsqrt(gsum / N_global); } realtype N_VWrmsNormMask_NrnParallelLD(N_Vector x, N_Vector w, N_Vector id) { @@ -692,7 +691,7 @@ realtype N_VWrmsNormMask_NrnParallelLD(N_Vector x, N_Vector w, N_Vector id) { } auto const gsum = VAllReduce_long_NrnParallelLD(sum, 1, comm); - return RSqrt(gsum / N_global); + return SUNRsqrt(gsum / N_global); } realtype N_VMin_NrnParallelLD(N_Vector x) { @@ -741,7 +740,7 @@ realtype N_VWL2Norm_NrnParallelLD(N_Vector x, N_Vector w) { } auto const gsum = VAllReduce_long_NrnParallelLD(sum, 1, comm); - return RSqrt(gsum); + return SUNRsqrt(gsum); } realtype N_VL1Norm_NrnParallelLD(N_Vector x) { @@ -755,7 +754,7 @@ realtype N_VL1Norm_NrnParallelLD(N_Vector x) { realtype sum{}, c{}; for (i = 0; i < N; i++, xd++) { - auto const y = ABS(*xd) - c; + auto const y = SUNRabs(*xd) - c; auto const t = sum + y; c = (t - sum) - y; sum = t; @@ -774,7 +773,7 @@ void N_VCompare_NrnParallelLD(realtype c, N_Vector x, N_Vector z) { zd = NV_DATA_P_LD(z); for (i = 0; i < N; i++, xd++, zd++) { - *zd = (ABS(*xd) >= c) ? ONE : ZERO; + *zd = (SUNRabs(*xd) >= c) ? ONE : ZERO; } } @@ -798,9 +797,9 @@ booleantype N_VInvTest_NrnParallelLD(N_Vector x, N_Vector z) { gval = VAllReduce_NrnParallelLD(val, 3, comm); if (gval == ZERO) - return (FALSE); + return (SUNFALSE); else - return (TRUE); + return (SUNTRUE); } booleantype N_VConstrMask_NrnParallelLD(N_Vector c, N_Vector x, N_Vector m) { @@ -815,7 +814,7 @@ booleantype N_VConstrMask_NrnParallelLD(N_Vector c, N_Vector x, N_Vector m) { md = NV_DATA_P_LD(m); comm = NV_COMM_P_LD(x); - test = TRUE; + test = SUNTRUE; for (i = 0; i < N; i++, cd++, xd++, md++) { *md = ZERO; @@ -823,14 +822,14 @@ booleantype N_VConstrMask_NrnParallelLD(N_Vector c, N_Vector x, N_Vector m) { continue; if (*cd > ONEPT5 || (*cd) < -ONEPT5) { if ((*xd) * (*cd) <= ZERO) { - test = FALSE; + test = SUNFALSE; *md = ONE; } continue; } if ((*cd) > HALF || (*cd) < -HALF) { if ((*xd) * (*cd) < ZERO) { - test = FALSE; + test = SUNFALSE; *md = ONE; } } @@ -850,7 +849,7 @@ realtype N_VMinQuotient_NrnParallelLD(N_Vector num, N_Vector denom) { dd = NV_DATA_P_LD(denom); comm = NV_COMM_P_LD(num); - notEvenOnce = TRUE; + notEvenOnce = SUNTRUE; for (i = 0; i < N; i++, nd++, dd++) { if (*dd == ZERO) @@ -858,9 +857,9 @@ realtype N_VMinQuotient_NrnParallelLD(N_Vector num, N_Vector denom) { else { if (notEvenOnce) { min = *nd / *dd; - notEvenOnce = FALSE; + notEvenOnce = SUNFALSE; } else - min = MIN(min, (*nd) / (*dd)); + min = SUNMIN(min, (*nd) / (*dd)); } } diff --git a/src/nrniv/nvector_nrnparallel_ld.h b/src/nrniv/nvector_nrnparallel_ld.h index f7d5bd6c62..286fa07072 100644 --- a/src/nrniv/nvector_nrnparallel_ld.h +++ b/src/nrniv/nvector_nrnparallel_ld.h @@ -62,11 +62,12 @@ mv temp nvector_nrnparallel_ld.cpp #pragma once -#include +// may want to just get rid of MPI_Comm altogether +#undef MPI_Comm #define MPI_Comm int -#include "nvector.h" -#include "sundialstypes.h" +#include /* serial N_Vector types, fcts, macros*/ +#include /* definition of type realtype*/ /* * ----------------------------------------------------------------- @@ -292,7 +293,7 @@ void N_VPrint_NrnParallelLD(N_Vector v); N_Vector N_VClone_NrnParallelLD(N_Vector w); void N_VDestroy_NrnParallelLD(N_Vector v); -void N_VSpace_NrnParallelLD(N_Vector v, long int* lrw, long int* liw); +void N_VSpace_NrnParallelLD(N_Vector v, sunindextype* lrw, sunindextype* liw); realtype* N_VGetArrayPointer_NrnParallelLD(N_Vector v); void N_VSetArrayPointer_NrnParallelLD(realtype* v_data, N_Vector v); void N_VLinearSum_NrnParallelLD(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); diff --git a/src/nrniv/nvector_nrnserial_ld.cpp b/src/nrniv/nvector_nrnserial_ld.cpp index 33c3d59645..87866e04f8 100644 --- a/src/nrniv/nvector_nrnserial_ld.cpp +++ b/src/nrniv/nvector_nrnserial_ld.cpp @@ -31,8 +31,8 @@ #include #include "nvector_nrnserial_ld.h" -#include "shared/sundialsmath.h" -#include "shared/sundialstypes.h" +#include /* defs. of realtype, sunindextype */ +#include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) @@ -122,7 +122,7 @@ N_Vector N_VNewEmpty_NrnSerialLD(long int length) { } content->length = length; - content->own_data = FALSE; + content->own_data = SUNFALSE; content->data = NULL; /* Attach content and ops */ @@ -158,7 +158,7 @@ N_Vector N_VNew_NrnSerialLD(long int length) { } /* Attach data */ - NV_OWN_DATA_S_LD(v) = TRUE; + NV_OWN_DATA_S_LD(v) = SUNTRUE; NV_DATA_S_LD(v) = data; } @@ -223,7 +223,7 @@ N_Vector N_VCloneEmpty_NrnSerialLD(N_Vector w) { } content->length = NV_LENGTH_S_LD(w); - content->own_data = FALSE; + content->own_data = SUNFALSE; content->data = NULL; /* Attach content and ops */ @@ -246,7 +246,7 @@ N_Vector N_VMake_NrnSerialLD(long int length, realtype* v_data) { if (length > 0) { /* Attach data */ - NV_OWN_DATA_S_LD(v) = FALSE; + NV_OWN_DATA_S_LD(v) = SUNFALSE; NV_DATA_S_LD(v) = v_data; } @@ -366,7 +366,7 @@ N_Vector N_VClone_NrnSerialLD(N_Vector w) { } /* Attach data */ - NV_OWN_DATA_S_LD(v) = TRUE; + NV_OWN_DATA_S_LD(v) = SUNTRUE; NV_DATA_S_LD(v) = data; } @@ -374,14 +374,14 @@ N_Vector N_VClone_NrnSerialLD(N_Vector w) { } void N_VDestroy_NrnSerialLD(N_Vector v) { - if (NV_OWN_DATA_S_LD(v) == TRUE) + if (NV_OWN_DATA_S_LD(v) == SUNTRUE) free(NV_DATA_S_LD(v)); free(v->content); free(v->ops); free(v); } -void N_VSpace_NrnSerialLD(N_Vector v, long int* lrw, long int* liw) { +void N_VSpace_NrnSerialLD(N_Vector v, sunindextype* lrw, sunindextype* liw) { *lrw = NV_LENGTH_S_LD(v); *liw = 1; } @@ -549,7 +549,7 @@ void N_VAbs_NrnSerialLD(N_Vector x, N_Vector z) { zd = NV_DATA_S_LD(z); for (i = 0; i < N; i++, xd++, zd++) - *zd = ABS(*xd); + *zd = SUNRabs(*xd); } void N_VInv_NrnSerialLD(N_Vector x, N_Vector z) { @@ -598,8 +598,8 @@ realtype N_VMaxNorm_NrnSerialLD(N_Vector x) { xd = NV_DATA_S_LD(x); for (i = 0; i < N; i++, xd++) { - if (ABS(*xd) > max) - max = ABS(*xd); + if (SUNRabs(*xd) > max) + max = SUNRabs(*xd); } return (max); @@ -623,7 +623,7 @@ realtype N_VWrmsNorm_NrnSerialLD(N_Vector x, N_Vector w) { sum = t; } - return RSqrt(sum / N); + return SUNRsqrt(sum / N); } realtype N_VWrmsNormMask_NrnSerialLD(N_Vector x, N_Vector w, N_Vector id) { @@ -647,7 +647,7 @@ realtype N_VWrmsNormMask_NrnSerialLD(N_Vector x, N_Vector w, N_Vector id) { } } - return RSqrt(sum / N); + return SUNRsqrt(sum / N); } realtype N_VMin_NrnSerialLD(N_Vector x) { @@ -686,7 +686,7 @@ realtype N_VWL2Norm_NrnSerialLD(N_Vector x, N_Vector w) { sum = t; } - return RSqrt(sum); + return SUNRsqrt(sum); } realtype N_VL1Norm_NrnSerialLD(N_Vector x) { @@ -699,7 +699,7 @@ realtype N_VL1Norm_NrnSerialLD(N_Vector x) { // Use Kahan summation instead of a long double accumulator for better portability. realtype sum{}, c{}; for (i = 0; i < N; i++) { - auto const y = ABS(xd[i]) - c; + auto const y = SUNRabs(xd[i]) - c; auto const t = sum + y; c = (t - sum) - y; sum = t; @@ -730,7 +730,7 @@ void N_VCompare_NrnSerialLD(realtype c, N_Vector x, N_Vector z) { zd = NV_DATA_S_LD(z); for (i = 0; i < N; i++, xd++, zd++) { - *zd = (ABS(*xd) >= c) ? ONE : ZERO; + *zd = (SUNRabs(*xd) >= c) ? ONE : ZERO; } } @@ -744,11 +744,11 @@ booleantype N_VInvTest_NrnSerialLD(N_Vector x, N_Vector z) { for (i = 0; i < N; i++) { if (*xd == ZERO) - return (FALSE); + return (SUNFALSE); *zd++ = ONE / (*xd++); } - return (TRUE); + return (SUNTRUE); } booleantype N_VConstrMask_NrnSerialLD(N_Vector c, N_Vector x, N_Vector m) { @@ -761,7 +761,7 @@ booleantype N_VConstrMask_NrnSerialLD(N_Vector c, N_Vector x, N_Vector m) { cd = NV_DATA_S_LD(c); md = NV_DATA_S_LD(m); - test = TRUE; + test = SUNTRUE; for (i = 0; i < N; i++, cd++, xd++, md++) { *md = ZERO; @@ -769,14 +769,14 @@ booleantype N_VConstrMask_NrnSerialLD(N_Vector c, N_Vector x, N_Vector m) { continue; if (*cd > ONEPT5 || (*cd) < -ONEPT5) { if ((*xd) * (*cd) <= ZERO) { - test = FALSE; + test = SUNFALSE; *md = ONE; } continue; } if ((*cd) > HALF || (*cd) < -HALF) { if ((*xd) * (*cd) < ZERO) { - test = FALSE; + test = SUNFALSE; *md = ONE; } } @@ -793,7 +793,7 @@ realtype N_VMinQuotient_NrnSerialLD(N_Vector num, N_Vector denom) { nd = NV_DATA_S_LD(num); dd = NV_DATA_S_LD(denom); - notEvenOnce = TRUE; + notEvenOnce = SUNTRUE; for (i = 0; i < N; i++, nd++, dd++) { if (*dd == ZERO) @@ -801,9 +801,9 @@ realtype N_VMinQuotient_NrnSerialLD(N_Vector num, N_Vector denom) { else { if (notEvenOnce) { min = *nd / *dd; - notEvenOnce = FALSE; + notEvenOnce = SUNFALSE; } else - min = MIN(min, (*nd) / (*dd)); + min = SUNMIN(min, (*nd) / (*dd)); } } diff --git a/src/nrniv/nvector_nrnserial_ld.h b/src/nrniv/nvector_nrnserial_ld.h index a5ff42dd7c..98225a0848 100644 --- a/src/nrniv/nvector_nrnserial_ld.h +++ b/src/nrniv/nvector_nrnserial_ld.h @@ -62,8 +62,8 @@ mv temp nvector_nrnserial_ld.cpp #pragma once -#include "nvector.h" -#include "sundialstypes.h" +#include /* serial N_Vector types, fcts, macros*/ +#include /* definition of type realtype*/ /* * ----------------------------------------------------------------- @@ -256,7 +256,7 @@ void N_VPrint_NrnSerialLD(N_Vector v); N_Vector N_VClone_NrnSerialLD(N_Vector w); void N_VDestroy_NrnSerialLD(N_Vector v); -void N_VSpace_NrnSerialLD(N_Vector v, long int* lrw, long int* liw); +void N_VSpace_NrnSerialLD(N_Vector v, sunindextype* lrw, sunindextype* liw); realtype* N_VGetArrayPointer_NrnSerialLD(N_Vector v); void N_VSetArrayPointer_NrnSerialLD(realtype* v_data, N_Vector v); void N_VLinearSum_NrnSerialLD(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); diff --git a/src/nrniv/nvector_nrnthread.cpp b/src/nrniv/nvector_nrnthread.cpp index 7084489011..86ef04fda1 100644 --- a/src/nrniv/nvector_nrnthread.cpp +++ b/src/nrniv/nvector_nrnthread.cpp @@ -19,10 +19,10 @@ #include #include -#include "shared/nvector_serial.h" +#include /* serial N_Vector types, fcts, macros*/ #include "nvector_nrnthread.h" -#include "shared/sundialsmath.h" -#include "shared/sundialstypes.h" +#include /* defs. of realtype, sunindextype */ +#include #include "section.h" #include "nrnmutdec.h" @@ -88,9 +88,9 @@ static booleantype bretval; retval = arg; \ }; \ unlock; -#define lockfalse \ - lock; \ - bretval = FALSE; \ +#define lockfalse \ + lock; \ + bretval = SUNFALSE; \ unlock; /* @@ -160,7 +160,7 @@ N_Vector N_VNewEmpty_NrnThread(long int length, int nthread, long int* sizes) { content->length = length; content->nt = nthread; - content->own_data = FALSE; + content->own_data = SUNFALSE; content->data = (N_Vector*) malloc(sizeof(N_Vector) * nthread); if (content->data == NULL) { free(ops); @@ -195,7 +195,7 @@ N_Vector N_VNew_NrnThread(long int length, int nthread, long int* sizes) { /* Create data */ if (length > 0) { /* Allocate memory */ - NV_OWN_DATA_NT(v) = TRUE; + NV_OWN_DATA_NT(v) = SUNTRUE; for (i = 0; i < nthread; ++i) { data = N_VNew_Serial(sizes[i]); if (data == NULL) { @@ -270,7 +270,7 @@ N_Vector N_VCloneEmpty_NrnThread(N_Vector w) { wcontent = NV_CONTENT_NT(w); content->length = NV_LENGTH_NT(w); - content->own_data = FALSE; + content->own_data = SUNFALSE; content->nt = wcontent->nt; content->data = (N_Vector*) malloc(sizeof(N_Vector) * content->nt); if (content->data == NULL) { @@ -421,7 +421,7 @@ N_Vector N_VClone_NrnThread(N_Vector w) { /* Create data */ if (length > 0) { - NV_OWN_DATA_NT(v) = TRUE; + NV_OWN_DATA_NT(v) = SUNTRUE; for (i = 0; i < nt; ++i) { wdata = NV_SUBVEC_NT(w, i); data = N_VClone(wdata); @@ -441,7 +441,7 @@ void N_VDestroy_NrnThread(N_Vector v) { int i, nt; N_Vector data; nt = NV_NT_NT(v); - if (NV_OWN_DATA_NT(v) == TRUE) { + if (NV_OWN_DATA_NT(v) == SUNTRUE) { if (NV_CONTENT_NT(v)->data) { for (i = 0; i < nt; ++i) { data = NV_SUBVEC_NT(v, i); @@ -457,7 +457,7 @@ void N_VDestroy_NrnThread(N_Vector v) { free(v); } -void N_VSpace_NrnThread(N_Vector v, long int* lrw, long int* liw) { +void N_VSpace_NrnThread(N_Vector v, sunindextype* lrw, sunindextype* liw) { *lrw = NV_LENGTH_NT(v); *liw = 1; } @@ -620,7 +620,7 @@ realtype N_VWrmsNorm_NrnThread(N_Vector x, N_Vector w) { retval = ZERO; xpass wpass nrn_multithread_job(vwrmsnorm); mydebug2("vwrmsnorm %.20g\n", RSqrt(retval / N)); - return (RSqrt(retval / N)); + return (SUNRsqrt(retval / N)); } static realtype vwrmsnormmask_help(N_Vector x, N_Vector w, N_Vector id) { @@ -654,7 +654,7 @@ realtype N_VWrmsNormMask_NrnThread(N_Vector x, N_Vector w, N_Vector id) { retval = ZERO; xpass wpass idpass nrn_multithread_job(vwrmsnormmask); mydebug2("vwrmsnormmask %.20g\n", RSqrt(retval / N)); - return (RSqrt(retval / N)); + return (SUNRsqrt(retval / N)); } static void* vmin(NrnThread* nt) { @@ -701,7 +701,7 @@ realtype N_VWL2Norm_NrnThread(N_Vector x, N_Vector w) { xpass wpass nrn_multithread_job(vwl2norm); N = NV_LENGTH_NT(x); mydebug2("vwl2norm %.20g\n", RSqrt(retval)); - return (RSqrt(retval)); + return (SUNRsqrt(retval)); } static void* vl1norm(NrnThread* nt) { @@ -718,6 +718,18 @@ realtype N_VL1Norm_NrnThread(N_Vector x) { return (retval); } +// This function was removed from Sundials3 +// I copied it from Sundials2 +// TODO replace by proper call +void N_VOneMask_Serial(N_Vector x) { + long int N = NV_LENGTH_S(x); + realtype* xd = NV_DATA_S(x); + for (long int i = 0; i < N; i++, xd++) { + if (*xd != ZERO) + *xd = ONE; + } +} + static void* v1mask(NrnThread* nt) { int i = nt->id; N_VOneMask_Serial(xarg(i)); @@ -747,7 +759,7 @@ static void* vinvtest(NrnThread* nt) { return nullptr; } booleantype N_VInvTest_NrnThread(N_Vector x, N_Vector z) { - bretval = TRUE; + bretval = SUNTRUE; xpass zpass nrn_multithread_job(vinvtest); mydebug2("vinvtest %d\n", bretval); return (bretval); @@ -763,7 +775,7 @@ static void* vconstrmask(NrnThread* nt) { return nullptr; } booleantype N_VConstrMask_NrnThread(N_Vector y, N_Vector x, N_Vector z) { - bretval = TRUE; + bretval = SUNTRUE; ypass xpass zpass nrn_multithread_job(vconstrmask); mydebug2("vconstrmask %d\n", bretval); return (bretval); diff --git a/src/nrniv/nvector_nrnthread.h b/src/nrniv/nvector_nrnthread.h index 24ab564b1c..b49a837108 100644 --- a/src/nrniv/nvector_nrnthread.h +++ b/src/nrniv/nvector_nrnthread.h @@ -55,8 +55,8 @@ #pragma once -#include "nvector.h" -#include "sundialstypes.h" +#include /* serial N_Vector types, fcts, macros*/ +#include /* definition of type realtype*/ extern "C" { extern void N_VOneMask_Serial(N_Vector x); } @@ -265,7 +265,7 @@ void N_VPrint_NrnThread(N_Vector v); N_Vector N_VClone_NrnThread(N_Vector w); void N_VDestroy_NrnThread(N_Vector v); -void N_VSpace_NrnThread(N_Vector v, long int* lrw, long int* liw); +void N_VSpace_NrnThread(N_Vector v, sunindextype* lrw, sunindextype* liw); realtype* N_VGetArrayPointer_NrnThread(N_Vector v); void N_VSetArrayPointer_NrnThread(realtype* v_data, N_Vector v); void N_VLinearSum_NrnThread(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); diff --git a/src/nrniv/nvector_nrnthread_ld.cpp b/src/nrniv/nvector_nrnthread_ld.cpp index 24e1b6e5b3..05f73e189a 100644 --- a/src/nrniv/nvector_nrnthread_ld.cpp +++ b/src/nrniv/nvector_nrnthread_ld.cpp @@ -19,10 +19,10 @@ #include #include -#include "shared/nvector_serial.h" +#include /* serial N_Vector types, fcts, macros*/ #include "nvector_nrnthread_ld.h" -#include "shared/sundialsmath.h" -#include "shared/sundialstypes.h" +#include /* defs. of realtype, sunindextype */ +#include #include "section.h" #include "nrnmutdec.h" @@ -89,9 +89,9 @@ static booleantype bretval; retval = arg; \ }; \ unlock; -#define lockfalse \ - lock; \ - bretval = FALSE; \ +#define lockfalse \ + lock; \ + bretval = SUNFALSE; \ unlock; /* @@ -161,7 +161,7 @@ N_Vector N_VNewEmpty_NrnThreadLD(long int length, int nthread, long int* sizes) content->length = length; content->nt = nthread; - content->own_data = FALSE; + content->own_data = SUNFALSE; content->data = (N_Vector*) malloc(sizeof(N_Vector) * nthread); if (content->data == NULL) { free(ops); @@ -196,9 +196,9 @@ N_Vector N_VNew_NrnThreadLD(long int length, int nthread, long int* sizes) { /* Create data */ if (length > 0) { /* Allocate memory */ - NV_OWN_DATA_NT_LD(v) = TRUE; + NV_OWN_DATA_NT_LD(v) = SUNTRUE; for (i = 0; i < nthread; ++i) { - data = N_VNew_Serial(sizes[i]); + data = N_VNew_Serial(sizes[i]); // TODO - SUNctxt if (data == NULL) { N_VDestroy_NrnThreadLD(v); return (NULL); @@ -271,7 +271,7 @@ N_Vector N_VCloneEmpty_NrnThreadLD(N_Vector w) { wcontent = NV_CONTENT_NT_LD(w); content->length = NV_LENGTH_NT_LD(w); - content->own_data = FALSE; + content->own_data = SUNFALSE; content->nt = wcontent->nt; content->data = (N_Vector*) malloc(sizeof(N_Vector) * content->nt); if (content->data == NULL) { @@ -421,7 +421,7 @@ N_Vector N_VClone_NrnThreadLD(N_Vector w) { /* Create data */ if (length > 0) { - NV_OWN_DATA_NT_LD(v) = TRUE; + NV_OWN_DATA_NT_LD(v) = SUNTRUE; for (i = 0; i < nt; ++i) { wdata = NV_SUBVEC_NT_LD(w, i); data = N_VClone(wdata); @@ -441,7 +441,7 @@ void N_VDestroy_NrnThreadLD(N_Vector v) { int i, nt; N_Vector data; nt = NV_NT_NT_LD(v); - if (NV_OWN_DATA_NT_LD(v) == TRUE) { + if (NV_OWN_DATA_NT_LD(v) == SUNTRUE) { if (NV_CONTENT_NT_LD(v)->data) { for (i = 0; i < nt; ++i) { data = NV_SUBVEC_NT_LD(v, i); @@ -457,7 +457,7 @@ void N_VDestroy_NrnThreadLD(N_Vector v) { free(v); } -void N_VSpace_NrnThreadLD(N_Vector v, long int* lrw, long int* liw) { +void N_VSpace_NrnThreadLD(N_Vector v, sunindextype* lrw, sunindextype* liw) { *lrw = NV_LENGTH_NT_LD(v); *liw = 1; } @@ -631,7 +631,7 @@ realtype N_VWrmsNorm_NrnThreadLD(N_Vector x, N_Vector w) { retval = retval_comp = 0.0; xpass wpass nrn_multithread_job(vwrmsnorm); mydebug2("vwrmsnorm %.20g\n", RSqrt(retval / N)); - return (RSqrt(retval / N)); + return (SUNRsqrt(retval / N)); } static realtype vwrmsnormmask_help(N_Vector x, N_Vector w, N_Vector id) { @@ -665,7 +665,7 @@ realtype N_VWrmsNormMask_NrnThreadLD(N_Vector x, N_Vector w, N_Vector id) { retval = ZERO; xpass wpass idpass nrn_multithread_job(vwrmsnormmask); mydebug2("vwrmsnormmask %.20g\n", RSqrt(retval / N)); - return (RSqrt(retval / N)); + return (SUNRsqrt(retval / N)); } static void* vmin(NrnThread* nt) { @@ -712,7 +712,7 @@ realtype N_VWL2Norm_NrnThreadLD(N_Vector x, N_Vector w) { xpass wpass nrn_multithread_job(vwl2norm); N = NV_LENGTH_NT_LD(x); mydebug2("vwl2norm %.20g\n", RSqrt(retval)); - return (RSqrt(retval)); + return (SUNRsqrt(retval)); } static void* vl1norm(NrnThread* nt) { @@ -758,7 +758,7 @@ static void* vinvtest(NrnThread* nt) { return nullptr; } booleantype N_VInvTest_NrnThreadLD(N_Vector x, N_Vector z) { - bretval = TRUE; + bretval = SUNTRUE; xpass zpass nrn_multithread_job(vinvtest); mydebug2("vinvtest %d\n", bretval); return (bretval); @@ -774,7 +774,7 @@ static void* vconstrmask(NrnThread* nt) { return nullptr; } booleantype N_VConstrMask_NrnThreadLD(N_Vector y, N_Vector x, N_Vector z) { - bretval = TRUE; + bretval = SUNTRUE; ypass xpass zpass nrn_multithread_job(vconstrmask); mydebug2("vconstrmask %d\n", bretval); return (bretval); diff --git a/src/nrniv/nvector_nrnthread_ld.h b/src/nrniv/nvector_nrnthread_ld.h index a0dd9467f0..b36c58665e 100644 --- a/src/nrniv/nvector_nrnthread_ld.h +++ b/src/nrniv/nvector_nrnthread_ld.h @@ -61,8 +61,8 @@ mv temp nvector_nrnthread_ld.h #pragma once -#include "nvector.h" -#include "sundialstypes.h" +#include /* serial N_Vector types, fcts, macros*/ +#include /* definition of type realtype*/ extern "C" { extern void N_VOneMask_Serial(N_Vector x); } @@ -274,7 +274,7 @@ void N_VPrint_NrnThreadLD(N_Vector v); N_Vector N_VClone_NrnThreadLD(N_Vector w); void N_VDestroy_NrnThreadLD(N_Vector v); -void N_VSpace_NrnThreadLD(N_Vector v, long int* lrw, long int* liw); +void N_VSpace_NrnThreadLD(N_Vector v, sunindextype* lrw, sunindextype* liw); realtype* N_VGetArrayPointer_NrnThreadLD(N_Vector v); void N_VSetArrayPointer_NrnThreadLD(realtype* v_data, N_Vector v); void N_VLinearSum_NrnThreadLD(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); diff --git a/src/sundials/shared/nvector_parallel.c b/src/nrniv/nvector_parallel.cpp old mode 100755 new mode 100644 similarity index 61% rename from src/sundials/shared/nvector_parallel.c rename to src/nrniv/nvector_parallel.cpp index 6b843651e0..130004075e --- a/src/sundials/shared/nvector_parallel.c +++ b/src/nrniv/nvector_parallel.cpp @@ -1,32 +1,35 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- +// modified to use nrnmpi_comm and work with NRNMPI_DYNAMICLOAD +// clang-format off +// Keep up to date with the original of +// sundials/src/sundials-external/src/nvec_par/nvector_parallel.c +#include <../../nrnconf.h> + +/* ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. + * LLNS Copyright Start + * Copyright (c) 2014, Lawrence Livermore National Security + * This work was performed under the auspices of the U.S. Department + * of Energy by Lawrence Livermore National Laboratory in part under + * Contract W-7405-Eng-48 and in part under Contract DE-AC52-07NA27344. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. - * For details, see sundials/shared/LICENSE. + * For details, see the LICENSE file. + * LLNS Copyright End * ----------------------------------------------------------------- * This is the implementation file for a parallel MPI implementation * of the NVECTOR package. - * ----------------------------------------------------------------- - */ + * -----------------------------------------------------------------*/ #include #include -#include -extern void nrnmpi_dbl_allreduce_vec(double* src, double* dest, int cnt, int type); -extern void nrnmpi_long_allreduce_vec(long* src, long* dest, int cnt, int type); -extern int nrnmpi_numprocs; - #include "nvector_parallel.h" -#include "sundialsmath.h" -#include "sundialstypes.h" +#define MPI_Comm int // or perhaps get rid of them all +#include "nrnmpi.h" +#include +#include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) @@ -41,8 +44,6 @@ extern int nrnmpi_numprocs; /* Private function prototypes */ -/* Reduction operations add/max/min over the processor group */ -static realtype VAllReduce_Parallel(realtype d, int op, MPI_Comm comm); /* z=x */ static void VCopy_Parallel(N_Vector x, N_Vector z); /* z=x+y */ @@ -54,7 +55,7 @@ static void VNeg_Parallel(N_Vector x, N_Vector z); /* z=c(x+y) */ static void VScaleSum_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=c(x-y) */ -static void VScaleDiff_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z); +static void VScaleDiff_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=ax+y */ static void VLin1_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z); /* z=ax-y */ @@ -70,36 +71,52 @@ static void VScaleBy_Parallel(realtype a, N_Vector x); * ----------------------------------------------------------------- */ +/* ---------------------------------------------------------------- + * Returns vector type ID. Used to identify vector implementation + * from abstract N_Vector interface. + */ + +N_Vector_ID N_VGetVectorID_Parallel(N_Vector v) +{ + return SUNDIALS_NVEC_PARALLEL; +} + /* ---------------------------------------------------------------- * Function to create a new parallel vector with empty data array */ -N_Vector N_VNewEmpty_Parallel(MPI_Comm comm, - long int local_length, - long int global_length) +N_Vector N_VNewEmpty_Parallel(MPI_Comm comm, + sunindextype local_length, + sunindextype global_length) { N_Vector v; N_Vector_Ops ops; N_VectorContent_Parallel content; - long int n, Nsum; - + sunindextype n, Nsum; + long n1, Nsum1; /* Compute global length as sum of local lengths */ n = local_length; - nrnmpi_long_allreduce_vec(&n, &Nsum, 1, 1); + n1 = long(n); + nrnmpi_long_allreduce_vec(&n1, &Nsum1, 1, 1); + Nsum = sunindextype(Nsum1); if (Nsum != global_length) { - printf(BAD_N); + fprintf(stderr, BAD_N); return(NULL); - } + } /* Create vector */ + v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); - + /* Create vector operation structure */ + ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } + ops->nvgetvectorid = N_VGetVectorID_Parallel; ops->nvclone = N_VClone_Parallel; + ops->nvcloneempty = N_VCloneEmpty_Parallel; ops->nvdestroy = N_VDestroy_Parallel; ops->nvspace = N_VSpace_Parallel; ops->nvgetarraypointer = N_VGetArrayPointer_Parallel; @@ -125,34 +142,36 @@ N_Vector N_VNewEmpty_Parallel(MPI_Comm comm, ops->nvminquotient = N_VMinQuotient_Parallel; /* Create content */ + content = NULL; content = (N_VectorContent_Parallel) malloc(sizeof(struct _N_VectorContent_Parallel)); if (content == NULL) { free(ops); free(v); return(NULL); } /* Attach lengths and communicator */ - content->local_length = local_length; + content->local_length = local_length; content->global_length = global_length; - content->comm = comm; - content->own_data = FALSE; - content->data = NULL; + content->comm = comm; + content->own_data = SUNFALSE; + content->data = NULL; /* Attach content and ops */ v->content = content; - v->ops = ops; + v->ops = ops; return(v); } -/* ---------------------------------------------------------------- +/* ---------------------------------------------------------------- * Function to create a new parallel vector */ -N_Vector N_VNew_Parallel(MPI_Comm comm, - long int local_length, - long int global_length) +N_Vector N_VNew_Parallel(MPI_Comm comm, + sunindextype local_length, + sunindextype global_length) { N_Vector v; realtype *data; + v = NULL; v = N_VNewEmpty_Parallel(comm, local_length, global_length); if (v == NULL) return(NULL); @@ -160,123 +179,61 @@ N_Vector N_VNew_Parallel(MPI_Comm comm, if(local_length > 0) { /* Allocate memory */ + data = NULL; data = (realtype *) malloc(local_length * sizeof(realtype)); - if(data == NULL) {N_VDestroy_Parallel(v);return(NULL);} + if(data == NULL) { N_VDestroy_Parallel(v); return(NULL); } /* Attach data */ - NV_OWN_DATA_P(v) = TRUE; - NV_DATA_P(v) = data; + NV_OWN_DATA_P(v) = SUNTRUE; + NV_DATA_P(v) = data; } return(v); } -/* ---------------------------------------------------------------------------- - * Function to clone from a template a new vector with empty (NULL) data array - */ - -N_Vector N_VCloneEmpty_Parallel(N_Vector w) -{ - N_Vector v; - N_Vector_Ops ops; - N_VectorContent_Parallel content; - - if (w == NULL) return(NULL); - - /* Create vector */ - v = (N_Vector) malloc(sizeof *v); - if (v == NULL) return(NULL); - - /* Create vector operation structure */ - ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); - if (ops == NULL) { free(v); return(NULL); } - - ops->nvclone = w->ops->nvclone; - ops->nvdestroy = w->ops->nvdestroy; - ops->nvspace = w->ops->nvspace; - ops->nvgetarraypointer = w->ops->nvgetarraypointer; - ops->nvsetarraypointer = w->ops->nvsetarraypointer; - ops->nvlinearsum = w->ops->nvlinearsum; - ops->nvconst = w->ops->nvconst; - ops->nvprod = w->ops->nvprod; - ops->nvdiv = w->ops->nvdiv; - ops->nvscale = w->ops->nvscale; - ops->nvabs = w->ops->nvabs; - ops->nvinv = w->ops->nvinv; - ops->nvaddconst = w->ops->nvaddconst; - ops->nvdotprod = w->ops->nvdotprod; - ops->nvmaxnorm = w->ops->nvmaxnorm; - ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; - ops->nvwrmsnorm = w->ops->nvwrmsnorm; - ops->nvmin = w->ops->nvmin; - ops->nvwl2norm = w->ops->nvwl2norm; - ops->nvl1norm = w->ops->nvl1norm; - ops->nvcompare = w->ops->nvcompare; - ops->nvinvtest = w->ops->nvinvtest; - ops->nvconstrmask = w->ops->nvconstrmask; - ops->nvminquotient = w->ops->nvminquotient; - - /* Create content */ - content = (N_VectorContent_Parallel) malloc(sizeof(struct _N_VectorContent_Parallel)); - if (content == NULL) { free(ops); free(v); return(NULL); } - - /* Attach lengths and communicator */ - content->local_length = NV_LOCLENGTH_P(w); - content->global_length = NV_GLOBLENGTH_P(w); - content->comm = NV_COMM_P(w); - content->own_data = FALSE; - content->data = NULL; - - /* Attach content and ops */ - v->content = content; - v->ops = ops; - - return(v); -} - -/* ---------------------------------------------------------------- - * Function to create a parallel N_Vector with user data component +/* ---------------------------------------------------------------- + * Function to create a parallel N_Vector with user data component */ -N_Vector N_VMake_Parallel(MPI_Comm comm, - long int local_length, - long int global_length, +N_Vector N_VMake_Parallel(MPI_Comm comm, + sunindextype local_length, + sunindextype global_length, realtype *v_data) { N_Vector v; + v = NULL; v = N_VNewEmpty_Parallel(comm, local_length, global_length); if (v == NULL) return(NULL); if (local_length > 0) { /* Attach data */ - NV_OWN_DATA_P(v) = FALSE; - NV_DATA_P(v) = v_data; + NV_OWN_DATA_P(v) = SUNFALSE; + NV_DATA_P(v) = v_data; } return(v); } -/* ---------------------------------------------------------------- - * Function to create an array of new parallel vectors. +/* ---------------------------------------------------------------- + * Function to create an array of new parallel vectors. */ -N_Vector *N_VNewVectorArray_Parallel(int count, - MPI_Comm comm, - long int local_length, - long int global_length) +N_Vector *N_VCloneVectorArray_Parallel(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); + vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); - for (j=0; jnvgetvectorid = w->ops->nvgetvectorid; + ops->nvclone = w->ops->nvclone; + ops->nvcloneempty = w->ops->nvcloneempty; + ops->nvdestroy = w->ops->nvdestroy; + ops->nvspace = w->ops->nvspace; + ops->nvgetarraypointer = w->ops->nvgetarraypointer; + ops->nvsetarraypointer = w->ops->nvsetarraypointer; + ops->nvlinearsum = w->ops->nvlinearsum; + ops->nvconst = w->ops->nvconst; + ops->nvprod = w->ops->nvprod; + ops->nvdiv = w->ops->nvdiv; + ops->nvscale = w->ops->nvscale; + ops->nvabs = w->ops->nvabs; + ops->nvinv = w->ops->nvinv; + ops->nvaddconst = w->ops->nvaddconst; + ops->nvdotprod = w->ops->nvdotprod; + ops->nvmaxnorm = w->ops->nvmaxnorm; + ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; + ops->nvwrmsnorm = w->ops->nvwrmsnorm; + ops->nvmin = w->ops->nvmin; + ops->nvwl2norm = w->ops->nvwl2norm; + ops->nvl1norm = w->ops->nvl1norm; + ops->nvcompare = w->ops->nvcompare; + ops->nvinvtest = w->ops->nvinvtest; + ops->nvconstrmask = w->ops->nvconstrmask; + ops->nvminquotient = w->ops->nvminquotient; + + /* Create content */ + content = NULL; + content = (N_VectorContent_Parallel) malloc(sizeof(struct _N_VectorContent_Parallel)); + if (content == NULL) { free(ops); free(v); return(NULL); } + + /* Attach lengths and communicator */ + content->local_length = NV_LOCLENGTH_P(w); + content->global_length = NV_GLOBLENGTH_P(w); + content->comm = NV_COMM_P(w); + content->own_data = SUNFALSE; + content->data = NULL; + + /* Attach content and ops */ + v->content = content; + v->ops = ops; + + return(v); +} + N_Vector N_VClone_Parallel(N_Vector w) { N_Vector v; realtype *data; - long int local_length; + sunindextype local_length; + v = NULL; v = N_VCloneEmpty_Parallel(w); if (v == NULL) return(NULL); @@ -373,12 +427,13 @@ N_Vector N_VClone_Parallel(N_Vector w) if(local_length > 0) { /* Allocate memory */ + data = NULL; data = (realtype *) malloc(local_length * sizeof(realtype)); - if(data == NULL) {N_VDestroy_Parallel(v);return(NULL);} + if(data == NULL) { N_VDestroy_Parallel(v); return(NULL); } /* Attach data */ - NV_OWN_DATA_P(v) = TRUE; - NV_DATA_P(v) = data; + NV_OWN_DATA_P(v) = SUNTRUE; + NV_DATA_P(v) = data; } return(v); @@ -386,53 +441,57 @@ N_Vector N_VClone_Parallel(N_Vector w) void N_VDestroy_Parallel(N_Vector v) { - if ( (NV_OWN_DATA_P(v) == TRUE) && (NV_DATA_P(v) != NULL) ) + if ((NV_OWN_DATA_P(v) == SUNTRUE) && (NV_DATA_P(v) != NULL)) { free(NV_DATA_P(v)); - free(v->content); - free(v->ops); - free(v); + NV_DATA_P(v) = NULL; + } + free(v->content); v->content = NULL; + free(v->ops); v->ops = NULL; + free(v); v = NULL; + + return; } -void N_VSpace_Parallel(N_Vector v, long int *lrw, long int *liw) +void N_VSpace_Parallel(N_Vector v, sunindextype *lrw, sunindextype *liw) { - MPI_Comm comm; int npes; - comm = NV_COMM_P(v); npes = nrnmpi_numprocs; - + *lrw = NV_GLOBLENGTH_P(v); - *liw = 2 * npes; + *liw = 2*npes; + + return; } realtype *N_VGetArrayPointer_Parallel(N_Vector v) { - realtype *v_data; - - v_data = NV_DATA_P(v); - - return(v_data); + return((realtype *) NV_DATA_P(v)); } void N_VSetArrayPointer_Parallel(realtype *v_data, N_Vector v) { if (NV_LOCLENGTH_P(v) > 0) NV_DATA_P(v) = v_data; + + return; } void N_VLinearSum_Parallel(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) { - long int i, N; + sunindextype i, N; realtype c, *xd, *yd, *zd; N_Vector v1, v2; booleantype test; + xd = yd = zd = NULL; + if ((b == ONE) && (z == y)) { /* BLAS usage: axpy y <- ax+y */ - Vaxpy_Parallel(a,x,y); + Vaxpy_Parallel(a, x, y); return; } if ((a == ONE) && (z == x)) { /* BLAS usage: axpy x <- by+x */ - Vaxpy_Parallel(b,y,x); + Vaxpy_Parallel(b, y, x); return; } @@ -492,61 +551,76 @@ void N_VLinearSum_Parallel(realtype a, N_Vector x, realtype b, N_Vector y, N_Vec (1) a == other, b == 0.0 - user should have called N_VScale (2) a == 0.0, b == other - user should have called N_VScale (3) a,b == other, a !=b, a != -b */ - + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); - for (i=0; i < N; i++) - *zd++ = a * (*xd++) + b * (*yd++); + for (i = 0; i < N; i++) + zd[i] = (a*xd[i])+(b*yd[i]); + + return; } void N_VConst_Parallel(realtype c, N_Vector z) { - long int i, N; + sunindextype i, N; realtype *zd; + zd = NULL; + N = NV_LOCLENGTH_P(z); zd = NV_DATA_P(z); - for (i=0; i < N; i++) - *zd++ = c; + for (i = 0; i < N; i++) zd[i] = c; + + return; } void N_VProd_Parallel(N_Vector x, N_Vector y, N_Vector z) { - long int i, N; + sunindextype i, N; realtype *xd, *yd, *zd; + xd = yd = zd = NULL; + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); - for (i=0; i < N; i++) - *zd++ = (*xd++) * (*yd++); + for (i = 0; i < N; i++) + zd[i] = xd[i]*yd[i]; + + return; } void N_VDiv_Parallel(N_Vector x, N_Vector y, N_Vector z) { - long int i, N; + sunindextype i, N; realtype *xd, *yd, *zd; + xd = yd = zd = NULL; + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); - for (i=0; i < N; i++) - *zd++ = (*xd++) / (*yd++); + for (i = 0; i < N; i++) + zd[i] = xd[i]/yd[i]; + + return; } void N_VScale_Parallel(realtype c, N_Vector x, N_Vector z) { - long int i, N; + sunindextype i, N; realtype *xd, *zd; + xd = zd = NULL; + if (z == x) { /* BLAS usage: scale x <- cx */ VScaleBy_Parallel(c, x); return; @@ -560,294 +634,333 @@ void N_VScale_Parallel(realtype c, N_Vector x, N_Vector z) N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); - for (i=0; i < N; i++) - *zd++ = c * (*xd++); + for (i = 0; i < N; i++) + zd[i] = c*xd[i]; } + + return; } void N_VAbs_Parallel(N_Vector x, N_Vector z) { - long int i, N; + sunindextype i, N; realtype *xd, *zd; + xd = zd = NULL; + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); - for (i=0; i < N; i++, xd++, zd++) - *zd = ABS(*xd); + for (i = 0; i < N; i++) + zd[i] = SUNRabs(xd[i]); + + return; } void N_VInv_Parallel(N_Vector x, N_Vector z) { - long int i, N; + sunindextype i, N; realtype *xd, *zd; + xd = zd = NULL; + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); - for (i=0; i < N; i++) - *zd++ = ONE / (*xd++); + for (i = 0; i < N; i++) + zd[i] = ONE/xd[i]; + + return; } void N_VAddConst_Parallel(N_Vector x, realtype b, N_Vector z) { - long int i, N; + sunindextype i, N; realtype *xd, *zd; - + + xd = zd = NULL; + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); - - for (i=0; i < N; i++) *zd++ = (*xd++) + b; + + for (i = 0; i < N; i++) zd[i] = xd[i]+b; + + return; } realtype N_VDotProd_Parallel(N_Vector x, N_Vector y) { - long int i, N; - realtype sum = ZERO, *xd, *yd, gsum; - MPI_Comm comm; + sunindextype i, N; + realtype sum, *xd, *yd, gsum; + + sum = ZERO; + xd = yd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); - comm = NV_COMM_P(x); - for (i=0; i < N; i++) sum += xd[i] * yd[i]; + for (i = 0; i < N; i++) sum += xd[i]*yd[i]; - gsum = VAllReduce_Parallel(sum, 1, comm); + nrnmpi_dbl_allreduce_vec(&sum, &gsum, 1, 1); return(gsum); } realtype N_VMaxNorm_Parallel(N_Vector x) { - long int i, N; + sunindextype i, N; realtype max, *xd, gmax; - MPI_Comm comm; + + xd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); - comm = NV_COMM_P(x); max = ZERO; - for (i=0; i < N; i++, xd++) { - if (ABS(*xd) > max) max = ABS(*xd); + for (i = 0; i < N; i++) { + if (SUNRabs(xd[i]) > max) max = SUNRabs(xd[i]); } - - gmax = VAllReduce_Parallel(max, 2, comm); + + nrnmpi_dbl_allreduce_vec(&max, &gmax, 1, 2); return(gmax); } realtype N_VWrmsNorm_Parallel(N_Vector x, N_Vector w) { - long int i, N, N_global; - realtype sum = ZERO, prodi, *xd, *wd, gsum; - MPI_Comm comm; + sunindextype i, N, N_global; + realtype sum, prodi, *xd, *wd, gsum; - N = NV_LOCLENGTH_P(x); + sum = ZERO; + xd = wd = NULL; + + N = NV_LOCLENGTH_P(x); N_global = NV_GLOBLENGTH_P(x); - xd = NV_DATA_P(x); - wd = NV_DATA_P(w); - comm = NV_COMM_P(x); + xd = NV_DATA_P(x); + wd = NV_DATA_P(w); - for (i=0; i < N; i++) { - prodi = (*xd++) * (*wd++); - sum += prodi * prodi; + for (i = 0; i < N; i++) { + prodi = xd[i]*wd[i]; + sum += SUNSQR(prodi); } - gsum = VAllReduce_Parallel(sum, 1, comm); - return(RSqrt(gsum / N_global)); + nrnmpi_dbl_allreduce_vec(&sum, &gsum, 1, 1); + + return(SUNRsqrt(gsum/N_global)); } realtype N_VWrmsNormMask_Parallel(N_Vector x, N_Vector w, N_Vector id) { - long int i, N, N_global; - realtype sum = ZERO, prodi, *xd, *wd, *idd, gsum; - MPI_Comm comm; + sunindextype i, N, N_global; + realtype sum, prodi, *xd, *wd, *idd, gsum; - N = NV_LOCLENGTH_P(x); + sum = ZERO; + xd = wd = idd = NULL; + + N = NV_LOCLENGTH_P(x); N_global = NV_GLOBLENGTH_P(x); - xd = NV_DATA_P(x); - wd = NV_DATA_P(w); - idd = NV_DATA_P(id); - comm = NV_COMM_P(x); + xd = NV_DATA_P(x); + wd = NV_DATA_P(w); + idd = NV_DATA_P(id); - for (i=0; i < N; i++) { + for (i = 0; i < N; i++) { if (idd[i] > ZERO) { - prodi = xd[i] * wd[i]; - sum += prodi * prodi; + prodi = xd[i]*wd[i]; + sum += SUNSQR(prodi); } } - gsum = VAllReduce_Parallel(sum, 1, comm); - return(RSqrt(gsum / N_global)); + nrnmpi_dbl_allreduce_vec(&sum, &gsum, 1, 1); + + return(SUNRsqrt(gsum/N_global)); } realtype N_VMin_Parallel(N_Vector x) { - long int i, N; + sunindextype i, N; realtype min, *xd, gmin; - MPI_Comm comm; + + xd = NULL; N = NV_LOCLENGTH_P(x); - comm = NV_COMM_P(x); min = BIG_REAL; if (N > 0) { xd = NV_DATA_P(x); - + min = xd[0]; - - xd++; - for (i=1; i < N; i++, xd++) { - if ((*xd) < min) min = *xd; + + for (i = 1; i < N; i++) { + if (xd[i] < min) min = xd[i]; } } - - gmin = VAllReduce_Parallel(min, 3, comm); + + nrnmpi_dbl_allreduce_vec(&min, &gmin, 1, 3); + return(gmin); } realtype N_VWL2Norm_Parallel(N_Vector x, N_Vector w) { - long int i, N; - realtype sum = ZERO, prodi, *xd, *wd, gsum; - MPI_Comm comm; + sunindextype i, N; + realtype sum, prodi, *xd, *wd, gsum; + + sum = ZERO; + xd = wd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); wd = NV_DATA_P(w); - comm = NV_COMM_P(x); - for (i=0; i < N; i++) { - prodi = (*xd++) * (*wd++); - sum += prodi * prodi; + for (i = 0; i < N; i++) { + prodi = xd[i]*wd[i]; + sum += SUNSQR(prodi); } - gsum = VAllReduce_Parallel(sum, 1, comm); - return(RSqrt(gsum)); + nrnmpi_dbl_allreduce_vec(&sum, &gsum, 1, 1); + + return(SUNRsqrt(gsum)); } realtype N_VL1Norm_Parallel(N_Vector x) { - long int i, N; - realtype sum = ZERO, gsum, *xd; - MPI_Comm comm; + sunindextype i, N; + realtype sum, gsum, *xd; + + sum = ZERO; + xd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); - comm = NV_COMM_P(x); - for (i=0; i= c) ? ONE : ZERO; + for (i = 0; i < N; i++) { + zd[i] = (SUNRabs(xd[i]) >= c) ? ONE : ZERO; } + + return; } booleantype N_VInvTest_Parallel(N_Vector x, N_Vector z) { - long int i, N; + sunindextype i, N; realtype *xd, *zd, val, gval; - MPI_Comm comm; + + xd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); - comm = NV_COMM_P(x); val = ONE; - for (i=0; i < N; i++) { - if (*xd == ZERO) + for (i = 0; i < N; i++) { + if (xd[i] == ZERO) val = ZERO; else - *zd++ = ONE / (*xd++); + zd[i] = ONE/xd[i]; } - gval = VAllReduce_Parallel(val, 3, comm); + nrnmpi_dbl_allreduce_vec(&val, &gval, 1, 3); + if (gval == ZERO) - return(FALSE); + return(SUNFALSE); else - return(TRUE); + return(SUNTRUE); } booleantype N_VConstrMask_Parallel(N_Vector c, N_Vector x, N_Vector m) { - long int i, N; - booleantype test; + sunindextype i, N; + realtype temp; realtype *cd, *xd, *md; - MPI_Comm comm; - + booleantype test; + + cd = xd = md = NULL; + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); cd = NV_DATA_P(c); md = NV_DATA_P(m); - comm = NV_COMM_P(x); - test = TRUE; + temp = ZERO; - for (i=0; i ONEPT5 || (*cd) < -ONEPT5) { - if ( (*xd)*(*cd) <= ZERO) {test = FALSE; *md = ONE; } + for (i = 0; i < N; i++) { + md[i] = ZERO; + + /* Continue if no constraints were set for the variable */ + if (cd[i] == ZERO) continue; - } - if ( (*cd) > HALF || (*cd) < -HALF) { - if ( (*xd)*(*cd) < ZERO ) {test = FALSE; *md = ONE; } + + /* Check if a set constraint has been violated */ + test = (SUNRabs(cd[i]) > ONEPT5 && xd[i]*cd[i] <= ZERO) || + (SUNRabs(cd[i]) > HALF && xd[i]*cd[i] < ZERO); + if (test) { + temp = md[i] = ONE; } } - return((booleantype)VAllReduce_Parallel((realtype)test, 3, comm)); + /* Find max temp across all MPI ranks */ + realtype gtemp; + nrnmpi_dbl_allreduce_vec(&temp, >emp, 1, 2); + temp = gtemp; + + /* Return false if any constraint was violated */ + return (temp == ONE) ? SUNFALSE : SUNTRUE; } realtype N_VMinQuotient_Parallel(N_Vector num, N_Vector denom) { booleantype notEvenOnce; - long int i, N; - realtype *nd, *dd, min=0.0; - MPI_Comm comm; + sunindextype i, N; + realtype *nd, *dd, min; + + nd = dd = NULL; N = NV_LOCLENGTH_P(num); nd = NV_DATA_P(num); dd = NV_DATA_P(denom); - comm = NV_COMM_P(num); - notEvenOnce = TRUE; + notEvenOnce = SUNTRUE; + min = BIG_REAL; - for (i = 0; i < N; i++, nd++, dd++) { - if (*dd == ZERO) continue; + for (i = 0; i < N; i++) { + if (dd[i] == ZERO) continue; else { - if (notEvenOnce) { - min = *nd / *dd ; - notEvenOnce = FALSE; + if (!notEvenOnce) min = SUNMIN(min, nd[i]/dd[i]); + else { + min = nd[i]/dd[i]; + notEvenOnce = SUNFALSE; } - else min = MIN(min, (*nd) / (*dd)); } } - if (notEvenOnce || (N == 0)) min = BIG_REAL; - - return(VAllReduce_Parallel(min, 3, comm)); + realtype gmin; + nrnmpi_dbl_allreduce_vec(&min, &gmin, 3, 1); + return gmin; } /* @@ -856,163 +969,189 @@ realtype N_VMinQuotient_Parallel(N_Vector num, N_Vector denom) * ----------------------------------------------------------------- */ -static realtype VAllReduce_Parallel(realtype d, int op, MPI_Comm comm) -{ - /* - * This function does a global reduction. The operation is - * sum if op = 1, - * max if op = 2, - * min if op = 3. - * The operation is over all processors in the communicator - */ - realtype out = 0.0; - nrnmpi_dbl_allreduce_vec(&d, &out, 1, op); - return(out); -} - static void VCopy_Parallel(N_Vector x, N_Vector z) { - long int i, N; + sunindextype i, N; realtype *xd, *zd; + xd = zd = NULL; + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); - for (i=0; i < N; i++) - *zd++ = *xd++; + for (i = 0; i < N; i++) + zd[i] = xd[i]; + + return; } static void VSum_Parallel(N_Vector x, N_Vector y, N_Vector z) { - long int i, N; + sunindextype i, N; realtype *xd, *yd, *zd; + xd = yd = zd = NULL; + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); - for (i=0; i < N; i++) - *zd++ = (*xd++) + (*yd++); + for (i = 0; i < N; i++) + zd[i] = xd[i]+yd[i]; + + return; } static void VDiff_Parallel(N_Vector x, N_Vector y, N_Vector z) { - long int i, N; + sunindextype i, N; realtype *xd, *yd, *zd; - + + xd = yd = zd = NULL; + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); - for (i=0; i < N; i++) - *zd++ = (*xd++) - (*yd++); + for (i = 0; i < N; i++) + zd[i] = xd[i]-yd[i]; + + return; } static void VNeg_Parallel(N_Vector x, N_Vector z) { - long int i, N; + sunindextype i, N; realtype *xd, *zd; + xd = zd = NULL; + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); - for (i=0; i < N; i++) - *zd++ = -(*xd++); + for (i = 0; i < N; i++) + zd[i] = -xd[i]; + + return; } static void VScaleSum_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z) { - long int i, N; + sunindextype i, N; realtype *xd, *yd, *zd; + xd = yd = zd = NULL; + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); - for (i=0; i < N; i++) - *zd++ = c * ((*xd++) + (*yd++)); + for (i = 0; i < N; i++) + zd[i] = c*(xd[i]+yd[i]); + + return; } static void VScaleDiff_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z) { - long int i, N; + sunindextype i, N; realtype *xd, *yd, *zd; + xd = yd = zd = NULL; + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); - for (i=0; i < N; i++) - *zd++ = c * ((*xd++) - (*yd++)); + for (i = 0; i < N; i++) + zd[i] = c*(xd[i]-yd[i]); + + return; } static void VLin1_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z) { - long int i, N; + sunindextype i, N; realtype *xd, *yd, *zd; + xd = yd = zd = NULL; + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); - for (i=0; i < N; i++) - *zd++ = a * (*xd++) + (*yd++); + for (i = 0; i < N; i++) + zd[i] = (a*xd[i])+yd[i]; + + return; } static void VLin2_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z) { - long int i, N; + sunindextype i, N; realtype *xd, *yd, *zd; + xd = yd = zd = NULL; + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); - for (i=0; i < N; i++) - *zd++ = a * (*xd++) - (*yd++); + for (i = 0; i < N; i++) + zd[i] = (a*xd[i])-yd[i]; + + return; } static void Vaxpy_Parallel(realtype a, N_Vector x, N_Vector y) { - long int i, N; + sunindextype i, N; realtype *xd, *yd; + xd = yd = NULL; + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); if (a == ONE) { - for (i=0; i < N; i++) - *yd++ += (*xd++); + for (i = 0; i < N; i++) + yd[i] += xd[i]; return; } - + if (a == -ONE) { - for (i=0; i < N; i++) - *yd++ -= (*xd++); + for (i = 0; i < N; i++) + yd[i] -= xd[i]; return; - } - - for (i=0; i < N; i++) - *yd++ += a * (*xd++); + } + + for (i = 0; i < N; i++) + yd[i] += a*xd[i]; + + return; } static void VScaleBy_Parallel(realtype a, N_Vector x) { - long int i, N; + sunindextype i, N; realtype *xd; + xd = NULL; + N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); - for (i=0; i < N; i++) - *xd++ *= a; + for (i = 0; i < N; i++) + xd[i] *= a; + + return; } diff --git a/src/sundials/shared/nvector_parallel.h b/src/nrniv/nvector_parallel.h old mode 100755 new mode 100644 similarity index 58% rename from src/sundials/shared/nvector_parallel.h rename to src/nrniv/nvector_parallel.h index 8eaa2a0efe..6bde184fad --- a/src/sundials/shared/nvector_parallel.h +++ b/src/nrniv/nvector_parallel.h @@ -1,15 +1,17 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- +// clang-format off +/* ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. + * LLNS Copyright Start + * Copyright (c) 2014, Lawrence Livermore National Security + * This work was performed under the auspices of the U.S. Department + * of Energy by Lawrence Livermore National Laboratory in part under + * Contract W-7405-Eng-48 and in part under Contract DE-AC52-07NA27344. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. - * For details, see sundials/shared/LICENSE. + * For details, see the LICENSE file. + * LLNS Copyright End * ----------------------------------------------------------------- * This is the main header file for the MPI-enabled implementation * of the NVECTOR module. @@ -28,12 +30,12 @@ * Notes: * * - The definition of the generic N_Vector structure can be - * found in the header file shared/include/nvector.h. + * found in the header file sundials_nvector.h. * * - The definition of the type realtype can be found in the - * header file shared/include/sundialstypes.h, and it may be - * changed (at the configuration stage) according to the user's - * needs. The sundialstypes.h file also contains the definition + * header file sundials_types.h, and it may be changed (at the + * configuration stage) according to the user's needs. + * The sundials_types.h file also contains the definition * for the type booleantype. * * - N_Vector arguments to arithmetic vector operations need not @@ -43,20 +45,29 @@ * * (which stores the result of the operation a*x+b*y in y) * is legal. - * ----------------------------------------------------------------- - */ + * -----------------------------------------------------------------*/ #ifndef _NVECTOR_PARALLEL_H #define _NVECTOR_PARALLEL_H +#include + +#if 0 // avoid mpi.h. So no MPI_Comm. We want to support NRNMPI_DYNAMICLOAD +#include +#else +// locally to this .h file, MPI_Comm is an int +// Maybe later we will just remove all of them. +#undef MPI_Comm #define MPI_Comm int +#endif -#if defined(__cplusplus) +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif -#include "nvector.h" -#include "sundialstypes.h" /* * ----------------------------------------------------------------- @@ -64,32 +75,14 @@ extern "C" { * ----------------------------------------------------------------- */ -/* define MPI data types */ - -#if defined(SUNDIALS_SINGLE_PRECISION) - -#define PVEC_REAL_MPI_TYPE MPI_FLOAT - -#elif defined(SUNDIALS_DOUBLE_PRECISION) - -#define PVEC_REAL_MPI_TYPE MPI_DOUBLE - -#elif defined(SUNDIALS_EXTENDED_PRECISION) - -#define PVEC_REAL_MPI_TYPE MPI_LONG_DOUBLE - -#endif - -#define PVEC_INTEGER_MPI_TYPE MPI_LONG - /* parallel implementation of the N_Vector 'content' structure contains the global and local lengths of the vector, a pointer - to an array of realtype components, the MPI communicator, + to an array of 'realtype components', the MPI communicator, and a flag indicating ownership of the data */ struct _N_VectorContent_Parallel { - long int local_length; /* local vector length */ - long int global_length; /* global vector length */ + sunindextype local_length; /* local vector length */ + sunindextype global_length; /* global vector length */ booleantype own_data; /* ownership of data */ realtype *data; /* local data array */ MPI_Comm comm; /* pointer to MPI communicator */ @@ -106,7 +99,7 @@ typedef struct _N_VectorContent_Parallel *N_VectorContent_Parallel; * are assumed: * * N_Vector v; - * long int v_len, s_len, i; + * sunindextype v_len, s_len, i; * * (1) NV_CONTENT_P * @@ -182,14 +175,17 @@ typedef struct _N_VectorContent_Parallel *N_VectorContent_Parallel; * CONSTRUCTORS: * N_VNew_Parallel * N_VNewEmpty_Parallel - * N_VClone_Parallel - * N_VCloneEmpty_Parallel * N_VMake_Parallel - * N_VNewVectorArray_Parallel - * N_VNewVectorArrayEmpty_Parallel + * N_VCloneVectorArray_Parallel + * N_VCloneVectorArrayEmpty_Parallel * DESTRUCTORS: * N_VDestroy_Parallel * N_VDestroyVectorArray_Parallel + * OTHER: + * N_VGetLength_Parallel + * N_VGetLocalLength_Parallel + * N_VPrint_Parallel + * N_VPrintFile_Parallel * ----------------------------------------------------------------- */ @@ -201,9 +197,9 @@ typedef struct _N_VectorContent_Parallel *N_VectorContent_Parallel; * ----------------------------------------------------------------- */ -N_Vector N_VNew_Parallel(MPI_Comm comm, - long int local_length, - long int global_length); +SUNDIALS_EXPORT N_Vector N_VNew_Parallel(MPI_Comm comm, + sunindextype local_length, + sunindextype global_length); /* * ----------------------------------------------------------------- @@ -214,85 +210,100 @@ N_Vector N_VNew_Parallel(MPI_Comm comm, * ----------------------------------------------------------------- */ -N_Vector N_VNewEmpty_Parallel(MPI_Comm comm, - long int local_length, - long int global_length); +SUNDIALS_EXPORT N_Vector N_VNewEmpty_Parallel(MPI_Comm comm, + sunindextype local_length, + sunindextype global_length); /* * ----------------------------------------------------------------- - * Function : N_VCloneEmpty_Parallel + * Function : N_VMake_Parallel * ----------------------------------------------------------------- - * This function creates a new parallel N_Vector with an empty (NULL) - * data array using the vector w as a template - * (sets own_data = FALSE). + * This function creates and allocates memory for a parallel vector + * with a user-supplied data array. * ----------------------------------------------------------------- */ -N_Vector N_VCloneEmpty_Parallel(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VMake_Parallel(MPI_Comm comm, + sunindextype local_length, + sunindextype global_length, + realtype *v_data); /* * ----------------------------------------------------------------- - * Function : N_VMake_Parallel + * Function : N_VCloneVectorArray_Parallel * ----------------------------------------------------------------- - * This function creates and allocates memory for a parallel vector - * with a user-supplied data array. + * This function creates an array of 'count' PARALLEL vectors by + * cloning a given vector w. * ----------------------------------------------------------------- */ -N_Vector N_VMake_Parallel(MPI_Comm comm, - long int local_length, - long int global_length, - realtype *v_data); +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray_Parallel(int count, N_Vector w); /* * ----------------------------------------------------------------- - * Function : N_VNewVectorArray_Parallel + * Function : N_VCloneVectorArrayEmpty_Parallel * ----------------------------------------------------------------- - * This function creates an array of 'count' parallel vectors. This - * array of N_Vectors can be freed using N_VDestroyVectorArray - * (defined by the generic NVECTOR module). + * This function creates an array of 'count' PARALLEL vectors each + * with an empty (NULL) data array by cloning w. * ----------------------------------------------------------------- */ -N_Vector *N_VNewVectorArray_Parallel(int count, - MPI_Comm comm, - long int local_length, - long int global_length); +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArrayEmpty_Parallel(int count, N_Vector w); /* * ----------------------------------------------------------------- - * Function : N_VNewVectorArrayEmpty_Parallel + * Function : N_VDestroyVectorArray_Parallel * ----------------------------------------------------------------- - * This function creates an array of 'count' parallel vectors each - * with an empty (NULL) data array. + * This function frees an array of N_Vector created with + * N_VCloneVectorArray_Parallel or N_VCloneVectorArrayEmpty_Parallel. * ----------------------------------------------------------------- */ -N_Vector *N_VNewVectorArrayEmpty_Parallel(int count, - MPI_Comm comm, - long int local_length, - long int global_length); +SUNDIALS_EXPORT void N_VDestroyVectorArray_Parallel(N_Vector *vs, int count); /* * ----------------------------------------------------------------- - * Function : N_VDestroyVectorArray_Parallel + * Function : N_VGetLength_Parallel * ----------------------------------------------------------------- - * This function frees an array of N_Vector created with - * N_VNewVectorArray_Parallel. + * This function returns number of vector elements (global vector + * length). It returns locally stored integer, and is therefore + * a local call. * ----------------------------------------------------------------- */ -void N_VDestroyVectorArray_Parallel(N_Vector *vs, int count); +SUNDIALS_EXPORT sunindextype N_VGetLength_Parallel(N_Vector v); + +/* + * ----------------------------------------------------------------- + * Function : N_VGetLocalLength_Parallel + * ----------------------------------------------------------------- + * This function returns local vector length. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT sunindextype N_VGetLocalLength_Parallel(N_Vector v); /* * ----------------------------------------------------------------- * Function : N_VPrint_Parallel * ----------------------------------------------------------------- - * This function prints the content of a parallel vector to stdout. + * This function prints the local content of a parallel vector to + * stdout. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void N_VPrint_Parallel(N_Vector v); + +/* + * ----------------------------------------------------------------- + * Function : N_VPrintFile_Parallel + * ----------------------------------------------------------------- + * This function prints the local content of a parallel vector to + * outfile. * ----------------------------------------------------------------- */ -void N_VPrint_Parallel(N_Vector v); +SUNDIALS_EXPORT void N_VPrintFile_Parallel(N_Vector v, FILE *outfile); /* * ----------------------------------------------------------------- @@ -300,33 +311,39 @@ void N_VPrint_Parallel(N_Vector v); * ----------------------------------------------------------------- */ -N_Vector N_VClone_Parallel(N_Vector w); -void N_VDestroy_Parallel(N_Vector v); -void N_VSpace_Parallel(N_Vector v, long int *lrw, long int *liw); -realtype *N_VGetArrayPointer_Parallel(N_Vector v); -void N_VSetArrayPointer_Parallel(realtype *v_data, N_Vector v); -void N_VLinearSum_Parallel(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); -void N_VConst_Parallel(realtype c, N_Vector z); -void N_VProd_Parallel(N_Vector x, N_Vector y, N_Vector z); -void N_VDiv_Parallel(N_Vector x, N_Vector y, N_Vector z); -void N_VScale_Parallel(realtype c, N_Vector x, N_Vector z); -void N_VAbs_Parallel(N_Vector x, N_Vector z); -void N_VInv_Parallel(N_Vector x, N_Vector z); -void N_VAddConst_Parallel(N_Vector x, realtype b, N_Vector z); -realtype N_VDotProd_Parallel(N_Vector x, N_Vector y); -realtype N_VMaxNorm_Parallel(N_Vector x); -realtype N_VWrmsNorm_Parallel(N_Vector x, N_Vector w); -realtype N_VWrmsNormMask_Parallel(N_Vector x, N_Vector w, N_Vector id); -realtype N_VMin_Parallel(N_Vector x); -realtype N_VWL2Norm_Parallel(N_Vector x, N_Vector w); -realtype N_VL1Norm_Parallel(N_Vector x); -void N_VCompare_Parallel(realtype c, N_Vector x, N_Vector z); -booleantype N_VInvTest_Parallel(N_Vector x, N_Vector z); -booleantype N_VConstrMask_Parallel(N_Vector c, N_Vector x, N_Vector m); -realtype N_VMinQuotient_Parallel(N_Vector num, N_Vector denom); - -#if defined(__cplusplus) -} // extern "C" +SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_Parallel(N_Vector v); +SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Parallel(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VClone_Parallel(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy_Parallel(N_Vector v); +SUNDIALS_EXPORT void N_VSpace_Parallel(N_Vector v, sunindextype *lrw, sunindextype *liw); +SUNDIALS_EXPORT realtype *N_VGetArrayPointer_Parallel(N_Vector v); +SUNDIALS_EXPORT void N_VSetArrayPointer_Parallel(realtype *v_data, N_Vector v); +SUNDIALS_EXPORT void N_VLinearSum_Parallel(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VConst_Parallel(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd_Parallel(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv_Parallel(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale_Parallel(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs_Parallel(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv_Parallel(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst_Parallel(N_Vector x, realtype b, N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd_Parallel(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm_Parallel(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm_Parallel(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask_Parallel(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT realtype N_VMin_Parallel(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm_Parallel(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm_Parallel(N_Vector x); +SUNDIALS_EXPORT void N_VCompare_Parallel(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest_Parallel(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask_Parallel(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient_Parallel(N_Vector num, N_Vector denom); + +#ifdef __cplusplus +} #endif +// we would like an error raised if anyone includes this file and +// substantively uses MPI_Comm +#undef MPI_Comm + #endif diff --git a/src/nrnmpi/mpispike.cpp b/src/nrnmpi/mpispike.cpp index 355fb863b2..86d63a8935 100644 --- a/src/nrnmpi/mpispike.cpp +++ b/src/nrnmpi/mpispike.cpp @@ -677,6 +677,29 @@ void nrnmpi_long_allreduce_vec(long* src, long* dest, int cnt, int type) { return; } +#if 0 // unused +void nrnmpi_longlong_allreduce_vec(long long* src, long long* dest, int cnt, int type) { + int i; + MPI_Op t; + assert(src != dest); + if (nrnmpi_numprocs < 2) { + for (i = 0; i < cnt; ++i) { + dest[i] = src[i]; + } + return; + } + if (type == 1) { + t = MPI_SUM; + } else if (type == 2) { + t = MPI_MAX; + } else { + t = MPI_MIN; + } + MPI_Allreduce(src, dest, cnt, MPI_LONG_LONG, t, nrnmpi_comm); + return; +} +#endif // unused + void nrnmpi_dbl_allgather(double* s, double* r, int n) { MPI_Allgather(s, n, MPI_DOUBLE, r, n, MPI_DOUBLE, nrnmpi_comm); } diff --git a/src/nrnmpi/nrnmpi_dynam.cpp b/src/nrnmpi/nrnmpi_dynam.cpp index 0f8eb4d8f0..bff8832559 100644 --- a/src/nrnmpi/nrnmpi_dynam.cpp +++ b/src/nrnmpi/nrnmpi_dynam.cpp @@ -38,6 +38,7 @@ extern const char* path_prefix_to_libnrniv(); extern "C" { #include "nrnmpi_dynam_cinc" /* autogenerated file */ } + #include "nrnmpi_dynam_wrappers.inc" /* autogenerated file */ #include "nrnmpi_dynam_stubs.cpp" @@ -92,6 +93,7 @@ static void* load_nrnmpi(const char* name, std::string& mes) { } *p = cxx_char_alloc; } + return handle; } diff --git a/src/nrnmpi/nrnmpidec.h b/src/nrnmpi/nrnmpidec.h index eaa7fbd4db..fc5499be76 100644 --- a/src/nrnmpi/nrnmpidec.h +++ b/src/nrnmpi/nrnmpidec.h @@ -8,6 +8,8 @@ to the type, e.g. `T*` is valid, but `T *` isn't. #include #include using longdbl = long double; +// unused +// using nrnlonglong = long long; /* see Sundials sunindextype */ #if NRNMPI #include #include @@ -32,7 +34,7 @@ struct MemoryUsage; // olupton 2022-07-06: dynamic MPI needs to dlopen some of these (slightly // redefined) symbol names, so keep C linkage for simplicity extern "C" { -// clang-format off +/* clang-format off */ extern bbsmpibuf* nrnmpi_newbuf(int size); extern void nrnmpi_copy(bbsmpibuf* dest, bbsmpibuf* src); extern void nrnmpi_ref(bbsmpibuf* buf); @@ -120,14 +122,13 @@ extern double nrnmpi_dbl_allreduce(double x, int type); extern void nrnmpi_dbl_allreduce_vec(double* src, double* dest, int cnt, int type); extern void nrnmpi_longdbl_allreduce_vec(longdbl* src, longdbl* dest, int cnt, int type); extern void nrnmpi_long_allreduce_vec(long* src, long* dest, int cnt, int type); +// Extern void nrnmpi_longlong_allreduce_vec(nrnlonglong* src, nrnlonglong* dest, int cnt, int type); extern void nrnmpi_dbl_allgather(double* s, double* r, int n); -#if NRNMPI extern void nrnmpi_multisend_comm(); extern void nrnmpi_multisend_multisend(NRNMPI_Spike* spk, int n, int* hosts); extern int nrnmpi_multisend_single_advance(NRNMPI_Spike* spk); extern int nrnmpi_multisend_conserve(int nsend, int nrecv); -#endif -// clang-format on +/* clang-format on */ } #endif diff --git a/src/oc/nrnmpi.h b/src/oc/nrnmpi.h index 196e6cf2b5..9b5139f319 100644 --- a/src/oc/nrnmpi.h +++ b/src/oc/nrnmpi.h @@ -6,12 +6,14 @@ not easily coexist. ParallelContext.subworlds(nsmall) divides the world into nrnmpi_numprocs_world/small subworlds of size nsmall. */ +extern "C" { extern int nrnmpi_numprocs_world; /* size of entire world. total size of all subworlds */ extern int nrnmpi_myid_world; /* rank in entire world */ extern int nrnmpi_numprocs; /* size of subworld */ extern int nrnmpi_myid; /* rank in subworld */ extern int nrnmpi_numprocs_bbs; /* number of subworlds */ extern int nrnmpi_myid_bbs; /* rank in nrn_bbs_comm of rank 0 of a subworld */ +} struct NRNMPI_Spike { int gid; diff --git a/src/sundials/.clang-format b/src/sundials/.clang-format deleted file mode 100644 index 9d159247d5..0000000000 --- a/src/sundials/.clang-format +++ /dev/null @@ -1,2 +0,0 @@ -DisableFormat: true -SortIncludes: false diff --git a/src/sundials/LICENSE b/src/sundials/LICENSE deleted file mode 100644 index ecfe265100..0000000000 --- a/src/sundials/LICENSE +++ /dev/null @@ -1,63 +0,0 @@ -Copyright (c) 2002, The Regents of the University of California. -Produced at the Lawrence Livermore National Laboratory. -Written by S.D. Cohen, A.C. Hindmarsh, R. Serban, - D. Shumaker, and A.G. Taylor. -UCRL-CODE-155951 (CVODE) -UCRL-CODE-155950 (CVODES) -UCRL-CODE-155952 (IDA) -UCRL-CODE-155953 (KINSOL) -All rights reserved. - -This file is part of SUNDIALS. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: - -1. Redistributions of source code must retain the above copyright -notice, this list of conditions and the disclaimer below. - -2. Redistributions in binary form must reproduce the above copyright -notice, this list of conditions and the disclaimer (as noted below) -in the documentation and/or other materials provided with the -distribution. - -3. Neither the name of the UC/LLNL nor the names of its contributors -may be used to endorse or promote products derived from this software -without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS -FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -REGENTS OF THE UNIVERSITY OF CALIFORNIA, THE U.S. DEPARTMENT OF ENERGY -OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -Additional BSD Notice ---------------------- -1. This notice is required to be provided under our contract with -the U.S. Department of Energy (DOE). This work was produced at the -University of California, Lawrence Livermore National Laboratory -under Contract No. W-7405-ENG-48 with the DOE. - -2. Neither the United States Government nor the University of -California nor any of their employees, makes any warranty, express -or implied, or assumes any liability or responsibility for the -accuracy, completeness, or usefulness of any information, apparatus, -product, or process disclosed, or represents that its use would not -infringe privately-owned rights. - -3. Also, reference herein to any specific commercial products, -process, or services by trade name, trademark, manufacturer or -otherwise does not necessarily constitute or imply its endorsement, -recommendation, or favoring by the United States Government or the -University of California. The views and opinions of authors expressed -herein do not necessarily state or reflect those of the United States -Government or the University of California, and shall not be used for -advertising or product endorsement purposes. diff --git a/src/sundials/README b/src/sundials/README deleted file mode 100755 index 2d0de094b4..0000000000 --- a/src/sundials/README +++ /dev/null @@ -1,76 +0,0 @@ -Below is the original Readme from the sundials/README file. -The orginal sundials package was obtained from -http://www.llnl.gov/CASC/sundials/ -For purposes of incorporating cvodes and ida into NEURON I have -simplified the directory structure by combining source and include -files into the cvodes, and ida directories and combined -nvec_ser, nvec_par, shared/include, and shared/src *.[ch] files -into the shared subdirectory, eliminated -the doc, kinsol, cvode directories and other subdirectories, and -replaced the -Makefile.in files with Makefile.am files. -The reason that the sensitivity version of cvode is used is that the -previous version of cvode did not -support the tstop functionality needed by at_time. - -Note that the version 2.0 now has tstop functionality for cvode but -due to inertia we still use cvodes. Also version 2.0 incorporates -autoconf (although configure.in is not distributed in the sundials.tar.gz -file) so we make use of config.hin. It is conceivable that the -sundials.tar.gz with all its subdirectory structure along with configure -could be used now. But for least porting, cvs, Makefile.am -and distribution difficulty we retain the previous subdirectory structure. ------------------------------------------------------------------------------ - - SUNDIALS - SUite of Nonlinear and DIfferential/ALgebraic equation Solvers - Release 2.0.1, January 2005 - Peter Brown, Aaron Collier, Keith Grant, Alan Hindmarsh, - Steve Lee, Radu Serban, Dan Shumaker, Carol Woodward - Center for Applied Scientific Computing, LLNL - - -The family of solvers referred to as SUNDIALS consists of solvers CVODE -(for ODE systems), CVODES (ODE with sensitivity analysis capabilities), -IDA (for differential-algebraic systems), and KINSOL (for nonlinear -algebraic systems), - -The various solvers of this family share many subordinate modules. -For this reason, it is organized as a family, with a directory structure -that exploits that sharing. Each individual solver includes documentation -on installation, along with full usage documentation. - -The following is a list of the solver packages presently available. - -CVODE: A solver for stiff and nonstiff ODE systems y' = f(t,y), - with serial and parallel versions. - -CVODES: A solver for stiff and non-stiff ODE systems with sensitivity - analysis capabilities, with serial and parallel versions. - -IDA: A solver for differential-algebraic systems F(t,y,y') = 0, with - serial and parallel versions. - -KINSOL: A solver for nonlinear algebraic systems F(u) = 0, with serial - and parallel versions. - -Warning to users who receive more than one of these individual solvers -at different times: The mixing of old and new versions SUNDIALS may fail. -To avoid such failures, obtain all desired solvers at the same time. - -For installation directions see the file INSTALL_NOTES. - -For additional information on a particular solver, see the README file in -the solver directory. - - Release history - -+----------+------------------------------------------------------+ -| | SUNDIALS | Solver version | -| Date | +----------+----------+----------+----------+ -| | release | CVODE | CVODES | IDA | KINSOL | -+----------+----------+----------+----------+----------+----------+ -| Jul 2002 | 1.0 | 2.0 | 1.0 | 2.0 | 2.0 | -| Dec 2004 | 2.0 | 2.2.0 | 2.1.0 | 2.2.0 | 2.2.0 | -| Jan 2005 | 2.0.1 | 2.2.1 | 2.1.1 | 2.2.1 | 2.2.1 | -+----------+----------+----------+----------+----------+----------+ diff --git a/src/sundials/cvodes/cvband.c b/src/sundials/cvodes/cvband.c deleted file mode 100755 index 434e419b90..0000000000 --- a/src/sundials/cvodes/cvband.c +++ /dev/null @@ -1,594 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for the CVBAND linear solver. - * ----------------------------------------------------------------- - */ - -#include -#include - -#include "cvband_impl.h" -#include "cvodes_impl.h" -#include "sundialsmath.h" - -/* Other Constants */ - -#define MIN_INC_MULT RCONST(1000.0) -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) -#define TWO RCONST(2.0) - -/* CVBAND linit, lsetup, lsolve, and lfree routines */ - -static int CVBandInit(CVodeMem cv_mem); - -static int CVBandSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, - N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, - N_Vector vtemp2, N_Vector vtemp3); - -static int CVBandSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, - N_Vector ycur, N_Vector fcur); - -static void CVBandFree(CVodeMem cv_mem); - -/* CVBAND DQJac routine */ - -static void CVBandDQJac(long int n, long int mupper, long int mlower, - BandMat J, realtype t, - N_Vector y, N_Vector fy, void *jac_data, - N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); - -/* Readability Replacements */ - -#define lmm (cv_mem->cv_lmm) -#define f (cv_mem->cv_f) -#define f_data (cv_mem->cv_f_data) -#define uround (cv_mem->cv_uround) -#define nst (cv_mem->cv_nst) -#define tn (cv_mem->cv_tn) -#define h (cv_mem->cv_h) -#define gamma (cv_mem->cv_gamma) -#define gammap (cv_mem->cv_gammap) -#define gamrat (cv_mem->cv_gamrat) -#define ewt (cv_mem->cv_ewt) -#define nfe (cv_mem->cv_nfe) -#define errfp (cv_mem->cv_errfp) -#define linit (cv_mem->cv_linit) -#define lsetup (cv_mem->cv_lsetup) -#define lsolve (cv_mem->cv_lsolve) -#define lfree (cv_mem->cv_lfree) -#define lmem (cv_mem->cv_lmem) -#define vec_tmpl (cv_mem->cv_tempv) -#define setupNonNull (cv_mem->cv_setupNonNull) - -#define n (cvband_mem->b_n) -#define jac (cvband_mem->b_jac) -#define M (cvband_mem->b_M) -#define mu (cvband_mem->b_mu) -#define ml (cvband_mem->b_ml) -#define storage_mu (cvband_mem->b_storage_mu) -#define pivots (cvband_mem->b_pivots) -#define savedJ (cvband_mem->b_savedJ) -#define nstlj (cvband_mem->b_nstlj) -#define nje (cvband_mem->b_nje) -#define nfeB (cvband_mem->b_nfeB) -#define J_data (cvband_mem->b_J_data) -#define last_flag (cvband_mem->b_last_flag) - -/* - * ----------------------------------------------------------------- - * CVBand - * ----------------------------------------------------------------- - * This routine initializes the memory record and sets various function - * fields specific to the band linear solver module. CVBand first calls - * the existing lfree routine if this is not NULL. It then sets the - * cv_linit, cv_lsetup, cv_lsolve, and cv_lfree fields in (*cvode_mem) - * to be CVBandInit, CVBandSetup, CVBandSolve, and CVBandFree, - * respectively. It allocates memory for a structure of type - * CVBandMemRec and sets the cv_lmem field in (*cvode_mem) to the - * address of this structure. It sets setupNonNull in (*cvode_mem) to be - * TRUE, b_mu to be mupper, b_ml to be mlower, and the b_jac field to be - * CVBandDQJac. - * Finally, it allocates memory for M, savedJ, and pivot. The CVBand - * return value is SUCCESS = 0, LMEM_FAIL = -1, or LIN_ILL_INPUT = -2. - * - * NOTE: The band linear solver assumes a serial implementation - * of the NVECTOR package. Therefore, CVBand will first - * test for compatible a compatible N_Vector internal - * representation by checking that the function - * N_VGetArrayPointer exists. - * ----------------------------------------------------------------- - */ - -int CVBand(void *cvode_mem, long int N, - long int mupper, long int mlower) -{ - CVodeMem cv_mem; - CVBandMem cvband_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGB_CVMEM_NULL); - return(CVBAND_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - /* Test if the NVECTOR package is compatible with the BAND solver */ - if (vec_tmpl->ops->nvgetarraypointer == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_BAD_NVECTOR); - return(CVBAND_ILL_INPUT); - } - - if (lfree != NULL) lfree(cv_mem); - - /* Set four main function fields in cv_mem */ - linit = CVBandInit; - lsetup = CVBandSetup; - lsolve = CVBandSolve; - lfree = CVBandFree; - - /* Get memory for CVBandMemRec */ - cvband_mem = (CVBandMem) malloc(sizeof(CVBandMemRec)); - if (cvband_mem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_MEM_FAIL); - return(CVBAND_MEM_FAIL); - } - - /* Set default Jacobian routine and Jacobian data */ - jac = CVBandDQJac; - J_data = cvode_mem; - last_flag = CVBAND_SUCCESS; - - setupNonNull = TRUE; - - /* Load problem dimension */ - n = N; - - /* Load half-bandwiths in cvband_mem */ - ml = mlower; - mu = mupper; - - /* Test ml and mu for legality */ - if ((ml < 0) || (mu < 0) || (ml >= N) || (mu >= N)) { - if(errfp!=NULL) fprintf(errfp, MSGB_BAD_SIZES); - return(CVBAND_ILL_INPUT); - } - - /* Set extended upper half-bandwith for M (required for pivoting) */ - storage_mu = MIN(N-1, mu + ml); - - /* Allocate memory for M, savedJ, and pivot arrays */ - M = BandAllocMat(N, mu, ml, storage_mu); - if (M == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_MEM_FAIL); - return(CVBAND_MEM_FAIL); - } - savedJ = BandAllocMat(N, mu, ml, mu); - if (savedJ == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_MEM_FAIL); - BandFreeMat(M); - return(CVBAND_MEM_FAIL); - } - pivots = BandAllocPiv(N); - if (pivots == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_MEM_FAIL); - BandFreeMat(M); - BandFreeMat(savedJ); - return(CVBAND_MEM_FAIL); - } - - /* Attach linear solver memory to integrator memory */ - lmem = cvband_mem; - - return(CVBAND_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVBandSetJacFn - * ----------------------------------------------------------------- - */ - -int CVBandSetJacFn(void *cvode_mem, CVBandJacFn bjac) -{ - CVodeMem cv_mem; - CVBandMem cvband_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGB_SETGET_CVMEM_NULL); - return(CVBAND_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_SETGET_LMEM_NULL); - return(CVBAND_LMEM_NULL); - } - cvband_mem = (CVBandMem) lmem; - - jac = bjac; - - return(CVBAND_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVBandSetJacData - * ----------------------------------------------------------------- - */ - -int CVBandSetJacData(void *cvode_mem, void *jac_data) -{ - CVodeMem cv_mem; - CVBandMem cvband_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGB_SETGET_CVMEM_NULL); - return(CVBAND_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_SETGET_LMEM_NULL); - return(CVBAND_LMEM_NULL); - } - cvband_mem = (CVBandMem) lmem; - - J_data = jac_data; - - return(CVBAND_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVBandGetWorkSpace - * ----------------------------------------------------------------- - */ - -int CVBandGetWorkSpace(void *cvode_mem, long int *lenrwB, long int *leniwB) -{ - CVodeMem cv_mem; - CVBandMem cvband_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGB_SETGET_CVMEM_NULL); - return(CVBAND_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_SETGET_LMEM_NULL); - return(CVBAND_LMEM_NULL); - } - cvband_mem = (CVBandMem) lmem; - - *lenrwB = n*(storage_mu + mu + 2*ml + 2); - *leniwB = n; - - return(CVBAND_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVBandGetNumJacEvals - * ----------------------------------------------------------------- - */ - -int CVBandGetNumJacEvals(void *cvode_mem, long int *njevalsB) -{ - CVodeMem cv_mem; - CVBandMem cvband_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGB_SETGET_CVMEM_NULL); - return(CVBAND_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_SETGET_LMEM_NULL); - return(CVBAND_LMEM_NULL); - } - cvband_mem = (CVBandMem) lmem; - - *njevalsB = nje; - - return(CVBAND_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVBandGetNumRhsEvals - * ----------------------------------------------------------------- - */ - -int CVBandGetNumRhsEvals(void *cvode_mem, long int *nfevalsB) -{ - CVodeMem cv_mem; - CVBandMem cvband_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGB_SETGET_CVMEM_NULL); - return(CVBAND_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_SETGET_LMEM_NULL); - return(CVBAND_LMEM_NULL); - } - cvband_mem = (CVBandMem) lmem; - - *nfevalsB = nfeB; - - return(CVBAND_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVBandGetLastFlag - * ----------------------------------------------------------------- - */ - -int CVBandGetLastFlag(void *cvode_mem, int *flag) -{ - CVodeMem cv_mem; - CVBandMem cvband_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGB_SETGET_CVMEM_NULL); - return(CVBAND_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_SETGET_LMEM_NULL); - return(CVBAND_LMEM_NULL); - } - cvband_mem = (CVBandMem) lmem; - - *flag = last_flag; - - return(CVBAND_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVBandInit - * ----------------------------------------------------------------- - * This routine does remaining initializations specific to the band - * linear solver. - * ----------------------------------------------------------------- - */ - -static int CVBandInit(CVodeMem cv_mem) -{ - CVBandMem cvband_mem; - - cvband_mem = (CVBandMem) lmem; - - nje = 0; - nfeB = 0; - nstlj = 0; - - if (jac == NULL) { - jac = CVBandDQJac; - J_data = cv_mem; - } - - last_flag = CVBAND_SUCCESS; - return(0); -} - -/* - * ----------------------------------------------------------------- - * CVBandSetup - * ----------------------------------------------------------------- - * This routine does the setup operations for the band linear solver. - * It makes a decision whether or not to call the Jacobian evaluation - * routine based on various state variables, and if not it uses the - * saved copy. In any case, it constructs the Newton matrix - * M = I - gamma*J, updates counters, and calls the band LU - * factorization routine. - * ----------------------------------------------------------------- - */ - -static int CVBandSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, - N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, - N_Vector vtemp2, N_Vector vtemp3) -{ - booleantype jbad, jok; - realtype dgamma; - long int ier; - CVBandMem cvband_mem; - - cvband_mem = (CVBandMem) lmem; - - /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ - - dgamma = ABS((gamma/gammap) - ONE); - jbad = (nst == 0) || (nst > nstlj + CVB_MSBJ) || - ((convfail == CV_FAIL_BAD_J) && (dgamma < CVB_DGMAX)) || - (convfail == CV_FAIL_OTHER); - jok = !jbad; - - if (jok) { - /* If jok = TRUE, use saved copy of J */ - *jcurPtr = FALSE; - BandCopy(savedJ, M, mu, ml); - } else { - /* If jok = FALSE, call jac routine for new J value */ - nje++; - nstlj = nst; - *jcurPtr = TRUE; - BandZero(M); - jac(n, mu, ml, M, tn, ypred, fpred, J_data, vtemp1, vtemp2, vtemp3); - BandCopy(M, savedJ, mu, ml); - } - - /* Scale and add I to get M = I - gamma*J */ - BandScale(-gamma, M); - BandAddI(M); - - /* Do LU factorization of M */ - ier = BandFactor(M, pivots); - - /* Return 0 if the LU was complete; otherwise return 1 */ - if (ier > 0) { - last_flag = ier; - return(1); - } - last_flag = CVBAND_SUCCESS; - return(0); -} - -/* - * ----------------------------------------------------------------- - * CVBandSolve - * ----------------------------------------------------------------- - * This routine handles the solve operation for the band linear solver - * by calling the band backsolve routine. The return value is 0. - * ----------------------------------------------------------------- - */ - -static int CVBandSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, - N_Vector ycur, N_Vector fcur) -{ - CVBandMem cvband_mem; - realtype *bd; - - cvband_mem = (CVBandMem) lmem; - - bd = N_VGetArrayPointer(b); - - BandBacksolve(M, pivots, bd); - - /* If CV_BDF, scale the correction to account for change in gamma */ - if ((lmm == CV_BDF) && (gamrat != ONE)) { - N_VScale(TWO/(ONE + gamrat), b, b); - } - - last_flag = CVBAND_SUCCESS; - return(0); -} - -/* - * ----------------------------------------------------------------- - * CVBandFree - * ----------------------------------------------------------------- - * This routine frees memory specific to the band linear solver. - * ----------------------------------------------------------------- - */ - -static void CVBandFree(CVodeMem cv_mem) -{ - CVBandMem cvband_mem; - - cvband_mem = (CVBandMem) lmem; - - BandFreeMat(M); - BandFreeMat(savedJ); - BandFreePiv(pivots); - free(cvband_mem); -} - -/* - * ----------------------------------------------------------------- - * CVBandDQJac - * ----------------------------------------------------------------- - * This routine generates a banded difference quotient approximation to - * the Jacobian of f(t,y). It assumes that a band matrix of type - * BandMat is stored column-wise, and that elements within each column - * are contiguous. This makes it possible to get the address of a column - * of J via the macro BAND_COL and to write a simple for loop to set - * each of the elements of a column in succession. - * ----------------------------------------------------------------- - */ - -static void CVBandDQJac(long int N, long int mupper, long int mlower, - BandMat J, realtype t, - N_Vector y, N_Vector fy, void *jac_data, - N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) -{ - realtype fnorm, minInc, inc, inc_inv, srur; - N_Vector ftemp, ytemp; - long int group, i, j, width, ngroups, i1, i2; - realtype *col_j, *ewt_data, *fy_data, *ftemp_data, *y_data, *ytemp_data; - - CVodeMem cv_mem; - CVBandMem cvband_mem; - - /* jac_dat points to cvode_mem */ - cv_mem = (CVodeMem) jac_data; - cvband_mem = (CVBandMem) lmem; - - /* Rename work vectors for use as temporary values of y and f */ - ftemp = tmp1; - ytemp = tmp2; - - /* Obtain pointers to the data for ewt, fy, ftemp, y, ytemp */ - ewt_data = N_VGetArrayPointer(ewt); - fy_data = N_VGetArrayPointer(fy); - ftemp_data = N_VGetArrayPointer(ftemp); - y_data = N_VGetArrayPointer(y); - ytemp_data = N_VGetArrayPointer(ytemp); - - /* Load ytemp with y = predicted y vector */ - N_VScale(ONE, y, ytemp); - - /* Set minimum increment based on uround and norm of f */ - srur = RSqrt(uround); - fnorm = N_VWrmsNorm(fy, ewt); - minInc = (fnorm != ZERO) ? - (MIN_INC_MULT * ABS(h) * uround * N * fnorm) : ONE; - - /* Set bandwidth and number of column groups for band differencing */ - width = mlower + mupper + 1; - ngroups = MIN(width, N); - - for (group=1; group <= ngroups; group++) { - - /* Increment all y_j in group */ - for(j=group-1; j < N; j+=width) { - inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); - ytemp_data[j] += inc; - } - - /* Evaluate f with incremented y */ - - f(tn, ytemp, ftemp, f_data); - - /* Restore ytemp, then form and load difference quotients */ - for (j=group-1; j < N; j+=width) { - ytemp_data[j] = y_data[j]; - col_j = BAND_COL(J,j); - inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); - inc_inv = ONE/inc; - i1 = MAX(0, j-mupper); - i2 = MIN(j+mlower, N-1); - for (i=i1; i <= i2; i++) - BAND_COL_ELEM(col_j,i,j) = - inc_inv * (ftemp_data[i] - fy_data[i]); - } - } - - /* Increment counter nfeB */ - nfeB += ngroups; -} diff --git a/src/sundials/cvodes/cvband.h b/src/sundials/cvodes/cvband.h deleted file mode 100755 index 9264d095ae..0000000000 --- a/src/sundials/cvodes/cvband.h +++ /dev/null @@ -1,221 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This is the header file for the CVODE/CVODES band linear - * solver, CVBAND. - * ----------------------------------------------------------------- - */ - -#ifndef _CVBAND_H -#define _CVBAND_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include "band.h" -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * CVBAND solver constants - * ----------------------------------------------------------------- - * CVB_MSBJ : maximum number of steps between band Jacobian - * evaluations - * - * CVB_DGMAX : maximum change in gamma between band Jacobian - * evaluations - * ----------------------------------------------------------------- - */ - -#define CVB_MSBJ 50 -#define CVB_DGMAX RCONST(0.2) - -/* - * ----------------------------------------------------------------- - * Type : CVBandJacFn - * ----------------------------------------------------------------- - * A band Jacobian approximation function Jac must have the - * prototype given below. Its parameters are: - * - * N is the length of all vector arguments. - * - * mupper is the upper half-bandwidth of the approximate banded - * Jacobian. This parameter is the same as the mupper parameter - * passed by the user to the CVBand function. - * - * mlower is the lower half-bandwidth of the approximate banded - * Jacobian. This parameter is the same as the mlower parameter - * passed by the user to the CVBand function. - * - * J is the band matrix (of type BandMat) that will be loaded - * by a CVBandJacFn with an approximation to the Jacobian matrix - * J = (df_i/dy_j) at the point (t,y). - * J is preset to zero, so only the nonzero elements need to be - * loaded. Three efficient ways to load J are: - * - * (1) (with macros - no explicit data structure references) - * for (j=0; j < n; j++) { - * col_j = BAND_COL(J,j); - * for (i=j-mupper; i <= j+mlower; i++) { - * generate J_ij = the (i,j)th Jacobian element - * BAND_COL_ELEM(col_j,i,j) = J_ij; - * } - * } - * - * (2) (with BAND_COL macro, but without BAND_COL_ELEM macro) - * for (j=0; j < n; j++) { - * col_j = BAND_COL(J,j); - * for (k=-mupper; k <= mlower; k++) { - * generate J_ij = the (i,j)th Jacobian element, i=j+k - * col_j[k] = J_ij; - * } - * } - * - * (3) (without macros - explicit data structure references) - * offset = J->smu; - * for (j=0; j < n; j++) { - * col_j = ((J->data)[j])+offset; - * for (k=-mupper; k <= mlower; k++) { - * generate J_ij = the (i,j)th Jacobian element, i=j+k - * col_j[k] = J_ij; - * } - * } - * Caution: J->smu is generally NOT the same as mupper. - * - * The BAND_ELEM(A,i,j) macro is appropriate for use in small - * problems in which efficiency of access is NOT a major concern. - * - * t is the current value of the independent variable. - * - * y is the current value of the dependent variable vector, - * namely the predicted value of y(t). - * - * fy is the vector f(t,y). - * - * jac_data is a pointer to user data - the same as the jac_data - * parameter passed to CVBand. - * - * NOTE: If the user's Jacobian routine needs other quantities, - * they are accessible as follows: hcur (the current stepsize) - * and ewt (the error weight vector) are accessible through - * CVodeGetCurrentStep and CVodeGetErrWeights, respectively - * (see cvode.h). The unit roundoff is available as - * UNIT_ROUNDOFF defined in sundialstypes.h - * - * tmp1, tmp2, and tmp3 are pointers to memory allocated for - * vectors of length N which can be used by a CVBandJacFn - * as temporary storage or work space. - * ----------------------------------------------------------------- - */ - -typedef void (*CVBandJacFn)(long int N, long int mupper, long int mlower, - BandMat J, realtype t, - N_Vector y, N_Vector fy, void *jac_data, - N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); - -/* - * ----------------------------------------------------------------- - * Function : CVBand - * ----------------------------------------------------------------- - * A call to the CVBand function links the main CVODE integrator - * with the CVBAND linear solver. - * - * cvode_mem is the pointer to the integrator memory returned by - * CVodeCreate. - * - * N is the size of the ODE system. - * - * mupper is the upper bandwidth of the band Jacobian - * approximation. - * - * mlower is the lower bandwidth of the band Jacobian - * approximation. - * - * The return value of CVBand is one of: - * CVBAND_SUCCESS if successful - * CVBAND_MEM_NULL if the cvode memory was NULL - * CVBAND_MEM_FAIL if there was a memory allocation failure - * CVBAND_ILL_INPUT if a required vector operation is missing or - * if a bandwidth has an illegal value. - * ----------------------------------------------------------------- - */ - -int CVBand(void *cvode_mem, long int N, - long int mupper, long int mlower); - -/* - * ----------------------------------------------------------------- - * Optional inputs to the CVBAND linear solver - * ----------------------------------------------------------------- - * - * CVBandSetJacFn specifies the band Jacobian approximation - * routine to be used. A user-supplied bjac routine - * must be of type CVBandJacFn. By default, a difference - * quotient routine CVBandDQJac, supplied with this - * solver is used. - * CVBandSetJacData specifies a pointer to user data which is - * passed to the bjac routine every time it is - * called. - * - * The return value of CVBandSet* is one of: - * CVBAND_SUCCESS if successful - * CVBAND_MEM_NULL if the cvode memory was NULL - * CVBAND_LMEM_NULL if the cvband memory was NULL - * ----------------------------------------------------------------- - */ - -int CVBandSetJacFn(void *cvode_mem, CVBandJacFn bjac); -int CVBandSetJacData(void *cvode_mem, void *jac_data); - -/* - * ----------------------------------------------------------------- - * Optional outputs from the CVBAND linear solver - * ----------------------------------------------------------------- - * - * CVBandGetWorkSpace returns the real and integer workspace used - * by CVBAND. - * CVBandGetNumJacEvals returns the number of calls made to the - * Jacobian evaluation routine bjac. - * CVBandGetNumRhsEvals returns the number of calls to the user - * f routine due to finite difference Jacobian - * evaluation. - * CVBandGetLastFlag returns the last error flag set by any of - * the CVBAND interface functions. - * - * The return value of CVBandGet* is one of: - * CVBAND_SUCCESS if successful - * CVBAND_MEM_NULL if the cvode memory was NULL - * CVBAND_LMEM_NULL if the cvband memory was NULL - * ----------------------------------------------------------------- - */ - -int CVBandGetWorkSpace(void *cvode_mem, long int *lenrwB, long int *leniwB); -int CVBandGetNumJacEvals(void *cvode_mem, long int *njevalsB); -int CVBandGetNumRhsEvals(void *cvode_mem, long int *nfevalsB); -int CVBandGetLastFlag(void *cvode_mem, int *flag); - -/* CVBAND return values */ - -#define CVBAND_SUCCESS 0 -#define CVBAND_MEM_NULL -1 -#define CVBAND_LMEM_NULL -2 -#define CVBAND_ILL_INPUT -3 -#define CVBAND_MEM_FAIL -4 - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/cvodes/cvband_impl.h b/src/sundials/cvodes/cvband_impl.h deleted file mode 100755 index 2e12789650..0000000000 --- a/src/sundials/cvodes/cvband_impl.h +++ /dev/null @@ -1,90 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * Implementation header file for the band linear solver, CVBAND. - * ----------------------------------------------------------------- - */ - -#ifndef _CVBAND_IMPL_H -#define _CVBAND_IMPL_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include - -#include "band.h" -#include "cvband.h" -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Types: CVBandMemRec, CVBandMem - * ----------------------------------------------------------------- - * The type CVBandMem is pointer to a CVBandMemRec. - * This structure contains CVBand solver-specific data. - * ----------------------------------------------------------------- - */ - -typedef struct { - - long int b_n; /* N = problem dimension */ - - CVBandJacFn b_jac; /* jac = Jacobian routine to be called */ - - long int b_ml; /* b_ml = lower bandwidth of savedJ */ - - long int b_mu; /* b_mu = upper bandwidth of savedJ */ - - long int b_storage_mu; /* upper bandwith of M = MIN(N-1,b_mu+b_ml) */ - - BandMat b_M; /* M = I - gamma J, gamma = h / l1 */ - - long int *b_pivots; /* pivots = pivot array for PM = LU */ - - BandMat b_savedJ; /* savedJ = old Jacobian */ - - long int b_nstlj; /* nstlj = nst at last Jacobian eval. */ - - long int b_nje; /* nje = no. of calls to jac */ - - long int b_nfeB; /* nfeB = no. of calls to f due to difference - quotient band Jacobian approximation */ - - void *b_J_data; /* J_data is passed to jac */ - - int b_last_flag; /* last error return flag */ - -} CVBandMemRec, *CVBandMem; - -/* Error Messages */ - -#define _CVBAND_ "CVBand-- " -#define MSGB_MEM_FAIL _CVBAND_ "A memory request failed.\n\n" -#define MSGB_BAD_SIZES_1 _CVBAND_ "Illegal bandwidth parameter(s)." -#define MSGB_BAD_SIZES_2 "Must have 0 <= ml, mu <= N-1.\n\n" -#define MSGB_BAD_SIZES MSGB_BAD_SIZES_1 MSGB_BAD_SIZES_2 -#define MSGB_BAD_NVECTOR _CVBAND_ "A required vector operation is not implemented.\n\n" -#define MSGB_CVMEM_NULL _CVBAND_ "Integrator memory is NULL.\n\n" - -#define MSGB_SETGET_CVMEM_NULL "CVBandSet*/CVBandGet*-- Integrator memory is NULL.\n\n" - -#define MSGB_SETGET_LMEM_NULL "CVBandSet*/CVBandGet*-- CVBAND memory is NULL.\n\n" - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/cvodes/cvbandpre.c b/src/sundials/cvodes/cvbandpre.c deleted file mode 100755 index 0d8d24c64d..0000000000 --- a/src/sundials/cvodes/cvbandpre.c +++ /dev/null @@ -1,415 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This file contains implementations of the banded difference - * quotient Jacobian-based preconditioner and solver routines for - * use with CVSpgmr. - * ----------------------------------------------------------------- - */ - -#include -#include - -#include "cvbandpre_impl.h" -#include "cvodes_impl.h" -#include "cvspgmr_impl.h" - -#include "sundialsmath.h" - -#define MIN_INC_MULT RCONST(1000.0) -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) - -/* Prototypes of CVBandPrecSetup and CVBandPrecSolve */ - -static int CVBandPrecSetup(realtype t, N_Vector y, N_Vector fy, - booleantype jok, booleantype *jcurPtr, - realtype gamma, void *bp_data, - N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); - -static int CVBandPrecSolve(realtype t, N_Vector y, N_Vector fy, - N_Vector r, N_Vector z, - realtype gamma, realtype delta, - int lr, void *bp_data, N_Vector tmp); - -/* Prototype for difference quotient Jacobian calculation routine */ - -static void CVBandPDQJac(CVBandPrecData pdata, - realtype t, N_Vector y, N_Vector fy, - N_Vector ftemp, N_Vector ytemp); - -/* Redability replacements */ -#define vec_tmpl (cv_mem->cv_tempv) -#define errfp (cv_mem->cv_errfp) - -/* - * ----------------------------------------------------------------- - * Malloc, Free, and Get Functions - * NOTE: The band linear solver assumes a serial implementation - * of the NVECTOR package. Therefore, CVBandPrecAlloc will - * first test for compatible a compatible N_Vector internal - * representation by checking that the function - * N_VGetArrayPointer exists - * ----------------------------------------------------------------- - */ - -void *CVBandPrecAlloc(void *cvode_mem, long int N, - long int mu, long int ml) -{ - CVodeMem cv_mem; - CVBandPrecData pdata; - long int mup, mlp, storagemu; - - if (cvode_mem == NULL) { - fprintf(stderr, MSGBP_CVMEM_NULL); - return(NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - /* Test if the NVECTOR package is compatible with the BAND preconditioner */ - if(vec_tmpl->ops->nvgetarraypointer == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGBP_BAD_NVECTOR); - return(NULL); - } - - pdata = (CVBandPrecData) malloc(sizeof *pdata); /* Allocate data memory */ - if (pdata == NULL) return(NULL); - - /* Load pointers and bandwidths into pdata block. */ - pdata->cvode_mem = cvode_mem; - pdata->N = N; - pdata->mu = mup = MIN( N-1, MAX(0,mu) ); - pdata->ml = mlp = MIN( N-1, MAX(0,ml) ); - - /* Initialize nfeBP counter */ - pdata->nfeBP = 0; - - /* Allocate memory for saved banded Jacobian approximation. */ - pdata->savedJ = BandAllocMat(N, mup, mlp, mup); - if (pdata->savedJ == NULL) { - free(pdata); - return(NULL); - } - - /* Allocate memory for banded preconditioner. */ - storagemu = MIN( N-1, mup + mlp); - pdata->savedP = BandAllocMat(N, mup, mlp, storagemu); - if (pdata->savedP == NULL) { - BandFreeMat(pdata->savedJ); - free(pdata); - return(NULL); - } - - /* Allocate memory for pivot array. */ - pdata->pivots = BandAllocPiv(N); - if (pdata->savedJ == NULL) { - BandFreeMat(pdata->savedP); - BandFreeMat(pdata->savedJ); - free(pdata); - return(NULL); - } - - return((void *) pdata); -} - -int CVBPSpgmr(void *cvode_mem, int pretype, int maxl, void *p_data) -{ - int flag; - - if ( p_data == NULL ) { - fprintf(stderr, MSGBP_NO_PDATA); - return(CV_PDATA_NULL); - } - - flag = CVSpgmr(cvode_mem, pretype, maxl); - if(flag != CVSPGMR_SUCCESS) return(flag); - - flag = CVSpgmrSetPrecData(cvode_mem, p_data); - if(flag != CVSPGMR_SUCCESS) return(flag); - - flag = CVSpgmrSetPrecSetupFn(cvode_mem, CVBandPrecSetup); - if(flag != CVSPGMR_SUCCESS) return(flag); - - flag = CVSpgmrSetPrecSolveFn(cvode_mem, CVBandPrecSolve); - if(flag != CVSPGMR_SUCCESS) return(flag); - - return(CVSPGMR_SUCCESS); -} - -void CVBandPrecFree(void *bp_data) -{ - CVBandPrecData pdata; - - if ( bp_data != NULL ) { - pdata = (CVBandPrecData) bp_data; - BandFreeMat(pdata->savedJ); - BandFreeMat(pdata->savedP); - BandFreePiv(pdata->pivots); - free(pdata); - } -} - -int CVBandPrecGetWorkSpace(void *bp_data, long int *lenrwBP, long int *leniwBP) -{ - CVBandPrecData pdata; - long int N, ml, mu, smu; - - if ( bp_data == NULL ) { - fprintf(stderr, MSGBP_PDATA_NULL); - return(CV_PDATA_NULL); - } - - pdata = (CVBandPrecData) bp_data; - N = pdata->N; - mu = pdata->mu; - ml = pdata->ml; - smu = MIN( N-1, mu + ml); - - *leniwBP = pdata->N; - *lenrwBP = N * ( 2*ml + smu + mu + 2 ); - - return(CV_SUCCESS); -} - -int CVBandPrecGetNumRhsEvals(void *bp_data, long int *nfevalsBP) -{ - CVBandPrecData pdata; - - if ( bp_data == NULL ) { - fprintf(stderr, MSGBP_PDATA_NULL); - return(CV_PDATA_NULL); - } - - pdata = (CVBandPrecData) bp_data; - - *nfevalsBP = pdata->nfeBP; - - return(CV_SUCCESS); -} - -/* Readability Replacements */ - -#define N (pdata->N) -#define mu (pdata->mu) -#define ml (pdata->ml) -#define pivots (pdata->pivots) -#define savedJ (pdata->savedJ) -#define savedP (pdata->savedP) -#define nfeBP (pdata->nfeBP) - -/* - * ----------------------------------------------------------------- - * CVBandPrecSetup - * ----------------------------------------------------------------- - * Together CVBandPrecSetup and CVBandPrecSolve use a banded - * difference quotient Jacobian to create a preconditioner. - * CVBandPrecSetup calculates a new J, if necessary, then - * calculates P = I - gamma*J, and does an LU factorization of P. - * - * The parameters of CVBandPrecSetup are as follows: - * - * t is the current value of the independent variable. - * - * y is the current value of the dependent variable vector, - * namely the predicted value of y(t). - * - * fy is the vector f(t,y). - * - * jok is an input flag indicating whether Jacobian-related - * data needs to be recomputed, as follows: - * jok == FALSE means recompute Jacobian-related data - * from scratch. - * jok == TRUE means that Jacobian data from the - * previous PrecSetup call will be reused - * (with the current value of gamma). - * A CVBandPrecSetup call with jok == TRUE should only - * occur after a call with jok == FALSE. - * - * *jcurPtr is a pointer to an output integer flag which is - * set by CVBandPrecond as follows: - * *jcurPtr = TRUE if Jacobian data was recomputed. - * *jcurPtr = FALSE if Jacobian data was not recomputed, - * but saved data was reused. - * - * gamma is the scalar appearing in the Newton matrix. - * - * bp_data is a pointer to preconditoner data - the same as the - * bp_data parameter passed to CVSpgmr. - * - * tmp1, tmp2, and tmp3 are pointers to memory allocated - * for vectors of length N for work space. This - * routine uses only tmp1 and tmp2. - * - * - * The value to be returned by the CVBandPrecSetup function is - * 0 if successful, or - * 1 if the band factorization failed. - * - * ----------------------------------------------------------------- - */ - -static int CVBandPrecSetup(realtype t, N_Vector y, N_Vector fy, - booleantype jok, booleantype *jcurPtr, - realtype gamma, void *bp_data, - N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) -{ - long int ier; - CVBandPrecData pdata; - - /* Assume matrix and pivots have already been allocated. */ - pdata = (CVBandPrecData) bp_data; - - if (jok) { - /* If jok = TRUE, use saved copy of J. */ - *jcurPtr = FALSE; - BandCopy(savedJ, savedP, mu, ml); - } else { - /* If jok = FALSE, call CVBandPDQJac for new J value. */ - *jcurPtr = TRUE; - BandZero(savedJ); - CVBandPDQJac(pdata, t, y, fy, tmp1, tmp2); - BandCopy(savedJ, savedP, mu, ml); - } - - /* Scale and add I to get savedP = I - gamma*J. */ - BandScale(-gamma, savedP); - BandAddI(savedP); - - /* Do LU factorization of matrix. */ - ier = BandFactor(savedP, pivots); - - /* Return 0 if the LU was complete; otherwise return 1. */ - if (ier > 0) return(1); - return(0); -} - -/* - * ----------------------------------------------------------------- - * CVBandPrecSolve - * ----------------------------------------------------------------- - * CVBandPrecSolve solves a linear system P z = r, where P is the - * matrix computed by CVBandPrecond. - * - * The parameters of CVBandPrecSolve used here are as follows: - * - * r is the right-hand side vector of the linear system. - * - * bp_data is a pointer to preconditioner data - the same as the - * bp_data parameter passed to CVSpgmr. - * - * z is the output vector computed by CVBandPrecSolve. - * - * The value returned by the CVBandPrecSolve function is always 0, - * indicating success. - * ----------------------------------------------------------------- - */ - -static int CVBandPrecSolve(realtype t, N_Vector y, N_Vector fy, - N_Vector r, N_Vector z, - realtype gamma, realtype delta, - int lr, void *bp_data, N_Vector tmp) -{ - CVBandPrecData pdata; - realtype *zd; - - /* Assume matrix and pivots have already been allocated. */ - pdata = (CVBandPrecData) bp_data; - - /* Copy r to z. */ - N_VScale(ONE, r, z); - - /* Do band backsolve on the vector z. */ - zd = N_VGetArrayPointer(z); - - BandBacksolve(savedP, pivots, zd); - - return(0); -} - -/* - * ----------------------------------------------------------------- - * CVBandPDQJac - * ----------------------------------------------------------------- - * This routine generates a banded difference quotient approximation to - * the Jacobian of f(t,y). It assumes that a band matrix of type - * BandMat is stored column-wise, and that elements within each column - * are contiguous. This makes it possible to get the address of a column - * of J via the macro BAND_COL and to write a simple for loop to set - * each of the elements of a column in succession. - * ----------------------------------------------------------------- - */ - -#define ewt (cv_mem->cv_ewt) -#define uround (cv_mem->cv_uround) -#define h (cv_mem->cv_h) -#define f (cv_mem->cv_f) -#define f_data (cv_mem->cv_f_data) - -static void CVBandPDQJac(CVBandPrecData pdata, - realtype t, N_Vector y, N_Vector fy, - N_Vector ftemp, N_Vector ytemp) -{ - CVodeMem cv_mem; - realtype fnorm, minInc, inc, inc_inv, srur; - long int group, i, j, width, ngroups, i1, i2; - realtype *col_j, *ewt_data, *fy_data, *ftemp_data, *y_data, *ytemp_data; - - cv_mem = (CVodeMem) pdata->cvode_mem; - - /* Obtain pointers to the data for ewt, fy, ftemp, y, ytemp. */ - ewt_data = N_VGetArrayPointer(ewt); - fy_data = N_VGetArrayPointer(fy); - ftemp_data = N_VGetArrayPointer(ftemp); - y_data = N_VGetArrayPointer(y); - ytemp_data = N_VGetArrayPointer(ytemp); - - /* Load ytemp with y = predicted y vector. */ - N_VScale(ONE, y, ytemp); - - /* Set minimum increment based on uround and norm of f. */ - srur = RSqrt(uround); - fnorm = N_VWrmsNorm(fy, ewt); - minInc = (fnorm != ZERO) ? - (MIN_INC_MULT * ABS(h) * uround * N * fnorm) : ONE; - - /* Set bandwidth and number of column groups for band differencing. */ - width = ml + mu + 1; - ngroups = MIN(width, N); - - for (group = 1; group <= ngroups; group++) { - - /* Increment all y_j in group. */ - for(j = group-1; j < N; j += width) { - inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); - ytemp_data[j] += inc; - } - - /* Evaluate f with incremented y. */ - - f(t, ytemp, ftemp, f_data); - nfeBP++; - - /* Restore ytemp, then form and load difference quotients. */ - for (j = group-1; j < N; j += width) { - ytemp_data[j] = y_data[j]; - col_j = BAND_COL(savedJ,j); - inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); - inc_inv = ONE/inc; - i1 = MAX(0, j-mu); - i2 = MIN(j+ml, N-1); - for (i=i1; i <= i2; i++) - BAND_COL_ELEM(col_j,i,j) = - inc_inv * (ftemp_data[i] - fy_data[i]); - } - } -} diff --git a/src/sundials/cvodes/cvbandpre.h b/src/sundials/cvodes/cvbandpre.h deleted file mode 100755 index 90c55e7c78..0000000000 --- a/src/sundials/cvodes/cvbandpre.h +++ /dev/null @@ -1,174 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Michael Wittman, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This is the header file for the CVBANDPRE module, which - * provides a banded difference quotient Jacobian-based - * preconditioner and solver routines for use with CVSPGMR. - * - * Summary: - * These routines provide a band matrix preconditioner based on - * difference quotients of the ODE right-hand side function f. - * The user supplies parameters - * mu = upper half-bandwidth (number of super-diagonals) - * ml = lower half-bandwidth (number of sub-diagonals) - * The routines generate a band matrix of bandwidth ml + mu + 1 - * and use this to form a preconditioner for use with the Krylov - * linear solver in CVSPGMR. Although this matrix is intended - * to approximate the Jacobian df/dy, it may be a very crude - * approximation. The true Jacobian need not be banded, or its - * true bandwith may be larger than ml + mu + 1, as long as the - * banded approximation generated here is sufficiently accurate - * to speed convergence as a preconditioner. - * - * Usage: - * The following is a summary of the usage of this module. - * Details of the calls to CVodeCreate, CVodeMalloc, CVSpgmr, - * and CVode are available in the User Guide. - * To use these routines, the sequence of calls in the user - * main program should be as follows: - * - * #include "cvbandpre.h" - * #include "nvector_serial.h" - * ... - * void *bp_data; - * ... - * Set y0 - * ... - * cvode_mem = CVodeCreate(...); - * ier = CVodeMalloc(...); - * ... - * bp_data = CVBandPrecAlloc(cvode_mem, N, mu, ml); - * ... - * flag = CVBPSpgmr(cvode_mem, pretype, maxl, bp_data); - * ... - * flag = CVode(...); - * ... - * CVBandPrecFree(bp_data); - * ... - * Free y0 - * ... - * CVodeFree(cvode_mem); - * - * Notes: - * (1) Include this file for the CVBandPrecData type definition. - * (2) In the CVBandPrecAlloc call, the arguments N is the same - * as in the call to CVodeMalloc. - * (3) In the CVBPSpgmr call, the user is free to specify the input - * pretype and the optional input maxl. The last argument - * must be the pointer returned by CVBandPrecAlloc. - * ----------------------------------------------------------------- - */ - -#ifndef _CVBANDPRE_H -#define _CVBANDPRE_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -/* - * ----------------------------------------------------------------- - * Function : CVBandPrecAlloc - * ----------------------------------------------------------------- - * CVBandPrecAlloc allocates and initializes a CVBandPrecData - * structure to be passed to CVSpgmr (and subsequently used by - * CVBandPrecSetup and CVBandPrecSolve). - * - * The parameters of CVBandPrecAlloc are as follows: - * - * cvode_mem is the pointer to CVODE memory returned by CVodeCreate. - * - * N is the problem size. - * - * mu is the upper half bandwidth. - * - * ml is the lower half bandwidth. - * - * CVBandPrecAlloc returns the storage pointer of type - * CVBandPrecData, or NULL if the request for storage cannot be - * satisfied. - * - * NOTE: The band preconditioner assumes a serial implementation - * of the NVECTOR package. Therefore, CVBandPrecAlloc will - * first test for a compatible N_Vector internal - * representation by checking for required functions. - * ----------------------------------------------------------------- - */ - -void *CVBandPrecAlloc(void *cvode_mem, long int N, - long int mu, long int ml); - -/* - * ----------------------------------------------------------------- - * Function : CVBPSpgmr - * ----------------------------------------------------------------- - * CVBPSpgmr links the CVBANDPPRE preconditioner to the CVSPGMR - * linear solver. It performs the following actions: - * 1) Calls the CVSPGMR specification routine and attaches the - * CVSPGMR linear solver to the integrator memory; - * 2) Sets the preconditioner data structure for CVSPGMR - * 3) Sets the preconditioner setup routine for CVSPGMR - * 4) Sets the preconditioner solve routine for CVSPGMR - * - * Its first 3 arguments are the same as for CVSpgmr (see - * cvspgmr.h). The last argument is the pointer to the CVBANDPPRE - * memory block returned by CVBandPrecAlloc. - * Note that the user need not call CVSpgmr. - * - * Possible return values are: - * CVSPGMR_SUCCESS if successful - * CVSPGMR_MEM_NULL if the cvode memory was NULL - * CVSPGMR_LMEM_NULL if the cvspgmr memory was NULL - * CVSPGMR_MEM_FAIL if there was a memory allocation failure - * CVSPGMR_ILL_INPUT if a required vector operation is missing - * CV_PDATA_NULL if the bp_data was NULL - * ----------------------------------------------------------------- - */ - -int CVBPSpgmr(void *cvode_mem, int pretype, int maxl, void *p_data); - -/* - * ----------------------------------------------------------------- - * Function : CVBandPrecFree - * ----------------------------------------------------------------- - * CVBandPrecFree frees the memory allocated by CVBandPrecAlloc - * in the argument pdata. - * ----------------------------------------------------------------- - */ - -void CVBandPrecFree(void *bp_data); - -/* - * ----------------------------------------------------------------- - * Optional output functions : CVBandPrecGet* - * ----------------------------------------------------------------- - * CVBandPrecGetWorkSpace returns the real and integer workspace used - * by CVBANDPRE. - * CVBandPrecGetNumRhsEvals returns the number of calls made from - * CVBANDPRE to the user's right hand side - * routine f. - * - * The return value of CVBandPrecGet* is one of: - * CV_SUCCESS if successful - * CV_PDATA_NULL if the bp_data memory was NULL - * ----------------------------------------------------------------- - */ - -int CVBandPrecGetWorkSpace(void *bp_data, long int *lenrwBP, long int *leniwBP); -int CVBandPrecGetNumRhsEvals(void *bp_data, long int *nfevalsBP); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/cvodes/cvbandpre_impl.h b/src/sundials/cvodes/cvbandpre_impl.h deleted file mode 100755 index 4d202035d6..0000000000 --- a/src/sundials/cvodes/cvbandpre_impl.h +++ /dev/null @@ -1,70 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Michael Wittman, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * Implementation header file for the CVBANDPRE module. - * ----------------------------------------------------------------- - */ - -#ifndef _CVBANDPRE_IMPL_H -#define _CVBANDPRE_IMPL_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include "cvbandpre.h" - -#include "band.h" -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Type: CVBandPrecData - * ----------------------------------------------------------------- - */ - -typedef struct { - - /* Data set by user in CVBandPrecAlloc: */ - long int N; - long int ml, mu; - - /* Data set by CVBandPrecSetup: */ - BandMat savedJ; - BandMat savedP; - long int *pivots; - - /* Rhs calls */ - long int nfeBP; - - /* Pointer to cvode_mem */ - void *cvode_mem; - -} *CVBandPrecData; - -/* Error Messages */ - -#define _CVBALLOC_ "CVBandPreAlloc-- " -#define MSGBP_CVMEM_NULL _CVBALLOC_ "Integrator memory is NULL.\n\n" -#define MSGBP_BAD_NVECTOR _CVBALLOC_ "A required vector operation is not implemented.\n\n" - -#define MSGBP_PDATA_NULL "CVBandPrecGet*-- BandPrecData is NULL.\n\n" - -#define MSGBP_NO_PDATA "CVBPSpgmr-- BandPrecData is NULL.\n\n" - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/cvodes/cvbbdpre.c b/src/sundials/cvodes/cvbbdpre.c deleted file mode 100755 index c393ffee12..0000000000 --- a/src/sundials/cvodes/cvbbdpre.c +++ /dev/null @@ -1,470 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Michael Wittman, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This file contains implementations of routines for a - * band-block-diagonal preconditioner, i.e. a block-diagonal - * matrix with banded blocks, for use with CVODES, CVSpgmr, and - * the parallel implementation of NVECTOR. - * ----------------------------------------------------------------- - */ - -#include -#include - -#include "cvbbdpre_impl.h" -#include "cvodes_impl.h" -#include "cvspgmr_impl.h" - -#include "sundialsmath.h" - -#define MIN_INC_MULT RCONST(1000.0) -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) - -/* Prototypes of functions CVBBDPrecSetup and CVBBDPrecSolve */ - -static int CVBBDPrecSetup(realtype t, N_Vector y, N_Vector fy, - booleantype jok, booleantype *jcurPtr, - realtype gamma, void *bbd_data, - N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); - -static int CVBBDPrecSolve(realtype t, N_Vector y, N_Vector fy, - N_Vector r, N_Vector z, - realtype gamma, realtype delta, - int lr, void *bbd_data, N_Vector tmp); - -/* Prototype for difference quotient Jacobian calculation routine */ - -static void CVBBDDQJac(CVBBDPrecData pdata, realtype t, - N_Vector y, N_Vector gy, - N_Vector ytemp, N_Vector gtemp); - -/* Redability replacements */ -#define errfp (cv_mem->cv_errfp) -#define uround (cv_mem->cv_uround) -#define vec_tmpl (cv_mem->cv_tempv) - -/* - * ----------------------------------------------------------------- - * User-Callable Functions: malloc, reinit, and free - * ----------------------------------------------------------------- - */ - -void *CVBBDPrecAlloc(void *cvode_mem, long int Nlocal, - long int mudq, long int mldq, - long int mukeep, long int mlkeep, - realtype dqrely, - CVLocalFn gloc, CVCommFn cfn) -{ - CVodeMem cv_mem; - CVBBDPrecData pdata; - long int muk, mlk, storage_mu; - - if (cvode_mem == NULL) { - fprintf(stderr, MSGBBDP_CVMEM_NULL); - return(NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - /* Test if the NVECTOR package is compatible with the BLOCK BAND preconditioner */ - if(vec_tmpl->ops->nvgetarraypointer == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGBBDP_BAD_NVECTOR); - return(NULL); - } - - /* Allocate data memory */ - pdata = (CVBBDPrecData) malloc(sizeof *pdata); - if (pdata == NULL) return(NULL); - - /* Set pointers to gloc and cfn; load half-bandwidths */ - pdata->cvode_mem = cvode_mem; - pdata->gloc = gloc; - pdata->cfn = cfn; - pdata->mudq = MIN( Nlocal-1, MAX(0,mudq) ); - pdata->mldq = MIN( Nlocal-1, MAX(0,mldq) ); - muk = MIN( Nlocal-1, MAX(0,mukeep) ); - mlk = MIN( Nlocal-1, MAX(0,mlkeep) ); - pdata->mukeep = muk; - pdata->mlkeep = mlk; - - /* Allocate memory for saved Jacobian */ - pdata->savedJ = BandAllocMat(Nlocal, muk, mlk, muk); - if (pdata->savedJ == NULL) { free(pdata); return(NULL); } - - /* Allocate memory for preconditioner matrix */ - storage_mu = MIN(Nlocal-1, muk + mlk); - pdata->savedP = BandAllocMat(Nlocal, muk, mlk, storage_mu); - if (pdata->savedP == NULL) { - BandFreeMat(pdata->savedJ); - free(pdata); - return(NULL); - } - /* Allocate memory for pivots */ - pdata->pivots = BandAllocPiv(Nlocal); - if (pdata->savedJ == NULL) { - BandFreeMat(pdata->savedP); - BandFreeMat(pdata->savedJ); - free(pdata); - return(NULL); - } - - /* Set pdata->dqrely based on input dqrely (0 implies default). */ - pdata->dqrely = (dqrely > ZERO) ? dqrely : RSqrt(uround); - - /* Store Nlocal to be used in CVBBDPrecSetup */ - pdata->n_local = Nlocal; - - /* Set work space sizes and initialize nge */ - pdata->rpwsize = Nlocal*(muk + 2*mlk + storage_mu + 2); - pdata->ipwsize = Nlocal; - pdata->nge = 0; - - return((void *)pdata); -} - -int CVBBDSpgmr(void *cvode_mem, int pretype, int maxl, void *bbd_data) -{ - int flag; - - if ( bbd_data == NULL ) { - fprintf(stderr, MSGBBDP_NO_PDATA); - return(CV_PDATA_NULL); - } - - flag = CVSpgmr(cvode_mem, pretype, maxl); - if(flag != CVSPGMR_SUCCESS) return(flag); - - flag = CVSpgmrSetPrecData(cvode_mem, bbd_data); - if(flag != CVSPGMR_SUCCESS) return(flag); - - flag = CVSpgmrSetPrecSetupFn(cvode_mem, CVBBDPrecSetup); - if(flag != CVSPGMR_SUCCESS) return(flag); - - flag = CVSpgmrSetPrecSolveFn(cvode_mem, CVBBDPrecSolve); - if(flag != CVSPGMR_SUCCESS) return(flag); - - return(CVSPGMR_SUCCESS); -} - -int CVBBDPrecReInit(void *bbd_data, - long int mudq, long int mldq, - realtype dqrely, - CVLocalFn gloc, CVCommFn cfn) -{ - CVBBDPrecData pdata; - CVodeMem cv_mem; - long int Nlocal; - - if ( bbd_data == NULL ) { - fprintf(stderr, MSGBBDP_NO_PDATA); - return(CV_PDATA_NULL); - } - - pdata = (CVBBDPrecData) bbd_data; - cv_mem = (CVodeMem) pdata->cvode_mem; - - /* Set pointers to gloc and cfn; load half-bandwidths */ - pdata->gloc = gloc; - pdata->cfn = cfn; - Nlocal = pdata->n_local; - pdata->mudq = MIN( Nlocal-1, MAX(0,mudq) ); - pdata->mldq = MIN( Nlocal-1, MAX(0,mldq) ); - - /* Set pdata->dqrely based on input dqrely (0 implies default). */ - pdata->dqrely = (dqrely > ZERO) ? dqrely : RSqrt(uround); - - /* Re-initialize nge */ - pdata->nge = 0; - - return(CV_SUCCESS); -} - -void CVBBDPrecFree(void *bbd_data) -{ - CVBBDPrecData pdata; - - if ( bbd_data != NULL ) { - pdata = (CVBBDPrecData) bbd_data; - BandFreeMat(pdata->savedJ); - BandFreeMat(pdata->savedP); - BandFreePiv(pdata->pivots); - free(pdata); - } -} - -int CVBBDPrecGetWorkSpace(void *bbd_data, long int *lenrwBBDP, long int *leniwBBDP) -{ - CVBBDPrecData pdata; - - if ( bbd_data == NULL ) { - fprintf(stderr, MSGBBDP_PDATA_NULL); - return(CV_PDATA_NULL); - } - - pdata = (CVBBDPrecData) bbd_data; - - *lenrwBBDP = pdata->rpwsize; - *leniwBBDP = pdata->ipwsize; - - return(CV_SUCCESS); -} - -int CVBBDPrecGetNumGfnEvals(void *bbd_data, long int *ngevalsBBDP) -{ - CVBBDPrecData pdata; - - if ( bbd_data == NULL ) { - fprintf(stderr, MSGBBDP_PDATA_NULL); - return(CV_PDATA_NULL); - } - - pdata = (CVBBDPrecData) bbd_data; - - *ngevalsBBDP = pdata->nge; - - return(CV_SUCCESS); -} - - -/* Readability Replacements */ - -#define Nlocal (pdata->n_local) -#define mudq (pdata->mudq) -#define mldq (pdata->mldq) -#define mukeep (pdata->mukeep) -#define mlkeep (pdata->mlkeep) -#define dqrely (pdata->dqrely) -#define gloc (pdata->gloc) -#define cfn (pdata->cfn) -#define savedJ (pdata->savedJ) -#define savedP (pdata->savedP) -#define pivots (pdata->pivots) -#define nge (pdata->nge) - - -/* - * ----------------------------------------------------------------- - * Function : CVBBDPrecSetup - * ----------------------------------------------------------------- - * CVBBDPrecSetup generates and factors a banded block of the - * preconditioner matrix on each processor, via calls to the - * user-supplied gloc and cfn functions. It uses difference - * quotient approximations to the Jacobian elements. - * - * CVBBDPrecSetup calculates a new J,if necessary, then calculates - * P = I - gamma*J, and does an LU factorization of P. - * - * The parameters of CVBBDPrecSetup used here are as follows: - * - * t is the current value of the independent variable. - * - * y is the current value of the dependent variable vector, - * namely the predicted value of y(t). - * - * fy is the vector f(t,y). - * - * jok is an input flag indicating whether Jacobian-related - * data needs to be recomputed, as follows: - * jok == FALSE means recompute Jacobian-related data - * from scratch. - * jok == TRUE means that Jacobian data from the - * previous CVBBDPrecon call can be reused - * (with the current value of gamma). - * A CVBBDPrecon call with jok == TRUE should only occur - * after a call with jok == FALSE. - * - * jcurPtr is a pointer to an output integer flag which is - * set by CVBBDPrecon as follows: - * *jcurPtr = TRUE if Jacobian data was recomputed. - * *jcurPtr = FALSE if Jacobian data was not recomputed, - * but saved data was reused. - * - * gamma is the scalar appearing in the Newton matrix. - * - * bbd_data is a pointer to user data - the same as the P_data - * parameter passed to CVSpgmr. For CVBBDPrecon, this - * should be of type CVBBDData. - * - * tmp1, tmp2, and tmp3 are pointers to memory allocated - * for NVectors which are be used by CVBBDPrecSetup - * as temporary storage or work space. - * - * - * Return value: - * The value returned by this CVBBDPrecSetup function is the int - * 0 if successful, - * 1 for a recoverable error (step will be retried). - * ----------------------------------------------------------------- - */ - -static int CVBBDPrecSetup(realtype t, N_Vector y, N_Vector fy, - booleantype jok, booleantype *jcurPtr, - realtype gamma, void *bbd_data, - N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) -{ - long int ier; - CVBBDPrecData pdata; - - pdata = (CVBBDPrecData) bbd_data; - - if (jok) { - /* If jok = TRUE, use saved copy of J */ - *jcurPtr = FALSE; - BandCopy(savedJ, savedP, mukeep, mlkeep); - } else { - /* Otherwise call CVBBDDQJac for new J value */ - *jcurPtr = TRUE; - BandZero(savedJ); - CVBBDDQJac(pdata, t, y, tmp1, tmp2, tmp3); - nge += 1 + MIN(mldq + mudq + 1, Nlocal); - BandCopy(savedJ, savedP, mukeep, mlkeep); - } - - /* Scale and add I to get P = I - gamma*J */ - BandScale(-gamma, savedP); - BandAddI(savedP); - - /* Do LU factorization of P in place */ - ier = BandFactor(savedP, pivots); - - /* Return 0 if the LU was complete; otherwise return 1 */ - if (ier > 0) return(1); - return(0); -} - - -/* - * ----------------------------------------------------------------- - * Function : CVBBDPrecSolve - * ----------------------------------------------------------------- - * CVBBDPrecSolve solves a linear system P z = r, with the - * band-block-diagonal preconditioner matrix P generated and - * factored by CVBBDPrecSetup. - * - * The parameters of CVBBDPrecSolve used here are as follows: - * - * r is the right-hand side vector of the linear system. - * - * bbd_data is a pointer to the preconditioner data returned by - * CVBBDPrecAlloc. - * - * z is the output vector computed by CVBBDPrecSolve. - * - * The value returned by the CVBBDPrecSolve function is always 0, - * indicating success. - * ----------------------------------------------------------------- - */ - -static int CVBBDPrecSolve(realtype t, N_Vector y, N_Vector fy, - N_Vector r, N_Vector z, - realtype gamma, realtype delta, - int lr, void *bbd_data, N_Vector tmp) -{ - CVBBDPrecData pdata; - realtype *zd; - - pdata = (CVBBDPrecData) bbd_data; - - /* Copy r to z, then do backsolve and return */ - N_VScale(ONE, r, z); - - zd = N_VGetArrayPointer(z); - - BandBacksolve(savedP, pivots, zd); - - return(0); -} - - -/* - * ----------------------------------------------------------------- - * CVBBDDQJac - * ----------------------------------------------------------------- - * This routine generates a banded difference quotient approximation to - * the local block of the Jacobian of g(t,y). It assumes that a band - * matrix of type BandMat is stored columnwise, and that elements within - * each column are contiguous. All matrix elements are generated as - * difference quotients, by way of calls to the user routine gloc. - * By virtue of the band structure, the number of these calls is - * bandwidth + 1, where bandwidth = mldq + mudq + 1. - * But the band matrix kept has bandwidth = mlkeep + mukeep + 1. - * This routine also assumes that the local elements of a vector are - * stored contiguously. - * ----------------------------------------------------------------- - */ - -#define ewt (cv_mem->cv_ewt) -#define h (cv_mem->cv_h) -#define f_data (cv_mem->cv_f_data) - -static void CVBBDDQJac(CVBBDPrecData pdata, realtype t, - N_Vector y, N_Vector gy, - N_Vector ytemp, N_Vector gtemp) -{ - CVodeMem cv_mem; - realtype gnorm, minInc, inc, inc_inv; - long int group, i, j, width, ngroups, i1, i2; - realtype *y_data, *ewt_data, *gy_data, *gtemp_data, *ytemp_data, *col_j; - - cv_mem = (CVodeMem) pdata->cvode_mem; - - /* Load ytemp with y = predicted solution vector */ - N_VScale(ONE, y, ytemp); - - /* Call cfn and gloc to get base value of g(t,y) */ - if (cfn != NULL) - cfn (Nlocal, t, y, f_data); - gloc(Nlocal, t, ytemp, gy, f_data); - - /* Obtain pointers to the data for various vectors */ - y_data = N_VGetArrayPointer(y); - gy_data = N_VGetArrayPointer(gy); - ewt_data = N_VGetArrayPointer(ewt); - ytemp_data = N_VGetArrayPointer(ytemp); - gtemp_data = N_VGetArrayPointer(gtemp); - - /* Set minimum increment based on uround and norm of g */ - gnorm = N_VWrmsNorm(gy, ewt); - minInc = (gnorm != ZERO) ? - (MIN_INC_MULT * ABS(h) * uround * Nlocal * gnorm) : ONE; - - /* Set bandwidth and number of column groups for band differencing */ - width = mldq + mudq + 1; - ngroups = MIN(width, Nlocal); - - /* Loop over groups */ - for (group=1; group <= ngroups; group++) { - - /* Increment all y_j in group */ - for(j=group-1; j < Nlocal; j+=width) { - inc = MAX(dqrely*ABS(y_data[j]), minInc/ewt_data[j]); - ytemp_data[j] += inc; - } - - /* Evaluate g with incremented y */ - gloc(Nlocal, t, ytemp, gtemp, f_data); - - /* Restore ytemp, then form and load difference quotients */ - for (j=group-1; j < Nlocal; j+=width) { - ytemp_data[j] = y_data[j]; - col_j = BAND_COL(savedJ,j); - inc = MAX(dqrely*ABS(y_data[j]), minInc/ewt_data[j]); - inc_inv = ONE/inc; - i1 = MAX(0, j-mukeep); - i2 = MIN(j+mlkeep, Nlocal-1); - for (i=i1; i <= i2; i++) - BAND_COL_ELEM(col_j,i,j) = - inc_inv * (gtemp_data[i] - gy_data[i]); - } - } -} diff --git a/src/sundials/cvodes/cvbbdpre.h b/src/sundials/cvodes/cvbbdpre.h deleted file mode 100755 index 49f15cd691..0000000000 --- a/src/sundials/cvodes/cvbbdpre.h +++ /dev/null @@ -1,298 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Michael Wittman, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This is the header file for the CVBBDPRE module, for a - * band-block-diagonal preconditioner, i.e. a block-diagonal - * matrix with banded blocks, for use with CVSpgmr, and - * the parallel implementation of the NVECTOR module. - * - * Summary: - * - * These routines provide a preconditioner matrix that is - * block-diagonal with banded blocks. The blocking corresponds - * to the distribution of the dependent variable vector y among - * the processors. Each preconditioner block is generated from - * the Jacobian of the local part (on the current processor) of a - * given function g(t,y) approximating f(t,y). The blocks are - * generated by a difference quotient scheme on each processor - * independently. This scheme utilizes an assumed banded - * structure with given half-bandwidths, mudq and mldq. - * However, the banded Jacobian block kept by the scheme has - * half-bandwiths mukeep and mlkeep, which may be smaller. - * - * The user's calling program should have the following form: - * - * #include "nvector_parallel.h" - * #include "cvbbdpre.h" - * ... - * void *cvode_mem; - * void *bbd_data; - * ... - * Set y0 - * ... - * cvode_mem = CVodeCreate(...); - * ier = CVodeMalloc(...); - * ... - * bbd_data = CVBBDPrecAlloc(cvode_mem, Nlocal, mudq ,mldq, - * mukeep, mlkeep, dqrely, gloc, cfn); - * flag = CVBBDSpgmr(cvode_mem, pretype, maxl, bbd_data); - * ... - * ier = CVode(...); - * ... - * CVBBDPrecFree(bbd_data); - * ... - * CVodeFree(...); - * - * Free y0 - * - * The user-supplied routines required are: - * - * f = function defining the ODE right-hand side f(t,y). - * - * gloc = function defining the approximation g(t,y). - * - * cfn = function to perform communication need for gloc. - * - * Notes: - * - * 1) This header file is included by the user for the definition - * of the CVBBDData type and for needed function prototypes. - * - * 2) The CVBBDPrecAlloc call includes half-bandwiths mudq and mldq - * to be used in the difference-quotient calculation of the - * approximate Jacobian. They need not be the true - * half-bandwidths of the Jacobian of the local block of g, - * when smaller values may provide a greater efficiency. - * Also, the half-bandwidths mukeep and mlkeep of the retained - * banded approximate Jacobian block may be even smaller, - * to reduce storage and computation costs further. - * For all four half-bandwidths, the values need not be the - * same on every processor. - * - * 3) The actual name of the user's f function is passed to - * CVodeMalloc, and the names of the user's gloc and cfn - * functions are passed to CVBBDPrecAlloc. - * - * 4) The pointer to the user-defined data block f_data, which is - * set through CVodeSetFdata is also available to the user in - * gloc and cfn. - * - * 5) For the CVSpgmr solver, the Gram-Schmidt type gstype, is - * left to the user to specify through CVSpgmrSetGStype. - * - * 6) Optional outputs specific to this module are available by - * way of routines listed below. These include work space sizes - * and the cumulative number of gloc calls. The costs - * associated with this module also include nsetups banded LU - * factorizations, nlinsetups cfn calls, and npsolves banded - * backsolve calls, where nlinsetups and npsolves are - * integrator/CVSPGMR optional outputs. - * ----------------------------------------------------------------- - */ - -#ifndef _CVBBDPRE_H -#define _CVBBDPRE_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Type : CVLocalFn - * ----------------------------------------------------------------- - * The user must supply a function g(t,y) which approximates the - * right-hand side function f for the system y'=f(t,y), and which - * is computed locally (without inter-processor communication). - * (The case where g is mathematically identical to f is allowed.) - * The implementation of this function must have type CVLocalFn. - * - * This function takes as input the local vector size Nlocal, the - * independent variable value t, the local real dependent - * variable vector y, and a pointer to the user-defined data - * block f_data. It is to compute the local part of g(t,y) and - * store this in the vector g. - * (Allocation of memory for y and g is handled within the - * preconditioner module.) - * The f_data parameter is the same as that specified by the user - * through the CVodeSetFdata routine. - * A CVLocalFn gloc does not have a return value. - * ----------------------------------------------------------------- - */ - -typedef void (*CVLocalFn)(long int Nlocal, realtype t, N_Vector y, - N_Vector g, void *f_data); - -/* - * ----------------------------------------------------------------- - * Type : CVCommFn - * ----------------------------------------------------------------- - * The user may supply a function of type CVCommFn which performs - * all inter-processor communication necessary to evaluate the - * approximate right-hand side function described above. - * - * This function takes as input the local vector size Nlocal, - * the independent variable value t, the dependent variable - * vector y, and a pointer to the user-defined data block f_data. - * The f_data parameter is the same as that specified by the user - * through the CVodeSetFdata routine. The CVCommFn cfn is - * expected to save communicated data in space defined within the - * structure f_data. Note: A CVCommFn cfn does not have a return value. - * - * Each call to the CVCommFn cfn is preceded by a call to the - * RhsFn f with the same (t,y) arguments. Thus cfn can omit any - * communications done by f if relevant to the evaluation of g. - * If all necessary communication was done by f, the user can - * pass NULL for cfn in CVBBDPrecAlloc (see below). - * ----------------------------------------------------------------- - */ - -typedef void (*CVCommFn)(long int Nlocal, realtype t, N_Vector y, - void *f_data); - -/* - * ----------------------------------------------------------------- - * Function : CVBBDPrecAlloc - * ----------------------------------------------------------------- - * CVBBDPrecAlloc allocates and initializes a CVBBDData structure - * to be passed to CVSpgmr (and used by CVBBDPrecSetup and - * and CVBBDPrecSolve. - * - * The parameters of CVBBDPrecAlloc are as follows: - * - * cvode_mem is the pointer to the integrator memory. - * - * Nlocal is the length of the local block of the vectors y etc. - * on the current processor. - * - * mudq, mldq are the upper and lower half-bandwidths to be used - * in the difference-quotient computation of the local - * Jacobian block. - * - * mukeep, mlkeep are the upper and lower half-bandwidths of the - * retained banded approximation to the local Jacobian - * block. - * - * dqrely is an optional input. It is the relative increment - * in components of y used in the difference quotient - * approximations. To specify the default, pass 0. - * The default is dqrely = sqrt(unit roundoff). - * - * gloc is the name of the user-supplied function g(t,y) that - * approximates f and whose local Jacobian blocks are - * to form the preconditioner. - * - * cfn is the name of the user-defined function that performs - * necessary inter-processor communication for the - * execution of gloc. - * - * CVBBDPrecAlloc returns the storage allocated (type *void), - * or NULL if the request for storage cannot be satisfied. - * ----------------------------------------------------------------- - */ - -void *CVBBDPrecAlloc(void *cvode_mem, long int Nlocal, - long int mudq, long int mldq, - long int mukeep, long int mlkeep, - realtype dqrely, - CVLocalFn gloc, CVCommFn cfn); - -/* - * ----------------------------------------------------------------- - * Function : CVBBDSpgmr - * ----------------------------------------------------------------- - * CVBBDSpgmr links the CVBBDPRE preconditioner to the CVSPGMR - * linear solver. It performs the following actions: - * 1) Calls the CVSPGMR specification routine and attaches the - * CVSPGMR linear solver to the integrator memory; - * 2) Sets the preconditioner data structure for CVSPGMR - * 3) Sets the preconditioner setup routine for CVSPGMR - * 4) Sets the preconditioner solve routine for CVSPGMR - * - * Its first 3 arguments are the same as for CVSpgmr (see - * cvspgmr.h). The last argument is the pointer to the CVBBDPRE - * memory block returned by CVBBDPrecAlloc. - * Note that the user need not call CVSpgmr. - * - * Possible return values are: - * CVSPGMR_SUCCESS if successful - * CVSPGMR_MEM_NULL if the cvode memory was NULL - * CVSPGMR_LMEM_NULL if the cvspgmr memory was NULL - * CVSPGMR_MEM_FAIL if there was a memory allocation failure - * CVSPGMR_ILL_INPUT if a required vector operation is missing - * CV_PDATA_NULL if the bbd_data was NULL - * ----------------------------------------------------------------- - */ - -int CVBBDSpgmr(void *cvode_mem, int pretype, int maxl, void *bbd_data); - -/* - * ----------------------------------------------------------------- - * Function : CVBBDPrecReInit - * ----------------------------------------------------------------- - * CVBBDPrecReInit re-initializes the BBDPRE module when solving a - * sequence of problems of the same size with CVSPGMR/CVBBDPRE, - * provided there is no change in Nlocal, mukeep, or mlkeep. - * After solving one problem, and after calling CVodeReInit to - * re-initialize the integrator for a subsequent problem, call - * CVBBDPrecReInit. Then call CVSpgmrSet* functions if necessary - * for any changes to CVSpgmr parameters, before calling CVode. - * - * The first argument to CVBBDPrecReInit must be the pointer pdata - * that was returned by CVBBDPrecAlloc. All other arguments have - * the same names and meanings as those of CVBBDPrecAlloc. - * - * The return value of CVBBDPrecReInit is CV_SUCCESS, indicating - * success, or CV_PDATA_NULL if bbd_data was NULL. - * ----------------------------------------------------------------- - */ - -int CVBBDPrecReInit(void *bbd_data, long int mudq, long int mldq, - realtype dqrely, CVLocalFn gloc, CVCommFn cfn); - -/* - * ----------------------------------------------------------------- - * Function : CVBBDPrecFree - * ----------------------------------------------------------------- - * CVBBDPrecFree frees the memory block bbd_data allocated by the - * call to CVBBDAlloc. - * ----------------------------------------------------------------- - */ - -void CVBBDPrecFree(void *bbd_data); - -/* - * ----------------------------------------------------------------- - * BBDPRE optional output extraction routines - * ----------------------------------------------------------------- - * CVBBDPrecGetWorkSpace returns the BBDPRE real and integer workspace - * sizes. - * CVBBDPrecGetNumGfnEvals returns the number of calls to gfn. - * - * The return value of CVBBDPrecGet* is one of: - * CV_SUCCESS if successful - * CV_PDATA_NULL if the bbd_data memory was NULL - * ----------------------------------------------------------------- - */ - -int CVBBDPrecGetWorkSpace(void *bbd_data, long int *lenrwBBDP, long int *leniwBBDP); -int CVBBDPrecGetNumGfnEvals(void *bbd_data, long int *ngevalsBBDP); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/cvodes/cvbbdpre_impl.h b/src/sundials/cvodes/cvbbdpre_impl.h deleted file mode 100755 index baca03b569..0000000000 --- a/src/sundials/cvodes/cvbbdpre_impl.h +++ /dev/null @@ -1,78 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Michael Wittman, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * Implementation header file for the CVBBDPRE module. - * ----------------------------------------------------------------- - */ - -#ifndef _CVBBDPRE_IMPL_H -#define _CVBBDPRE_IMPL_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include "cvbbdpre.h" - -#include "band.h" -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Type: CVBBDPrecData - * ----------------------------------------------------------------- - */ - -typedef struct { - - /* passed by user to CVBBDPrecAlloc, used by PrecSetup/PrecSolve */ - long int mudq, mldq, mukeep, mlkeep; - realtype dqrely; - CVLocalFn gloc; - CVCommFn cfn; - - /* set by CVBBDPrecSetup and used by CVBBDPrecSolve */ - BandMat savedJ; - BandMat savedP; - long int *pivots; - - /* set by CVBBDPrecAlloc and used by CVBBDPrecSetup */ - long int n_local; - - /* available for optional output: */ - long int rpwsize; - long int ipwsize; - long int nge; - - /* Pointer to cvode_mem */ - void *cvode_mem; - -} *CVBBDPrecData; - - -/* Error Messages */ - -#define _CVBBDALLOC_ "CVBBDAlloc-- " -#define MSGBBDP_CVMEM_NULL _CVBBDALLOC_ "Integrator memory is NULL.\n\n" -#define MSGBBDP_BAD_NVECTOR _CVBBDALLOC_ "A required vector operation is not implemented.\n\n" - -#define MSGBBDP_PDATA_NULL "CVBBDPrecGet*-- BBDPrecData is NULL.\n\n" - -#define MSGBBDP_NO_PDATA "CVBBDSpgmr-- BBDPrecData is NULL.\n\n" - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/cvodes/cvdense.c b/src/sundials/cvodes/cvdense.c deleted file mode 100755 index 14411e4e35..0000000000 --- a/src/sundials/cvodes/cvdense.c +++ /dev/null @@ -1,565 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for the CVDENSE linear solver. - * ----------------------------------------------------------------- - */ - -#include -#include - -#include "cvdense_impl.h" -#include "cvodes_impl.h" - -#include "sundialsmath.h" - -/* Other Constants */ - -#define MIN_INC_MULT RCONST(1000.0) -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) -#define TWO RCONST(2.0) - -/* CVDENSE linit, lsetup, lsolve, and lfree routines */ - -static int CVDenseInit(CVodeMem cv_mem); - -static int CVDenseSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, - N_Vector fpred, booleantype *jcurPtr, - N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); - -static int CVDenseSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, - N_Vector ycur, N_Vector fcur); - -static void CVDenseFree(CVodeMem cv_mem); - -/* CVDENSE DQJac routine */ - -static void CVDenseDQJac(long int n, DenseMat J, realtype t, - N_Vector y, N_Vector fy, void *jac_data, - N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); - -/* Readability Replacements */ - -#define lmm (cv_mem->cv_lmm) -#define f (cv_mem->cv_f) -#define f_data (cv_mem->cv_f_data) -#define uround (cv_mem->cv_uround) -#define nst (cv_mem->cv_nst) -#define tn (cv_mem->cv_tn) -#define h (cv_mem->cv_h) -#define gamma (cv_mem->cv_gamma) -#define gammap (cv_mem->cv_gammap) -#define gamrat (cv_mem->cv_gamrat) -#define ewt (cv_mem->cv_ewt) -#define errfp (cv_mem->cv_errfp) -#define linit (cv_mem->cv_linit) -#define lsetup (cv_mem->cv_lsetup) -#define lsolve (cv_mem->cv_lsolve) -#define lfree (cv_mem->cv_lfree) -#define lmem (cv_mem->cv_lmem) -#define vec_tmpl (cv_mem->cv_tempv) -#define setupNonNull (cv_mem->cv_setupNonNull) - -#define n (cvdense_mem->d_n) -#define jac (cvdense_mem->d_jac) -#define M (cvdense_mem->d_M) -#define pivots (cvdense_mem->d_pivots) -#define savedJ (cvdense_mem->d_savedJ) -#define nstlj (cvdense_mem->d_nstlj) -#define nje (cvdense_mem->d_nje) -#define nfeD (cvdense_mem->d_nfeD) -#define J_data (cvdense_mem->d_J_data) -#define last_flag (cvdense_mem->d_last_flag) - -/* - * ----------------------------------------------------------------- - * CVDense - * ----------------------------------------------------------------- - * This routine initializes the memory record and sets various function - * fields specific to the dense linear solver module. CVDense first - * calls the existing lfree routine if this is not NULL. Then it sets - * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) - * to be CVDenseInit, CVDenseSetup, CVDenseSolve, and CVDenseFree, - * respectively. It allocates memory for a structure of type - * CVDenseMemRec and sets the cv_lmem field in (*cvode_mem) to the - * address of this structure. It sets setupNonNull in (*cvode_mem) to - * TRUE, and the d_jac field to the default CVDenseDQJac. - * Finally, it allocates memory for M, savedJ, and pivots. - * The return value is SUCCESS = 0, or LMEM_FAIL = -1. - * - * NOTE: The dense linear solver assumes a serial implementation - * of the NVECTOR package. Therefore, CVDense will first - * test for compatible a compatible N_Vector internal - * representation by checking that N_VGetArrayPointer and - * N_VSetArrayPointer exist. - * ----------------------------------------------------------------- - */ - -int CVDense(void *cvode_mem, long int N) -{ - CVodeMem cv_mem; - CVDenseMem cvdense_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGDS_CVMEM_NULL); - return(CVDENSE_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - /* Test if the NVECTOR package is compatible with the DENSE solver */ - if (vec_tmpl->ops->nvgetarraypointer == NULL || - vec_tmpl->ops->nvsetarraypointer == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDS_BAD_NVECTOR); - return(CVDENSE_ILL_INPUT); - } - - if (lfree !=NULL) lfree(cv_mem); - - /* Set four main function fields in cv_mem */ - linit = CVDenseInit; - lsetup = CVDenseSetup; - lsolve = CVDenseSolve; - lfree = CVDenseFree; - - /* Get memory for CVDenseMemRec */ - cvdense_mem = (CVDenseMem) malloc(sizeof(CVDenseMemRec)); - if (cvdense_mem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDS_MEM_FAIL); - return(CVDENSE_MEM_FAIL); - } - - /* Set default Jacobian routine and Jacobian data */ - jac = CVDenseDQJac; - J_data = cvode_mem; - last_flag = CVDENSE_SUCCESS; - - setupNonNull = TRUE; - - /* Set problem dimension */ - n = N; - - /* Allocate memory for M, savedJ, and pivot array */ - - M = DenseAllocMat(N); - if (M == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDS_MEM_FAIL); - return(CVDENSE_MEM_FAIL); - } - savedJ = DenseAllocMat(N); - if (savedJ == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDS_MEM_FAIL); - DenseFreeMat(M); - return(CVDENSE_MEM_FAIL); - } - pivots = DenseAllocPiv(N); - if (pivots == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDS_MEM_FAIL); - DenseFreeMat(M); - DenseFreeMat(savedJ); - return(CVDENSE_MEM_FAIL); - } - - /* Attach linear solver memory to integrator memory */ - lmem = cvdense_mem; - - return(CVDENSE_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVDenseSetJacFn - * ----------------------------------------------------------------- - */ - -int CVDenseSetJacFn(void *cvode_mem, CVDenseJacFn djac) -{ - CVodeMem cv_mem; - CVDenseMem cvdense_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGDS_SETGET_CVMEM_NULL); - return(CVDENSE_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDS_SETGET_LMEM_NULL); - return(CVDENSE_LMEM_NULL); - } - cvdense_mem = (CVDenseMem) lmem; - - jac = djac; - - return(CVDENSE_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVDenseSetJacData - * ----------------------------------------------------------------- - */ - -int CVDenseSetJacData(void *cvode_mem, void *jac_data) -{ - CVodeMem cv_mem; - CVDenseMem cvdense_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGDS_SETGET_CVMEM_NULL); - return(CVDENSE_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDS_SETGET_LMEM_NULL); - return(CVDENSE_LMEM_NULL); - } - cvdense_mem = (CVDenseMem) lmem; - - J_data = jac_data; - - return(CVDENSE_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVDenseGetWorkSpace - * ----------------------------------------------------------------- - */ - -int CVDenseGetWorkSpace(void *cvode_mem, long int *lenrwD, long int *leniwD) -{ - CVodeMem cv_mem; - CVDenseMem cvdense_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGDS_SETGET_CVMEM_NULL); - return(CVDENSE_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDS_SETGET_LMEM_NULL); - return(CVDENSE_LMEM_NULL); - } - cvdense_mem = (CVDenseMem) lmem; - - *lenrwD = 2*n*n; - *leniwD = n; - - return(CVDENSE_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVDenseGetNumJacEvals - * ----------------------------------------------------------------- - */ - -int CVDenseGetNumJacEvals(void *cvode_mem, long int *njevalsD) -{ - CVodeMem cv_mem; - CVDenseMem cvdense_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGDS_SETGET_CVMEM_NULL); - return(CVDENSE_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDS_SETGET_LMEM_NULL); - return(CVDENSE_LMEM_NULL); - } - cvdense_mem = (CVDenseMem) lmem; - - *njevalsD = nje; - - return(CVDENSE_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVDenseGetNumRhsEvals - * ----------------------------------------------------------------- - */ - -int CVDenseGetNumRhsEvals(void *cvode_mem, long int *nfevalsD) -{ - CVodeMem cv_mem; - CVDenseMem cvdense_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGDS_SETGET_CVMEM_NULL); - return(CVDENSE_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDS_SETGET_LMEM_NULL); - return(CVDENSE_LMEM_NULL); - } - cvdense_mem = (CVDenseMem) lmem; - - *nfevalsD = nfeD; - - return(CVDENSE_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVDenseGetLastFlag - * ----------------------------------------------------------------- - */ - -int CVDenseGetLastFlag(void *cvode_mem, int *flag) -{ - CVodeMem cv_mem; - CVDenseMem cvdense_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGDS_SETGET_CVMEM_NULL); - return(CVDENSE_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDS_SETGET_LMEM_NULL); - return(CVDENSE_LMEM_NULL); - } - cvdense_mem = (CVDenseMem) lmem; - - *flag = last_flag; - - return(CVDENSE_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVDenseInit - * ----------------------------------------------------------------- - * This routine does remaining initializations specific to the dense - * linear solver. - * ----------------------------------------------------------------- - */ - -static int CVDenseInit(CVodeMem cv_mem) -{ - CVDenseMem cvdense_mem; - - cvdense_mem = (CVDenseMem) lmem; - - nje = 0; - nfeD = 0; - nstlj = 0; - - if (jac == NULL) { - jac = CVDenseDQJac; - J_data = cv_mem; - } - - last_flag = CVDENSE_SUCCESS; - return(0); -} - -/* - * ----------------------------------------------------------------- - * CVDenseSetup - * ----------------------------------------------------------------- - * This routine does the setup operations for the dense linear solver. - * It makes a decision whether or not to call the Jacobian evaluation - * routine based on various state variables, and if not it uses the - * saved copy. In any case, it constructs the Newton matrix - * M = I - gamma*J, updates counters, and calls the dense LU - * factorization routine. - * ----------------------------------------------------------------- - */ - -static int CVDenseSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, - N_Vector fpred, booleantype *jcurPtr, - N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) -{ - booleantype jbad, jok; - realtype dgamma; - long int ier; - CVDenseMem cvdense_mem; - - cvdense_mem = (CVDenseMem) lmem; - - /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ - - dgamma = ABS((gamma/gammap) - ONE); - jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) || - ((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) || - (convfail == CV_FAIL_OTHER); - jok = !jbad; - - if (jok) { - /* If jok = TRUE, use saved copy of J */ - *jcurPtr = FALSE; - DenseCopy(savedJ, M); - } else { - /* If jok = FALSE, call jac routine for new J value */ - nje++; - nstlj = nst; - *jcurPtr = TRUE; - DenseZero(M); - jac(n, M, tn, ypred, fpred, J_data, vtemp1, vtemp2, vtemp3); - DenseCopy(M, savedJ); - } - - /* Scale and add I to get M = I - gamma*J */ - DenseScale(-gamma, M); - DenseAddI(M); - - /* Do LU factorization of M */ - ier = DenseFactor(M, pivots); - - /* Return 0 if the LU was complete; otherwise return 1 */ - last_flag = ier; - if (ier > 0) return(1); - return(0); -} - -/* - * ----------------------------------------------------------------- - * CVDenseSolve - * ----------------------------------------------------------------- - * This routine handles the solve operation for the dense linear solver - * by calling the dense backsolve routine. The returned value is 0. - * ----------------------------------------------------------------- - */ - -static int CVDenseSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, - N_Vector ycur, N_Vector fcur) -{ - CVDenseMem cvdense_mem; - realtype *bd; - - cvdense_mem = (CVDenseMem) lmem; - - bd = N_VGetArrayPointer(b); - - DenseBacksolve(M, pivots, bd); - - /* If CV_BDF, scale the correction to account for change in gamma */ - if ((lmm == CV_BDF) && (gamrat != ONE)) { - N_VScale(TWO/(ONE + gamrat), b, b); - } - - last_flag = CVDENSE_SUCCESS; - return(0); -} - -/* - * ----------------------------------------------------------------- - * CVDenseFree - * ----------------------------------------------------------------- - * This routine frees memory specific to the dense linear solver. - * ----------------------------------------------------------------- - */ - -static void CVDenseFree(CVodeMem cv_mem) -{ - CVDenseMem cvdense_mem; - - cvdense_mem = (CVDenseMem) lmem; - - DenseFreeMat(M); - DenseFreeMat(savedJ); - DenseFreePiv(pivots); - free(cvdense_mem); -} - -/* - * ----------------------------------------------------------------- - * CVDenseDQJac - * ----------------------------------------------------------------- - * This routine generates a dense difference quotient approximation to - * the Jacobian of f(t,y). It assumes that a dense matrix of type - * DenseMat is stored column-wise, and that elements within each column - * are contiguous. The address of the jth column of J is obtained via - * the macro DENSE_COL and this pointer is associated with an N_Vector - * using the N_VGetArrayPointer/N_VSetArrayPointer functions. - * Finally, the actual computation of the jth column of the Jacobian is - * done with a call to N_VLinearSum. - * ----------------------------------------------------------------- - */ - -static void CVDenseDQJac(long int N, DenseMat J, realtype t, - N_Vector y, N_Vector fy, void *jac_data, - N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) -{ - realtype fnorm, minInc, inc, inc_inv, yjsaved, srur; - realtype *tmp2_data, *y_data, *ewt_data; - N_Vector ftemp, jthCol; - long int j; - - CVodeMem cv_mem; - CVDenseMem cvdense_mem; - - /* jac_data points to cvode_mem */ - cv_mem = (CVodeMem) jac_data; - cvdense_mem = (CVDenseMem) lmem; - - /* Save pointer to the array in tmp2 */ - tmp2_data = N_VGetArrayPointer(tmp2); - - /* Rename work vectors for readibility */ - ftemp = tmp1; - jthCol = tmp2; - - /* Obtain pointers to the data for ewt, y */ - ewt_data = N_VGetArrayPointer(ewt); - y_data = N_VGetArrayPointer(y); - - /* Set minimum increment based on uround and norm of f */ - srur = RSqrt(uround); - fnorm = N_VWrmsNorm(fy, ewt); - minInc = (fnorm != ZERO) ? - (MIN_INC_MULT * ABS(h) * uround * N * fnorm) : ONE; - - /* This is the only for loop for 0..N-1 in CVODE */ - - for (j = 0; j < N; j++) { - - /* Generate the jth col of J(tn,y) */ - - N_VSetArrayPointer(DENSE_COL(J,j), jthCol); - - yjsaved = y_data[j]; - inc = MAX(srur*ABS(yjsaved), minInc/ewt_data[j]); - y_data[j] += inc; - f(tn, y, ftemp, f_data); - y_data[j] = yjsaved; - - inc_inv = ONE/inc; - N_VLinearSum(inc_inv, ftemp, -inc_inv, fy, jthCol); - - DENSE_COL(J,j) = N_VGetArrayPointer(jthCol); - } - - /* Restore original array pointer in tmp2 */ - N_VSetArrayPointer(tmp2_data, tmp2); - - /* Increment counter nfeD */ - nfeD += N; -} diff --git a/src/sundials/cvodes/cvdense.h b/src/sundials/cvodes/cvdense.h deleted file mode 100755 index 6d6ce3bab4..0000000000 --- a/src/sundials/cvodes/cvdense.h +++ /dev/null @@ -1,192 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This is the header file for the CVODE/CVODES dense linear - * solver, CVDENSE. - * ----------------------------------------------------------------- - */ - -#ifndef _CVDENSE_H -#define _CVDENSE_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include "dense.h" -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * CVDENSE solver constants - * ----------------------------------------------------------------- - * CVD_MSBJ : maximum number of steps between dense Jacobian - * evaluations - * - * CVD_DGMAX : maximum change in gamma between dense Jacobian - * evaluations - * ----------------------------------------------------------------- - */ - -#define CVD_MSBJ 50 -#define CVD_DGMAX RCONST(0.2) - -/* - * ----------------------------------------------------------------- - * Type : CVDenseJacFn - * ----------------------------------------------------------------- - * A dense Jacobian approximation function Jac must have the - * prototype given below. Its parameters are: - * - * N is the problem size. - * - * J is the dense matrix (of type DenseMat) that will be loaded - * by a CVDenseJacFn with an approximation to the Jacobian matrix - * J = (df_i/dy_j) at the point (t,y). - * J is preset to zero, so only the nonzero elements need to be - * loaded. Two efficient ways to load J are: - * - * (1) (with macros - no explicit data structure references) - * for (j=0; j < n; j++) { - * col_j = DENSE_COL(J,j); - * for (i=0; i < n; i++) { - * generate J_ij = the (i,j)th Jacobian element - * col_j[i] = J_ij; - * } - * } - * - * (2) (without macros - explicit data structure references) - * for (j=0; j < n; j++) { - * col_j = (J->data)[j]; - * for (i=0; i < n; i++) { - * generate J_ij = the (i,j)th Jacobian element - * col_j[i] = J_ij; - * } - * } - * - * The DENSE_ELEM(A,i,j) macro is appropriate for use in small - * problems in which efficiency of access is NOT a major concern. - * - * t is the current value of the independent variable. - * - * y is the current value of the dependent variable vector, - * namely the predicted value of y(t). - * - * fy is the vector f(t,y). - * - * jac_data is a pointer to user data - the same as the jac_data - * parameter passed to CVDense. - * - * NOTE: If the user's Jacobian routine needs other quantities, - * they are accessible as follows: hcur (the current stepsize) - * and ewt (the error weight vector) are accessible through - * CVodeGetCurrentStep and CVodeGetErrWeights, respectively - * (see cvode.h). The unit roundoff is available as - * UNIT_ROUNDOFF defined in sundialstypes.h. - * - * tmp1, tmp2, and tmp3 are pointers to memory allocated for - * vectors of length N which can be used by a CVDenseJacFn - * as temporary storage or work space. - * ----------------------------------------------------------------- - */ - -typedef void (*CVDenseJacFn)(long int N, DenseMat J, realtype t, - N_Vector y, N_Vector fy, void *jac_data, - N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); - -/* - * ----------------------------------------------------------------- - * Function : CVDense - * ----------------------------------------------------------------- - * A call to the CVDense function links the main integrator with - * the CVDENSE linear solver. - * - * cvode_mem is the pointer to the integrator memory returned by - * CVodeCreate. - * - * N is the size of the ODE system. - * - * The return value of CVDense is one of: - * CVDENSE_SUCCESS if successful - * CVDENSE_MEM_NULL if the cvode memory was NULL - * CVDENSE_MEM_FAIL if there was a memory allocation failure - * CVDENSE_ILL_INPUT if a required vector operation is missing - * ----------------------------------------------------------------- - */ - -int CVDense(void *cvode_mem, long int N); - -/* - * ----------------------------------------------------------------- - * Optional inputs to the CVDENSE linear solver - * ----------------------------------------------------------------- - * - * CVDenseSetJacFn specifies the dense Jacobian approximation - * routine to be used. A user-supplied djac routine - * must be of type CVDenseJacFn. By default, a - * difference quotient routine CVDenseDQJac, supplied - * with this solver is used. - * CVDenseSetJacData specifies a pointer to user data which is - * passed to the djac routine every time it is called. - * - * The return value of CVDenseSet* is one of: - * CVDENSE_SUCCESS if successful - * CVDENSE_MEM_NULL if the cvode memory was NULL - * CVDENSE_LMEM_NULL if the cvdense memory was NULL - * ----------------------------------------------------------------- - */ - -int CVDenseSetJacFn(void *cvode_mem, CVDenseJacFn djac); -int CVDenseSetJacData(void *cvode_mem, void *jac_data); - -/* - * ----------------------------------------------------------------- - * Optional outputs from the CVDENSE linear solver - * ----------------------------------------------------------------- - * - * CVDenseGetWorkSpace returns the real and integer workspace used - * by CVDENSE. - * CVDenseGetNumJacEvals returns the number of calls made to the - * Jacobian evaluation routine djac. - * CVDenseGetNumRhsEvals returns the number of calls to the user - * f routine due to finite difference Jacobian - * evaluation. - * CVDenseGetLastFlag returns the last error flag set by any of - * the CVDENSE interface functions. - * - * The return value of CVDenseGet* is one of: - * CVDENSE_SUCCESS if successful - * CVDENSE_MEM_NULL if the cvode memory was NULL - * CVDENSE_LMEM_NULL if the cvdense memory was NULL - * ----------------------------------------------------------------- - */ - -int CVDenseGetWorkSpace(void *cvode_mem, long int *lenrwD, long int *leniwD); -int CVDenseGetNumJacEvals(void *cvode_mem, long int *njevalsD); -int CVDenseGetNumRhsEvals(void *cvode_mem, long int *nfevalsD); -int CVDenseGetLastFlag(void *cvode_mem, int *flag); - -/* CVDENSE return values */ - -#define CVDENSE_SUCCESS 0 -#define CVDENSE_MEM_NULL -1 -#define CVDENSE_LMEM_NULL -2 -#define CVDENSE_ILL_INPUT -3 -#define CVDENSE_MEM_FAIL -4 - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/cvodes/cvdense_impl.h b/src/sundials/cvodes/cvdense_impl.h deleted file mode 100755 index 2d5de24ec9..0000000000 --- a/src/sundials/cvodes/cvdense_impl.h +++ /dev/null @@ -1,82 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * Implementation header file for the dense linear solver, CVDENSE. - * ----------------------------------------------------------------- - */ - -#ifndef _CVDENSE_IMPL_H -#define _CVDENSE_IMPL_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include - -#include "cvdense.h" - -#include "dense.h" -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Types : CVDenseMemRec, CVDenseMem - * ----------------------------------------------------------------- - * The type CVDenseMem is pointer to a CVDenseMemRec. - * This structure contains CVDense solver-specific data. - * ----------------------------------------------------------------- - */ - -typedef struct { - - long int d_n; /* problem dimension */ - - CVDenseJacFn d_jac; /* jac = Jacobian routine to be called */ - - DenseMat d_M; /* M = I - gamma J, gamma = h / l1 */ - - long int *d_pivots; /* pivots = pivot array for PM = LU */ - - DenseMat d_savedJ; /* savedJ = old Jacobian */ - - long int d_nstlj; /* nstlj = nst at last Jacobian eval. */ - - long int d_nje; /* nje = no. of calls to jac */ - - long int d_nfeD; /* nfeD = no. of calls to f due to - difference quotient approximation of J */ - - void *d_J_data; /* J_data is passed to jac */ - - int d_last_flag; /* last error return flag */ - -} CVDenseMemRec, *CVDenseMem; - -/* Error Messages */ - -#define _CVDENSE_ "CVDense-- " -#define MSGDS_CVMEM_NULL _CVDENSE_ "Integrator memory is NULL.\n\n" -#define MSGDS_BAD_NVECTOR _CVDENSE_ "A required vector operation is not implemented.\n\n" -#define MSGDS_MEM_FAIL _CVDENSE_ "A memory request failed.\n\n" - -#define MSGDS_SETGET_CVMEM_NULL "CVDenseSet*/CVDenseGet*-- Integrator memory is NULL.\n\n" - -#define MSGDS_SETGET_LMEM_NULL "CVDenseSet*/CVDenseGet*-- cvdense memory is NULL.\n\n" - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/cvodes/cvdiag.c b/src/sundials/cvodes/cvdiag.c deleted file mode 100755 index 4570ea32d1..0000000000 --- a/src/sundials/cvodes/cvdiag.c +++ /dev/null @@ -1,378 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for the CVDIAG linear solver. - * ----------------------------------------------------------------- - */ - -#include -#include - -#include "cvdiag_impl.h" -#include "cvodes_impl.h" - -/* Other Constants */ - -#define FRACT RCONST(0.1) -#define ONE RCONST(1.0) - -/* CVDIAG linit, lsetup, lsolve, and lfree routines */ - -static int CVDiagInit(CVodeMem cv_mem); - -static int CVDiagSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, - N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, - N_Vector vtemp2, N_Vector vtemp3); - -static int CVDiagSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, - N_Vector ycur, N_Vector fcur); - -static void CVDiagFree(CVodeMem cv_mem); - -/* Readability Replacements */ - -#define lrw1 (cv_mem->cv_lrw1) -#define liw1 (cv_mem->cv_liw1) -#define f (cv_mem->cv_f) -#define f_data (cv_mem->cv_f_data) -#define uround (cv_mem->cv_uround) -#define tn (cv_mem->cv_tn) -#define h (cv_mem->cv_h) -#define rl1 (cv_mem->cv_rl1) -#define gamma (cv_mem->cv_gamma) -#define ewt (cv_mem->cv_ewt) -#define nfe (cv_mem->cv_nfe) -#define errfp (cv_mem->cv_errfp) -#define zn (cv_mem->cv_zn) -#define linit (cv_mem->cv_linit) -#define lsetup (cv_mem->cv_lsetup) -#define lsolve (cv_mem->cv_lsolve) -#define lfree (cv_mem->cv_lfree) -#define lmem (cv_mem->cv_lmem) -#define vec_tmpl (cv_mem->cv_tempv) -#define setupNonNull (cv_mem->cv_setupNonNull) - -#define gammasv (cvdiag_mem->di_gammasv) -#define M (cvdiag_mem->di_M) -#define bit (cvdiag_mem->di_bit) -#define bitcomp (cvdiag_mem->di_bitcomp) -#define nfeDI (cvdiag_mem->di_nfeDI) -#define last_flag (cvdiag_mem->di_last_flag) - -/* - * ----------------------------------------------------------------- - * CVDiag - * ----------------------------------------------------------------- - * This routine initializes the memory record and sets various function - * fields specific to the diagonal linear solver module. CVDense first - * calls the existing lfree routine if this is not NULL. Then it sets - * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) - * to be CVDiagInit, CVDiagSetup, CVDiagSolve, and CVDiagFree, - * respectively. It allocates memory for a structure of type - * CVDiagMemRec and sets the cv_lmem field in (*cvode_mem) to the - * address of this structure. It sets setupNonNull in (*cvode_mem) to - * TRUE. Finally, it allocates memory for M, bit, and bitcomp. - * The CVDiag return value is SUCCESS = 0, LMEM_FAIL = -1, or - * LIN_ILL_INPUT=-2. - * ----------------------------------------------------------------- - */ - -int CVDiag(void *cvode_mem) -{ - CVodeMem cv_mem; - CVDiagMem cvdiag_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGDG_CVMEM_NULL); - return(CVDIAG_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - /* Check if N_VCompare and N_VInvTest are present */ - if(vec_tmpl->ops->nvcompare == NULL || - vec_tmpl->ops->nvinvtest == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDG_BAD_NVECTOR); - return(CVDIAG_ILL_INPUT); - } - - if (lfree != NULL) lfree(cv_mem); - - /* Set four main function fields in cv_mem */ - linit = CVDiagInit; - lsetup = CVDiagSetup; - lsolve = CVDiagSolve; - lfree = CVDiagFree; - - /* Get memory for CVDiagMemRec */ - cvdiag_mem = (CVDiagMem) malloc(sizeof(CVDiagMemRec)); - if (cvdiag_mem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDG_MEM_FAIL); - return(CVDIAG_MEM_FAIL); - } - - last_flag = CVDIAG_SUCCESS; - - /* Set flag setupNonNull = TRUE */ - setupNonNull = TRUE; - - /* Allocate memory for M, bit, and bitcomp */ - - M = N_VClone(vec_tmpl); - if (M == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDG_MEM_FAIL); - return(CVDIAG_MEM_FAIL); - } - bit = N_VClone(vec_tmpl); - if (bit == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDG_MEM_FAIL); - N_VDestroy(M); - return(CVDIAG_MEM_FAIL); - } - bitcomp = N_VClone(vec_tmpl); - if (bitcomp == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDG_MEM_FAIL); - N_VDestroy(M); - N_VDestroy(bit); - return(CVDIAG_MEM_FAIL); - } - - /* Attach linear solver memory to integrator memory */ - lmem = cvdiag_mem; - - return(CVDIAG_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVDiagGetWorkSpace - * ----------------------------------------------------------------- - */ - -int CVDiagGetWorkSpace(void *cvode_mem, long int *lenrwDI, long int *leniwDI) -{ - CVodeMem cv_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGDG_SETGET_CVMEM_NULL); - return(CVDIAG_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - *lenrwDI = 3*lrw1; - *leniwDI = 3*liw1; - - return(CVDIAG_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVDiagGetNumRhsEvals - * ----------------------------------------------------------------- - */ - -int CVDiagGetNumRhsEvals(void *cvode_mem, long int *nfevalsDI) -{ - CVodeMem cv_mem; - CVDiagMem cvdiag_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGDG_SETGET_CVMEM_NULL); - return(CVDIAG_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDG_SETGET_LMEM_NULL); - return(CVDIAG_LMEM_NULL); - } - cvdiag_mem = (CVDiagMem) lmem; - - *nfevalsDI = nfeDI; - - return(CVDIAG_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVDiagGetLastFlag - * ----------------------------------------------------------------- - */ - -int CVDiagGetLastFlag(void *cvode_mem, int *flag) -{ - CVodeMem cv_mem; - CVDiagMem cvdiag_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGDG_SETGET_CVMEM_NULL); - return(CVDIAG_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGDG_SETGET_LMEM_NULL); - return(CVDIAG_LMEM_NULL); - } - cvdiag_mem = (CVDiagMem) lmem; - - *flag = last_flag; - - return(CVDIAG_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVDiagInit - * ----------------------------------------------------------------- - * This routine does remaining initializations specific to the diagonal - * linear solver. - * ----------------------------------------------------------------- - */ - -static int CVDiagInit(CVodeMem cv_mem) -{ - CVDiagMem cvdiag_mem; - - cvdiag_mem = (CVDiagMem) lmem; - - nfeDI = 0; - - last_flag = CVDIAG_SUCCESS; - return(0); -} - -/* - * ----------------------------------------------------------------- - * CVDiagSetup - * ----------------------------------------------------------------- - * This routine does the setup operations for the diagonal linear - * solver. It constructs a diagonal approximation to the Newton matrix - * M = I - gamma*J, updates counters, and inverts M. - * ----------------------------------------------------------------- - */ - -static int CVDiagSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, - N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, - N_Vector vtemp2, N_Vector vtemp3) -{ - realtype r; - N_Vector ftemp, y; - booleantype invOK; - CVDiagMem cvdiag_mem; - - cvdiag_mem = (CVDiagMem) lmem; - - /* Rename work vectors for use as temporary values of y and f */ - ftemp = vtemp1; - y = vtemp2; - - /* Form y with perturbation = FRACT*(func. iter. correction) */ - r = FRACT * rl1; - N_VLinearSum(h, fpred, -ONE, zn[1], ftemp); - N_VLinearSum(r, ftemp, ONE, ypred, y); - - /* Evaluate f at perturbed y */ - f(tn, y, M, f_data); - nfeDI++; - - /* Construct M = I - gamma*J with J = diag(deltaf_i/deltay_i) */ - N_VLinearSum(ONE, M, -ONE, fpred, M); - N_VLinearSum(FRACT, ftemp, -h, M, M); - N_VProd(ftemp, ewt, y); - /* Protect against deltay_i being at roundoff level */ - N_VCompare(uround, y, bit); - N_VAddConst(bit, -ONE, bitcomp); - N_VProd(ftemp, bit, y); - N_VLinearSum(FRACT, y, -ONE, bitcomp, y); - N_VDiv(M, y, M); - N_VProd(M, bit, M); - N_VLinearSum(ONE, M, -ONE, bitcomp, M); - - /* Invert M with test for zero components */ - invOK = N_VInvTest(M, M); - if (!invOK) { - last_flag = CVDIAG_INV_FAIL; - return(1); - } - - /* Set jcur = TRUE, save gamma in gammasv, and return */ - *jcurPtr = TRUE; - gammasv = gamma; - last_flag = CVDIAG_SUCCESS; - return(0); -} - -/* - * ----------------------------------------------------------------- - * CVDiagSolve - * ----------------------------------------------------------------- - * This routine performs the solve operation for the diagonal linear - * solver. If necessary it first updates gamma in M = I - gamma*J. - * ----------------------------------------------------------------- - */ - -static int CVDiagSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, - N_Vector ycur, N_Vector fcur) -{ - booleantype invOK; - realtype r; - CVDiagMem cvdiag_mem; - - cvdiag_mem = (CVDiagMem) lmem; - - /* If gamma has changed, update factor in M, and save gamma value */ - - if (gammasv != gamma) { - r = gamma / gammasv; - N_VInv(M, M); - N_VAddConst(M, -ONE, M); - N_VScale(r, M, M); - N_VAddConst(M, ONE, M); - invOK = N_VInvTest(M, M); - if (!invOK) { - last_flag = CVDIAG_INV_FAIL; - return (1); - } - gammasv = gamma; - } - - /* Apply M-inverse to b */ - N_VProd(b, M, b); - - last_flag = CVDIAG_SUCCESS; - return(0); -} - -/* - * ----------------------------------------------------------------- - * CVDiagFree - * ----------------------------------------------------------------- - * This routine frees memory specific to the diagonal linear solver. - * ----------------------------------------------------------------- - */ - -static void CVDiagFree(CVodeMem cv_mem) -{ - CVDiagMem cvdiag_mem; - - cvdiag_mem = (CVDiagMem) lmem; - - N_VDestroy(M); - N_VDestroy(bit); - N_VDestroy(bitcomp); - free(cvdiag_mem); -} diff --git a/src/sundials/cvodes/cvdiag.h b/src/sundials/cvodes/cvdiag.h deleted file mode 100755 index 89cccebf5e..0000000000 --- a/src/sundials/cvodes/cvdiag.h +++ /dev/null @@ -1,91 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This is the header file for the CVODE/CVODES diagonal linear - * solver, CVDIAG. - * ----------------------------------------------------------------- - */ - -#ifndef _CVDIAG_H -#define _CVDIAG_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include - -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Function : CVDiag - * ----------------------------------------------------------------- - * A call to the CVDiag function links the main integrator with - * the CVDIAG linear solver. - * - * cvode_mem is the pointer to the integrator memory returned by - * CVodeCreate. - * - * The return value of CVDiag is one of: - * CVDIAG_SUCCESS if successful - * CVDIAG_MEM_NULL if the cvode memory was NULL - * CVDIAG_MEM_FAIL if there was a memory allocation failure - * CVDIAG_ILL_INPUT if a required vector operation is missing - * ----------------------------------------------------------------- - */ - -int CVDiag(void *cvode_mem); - -/* - * ----------------------------------------------------------------- - * Optional outputs from the CVDIAG linear solver - * ----------------------------------------------------------------- - * - * CVDiagGetWorkSpace returns the real and integer workspace used - * by CVDIAG. - * CVDiagGetNumRhsEvals returns the number of calls to the user - * f routine due to finite difference Jacobian - * evaluation. - * Note: The number of diagonal approximate - * Jacobians formed is equal to the number of - * CVDiagSetup calls. This number is available - * through CVodeGetNumLinSolvSetups. - * CVDiagGetLastFlag returns the last error flag set by any of - * the CVDIAG interface functions. - * - * The return value of CVDiagGet* is one of: - * CVDIAG_SUCCESS if successful - * CVDIAG_MEM_NULL if the cvode memory was NULL - * CVDIAG_LMEM_NULL if the cvdiag memory was NULL - * ----------------------------------------------------------------- - */ - -int CVDiagGetWorkSpace(void *cvode_mem, long int *lenrwDI, long int *leniwDI); -int CVDiagGetNumRhsEvals(void *cvode_mem, long int *nfevalsDI); -int CVDiagGetLastFlag(void *cvode_mem, int *flag); - -#define CVDIAG_SUCCESS 0 -#define CVDIAG_MEM_NULL -1 -#define CVDIAG_LMEM_NULL -2 -#define CVDIAG_ILL_INPUT -3 -#define CVDIAG_MEM_FAIL -4 - -#define CVDIAG_INV_FAIL 1 - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/cvodes/cvdiag_impl.h b/src/sundials/cvodes/cvdiag_impl.h deleted file mode 100755 index a585df2312..0000000000 --- a/src/sundials/cvodes/cvdiag_impl.h +++ /dev/null @@ -1,74 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * Implementation header file for the diagonal linear solver, CVDIAG. - * ----------------------------------------------------------------- - */ - -#ifndef _CVDIAG_IMPL_H -#define _CVDIAG_IMPL_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include - -#include "cvdiag.h" - -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Types: CVDiagMemRec, CVDiagMem - * ----------------------------------------------------------------- - * The type CVDiagMem is pointer to a CVDiagMemRec. - * This structure contains CVDiag solver-specific data. - * ----------------------------------------------------------------- - */ - -typedef struct { - - realtype di_gammasv; /* gammasv = gamma at the last call to setup */ - /* or solve */ - - N_Vector di_M; /* M = (I - gamma J)^{-1} , gamma = h / l1 */ - - N_Vector di_bit; /* temporary storage vector */ - - N_Vector di_bitcomp; /* temporary storage vector */ - - long int di_nfeDI; /* no. of calls to f due to difference - quotient diagonal Jacobian approximation */ - - int di_last_flag; /* last error return flag */ - -} CVDiagMemRec, *CVDiagMem; - -/* Error Messages */ - -#define _CVDIAG_ "CVDiag-- " -#define MSGDG_CVMEM_NULL _CVDIAG_ "Integrator memory is NULL.\n\n" -#define MSGDG_BAD_NVECTOR _CVDIAG_ "A required vector operation is not implemented.\n\n" -#define MSGDG_MEM_FAIL _CVDIAG_ "A memory request failed.\n\n" - -#define MSGDG_SETGET_CVMEM_NULL "CVDiagGet*-- Integrator memory is NULL.\n\n" - -#define MSGDG_SETGET_LMEM_NULL "CVDiagGet*-- cvdiag memory is NULL.\n\n" - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/cvodes/cvodea.c b/src/sundials/cvodes/cvodea.c deleted file mode 100755 index d7e82454fa..0000000000 --- a/src/sundials/cvodes/cvodea.c +++ /dev/null @@ -1,2119 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for the CVODEA adjoint integrator. - * ----------------------------------------------------------------- - */ - -/*=================================================================*/ -/*BEGIN Import Header Files */ -/*=================================================================*/ - -#include -#include - -#include "cvdiag.h" -#include "cvodea_impl.h" -#include "sundialsmath.h" -#include "sundialstypes.h" - -/*=================================================================*/ -/*BEGIN Macros */ -/*=================================================================*/ - -/* Macro: loop */ - -#define loop for(;;) - -/*=================================================================*/ -/*BEGIN CVODEA Private Constants */ -/*=================================================================*/ - -#define ZERO RCONST(0.0) /* real 0.0 */ -#define ONE RCONST(1.0) /* real 1.0 */ -#define TWO RCONST(2.0) /* real 2.0 */ -#define FUZZ_FACTOR RCONST(1000000.0) /* fuzz factor for CVadjGetY */ - -/*=================================================================*/ -/*BEGIN Private Functions Prototypes */ -/*=================================================================*/ - -static CkpntMem CVAckpntInit(CVodeMem cv_mem); -static CkpntMem CVAckpntNew(CVodeMem cv_mem); -static void CVAckpntDelete(CkpntMem *ck_memPtr); - -static DtpntMem *CVAdataMalloc(CVodeMem cv_mem, long int steps); -static void CVAdataFree(DtpntMem *dt_mem, long int steps); - -static int CVAdataStore(CVadjMem ca_mem, CkpntMem ck_mem); -static int CVAckpntGet(CVodeMem cv_mem, CkpntMem ck_mem); -static void CVAhermitePrepare(CVadjMem ca_mem, DtpntMem *dt_mem, long int i); -static void CVAhermiteInterpolate(CVadjMem ca_mem, DtpntMem *dt_mem, - long int i, realtype t, N_Vector y); - -/* Wrappers */ - -static void CVArhs(realtype t, N_Vector yB, - N_Vector yBdot, void *cvadj_mem); -static void CVAdenseJac(long int nB, DenseMat JB, realtype t, - N_Vector yB, N_Vector fyB, void *cvadj_mem, - N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); -static void CVAbandJac(long int nB, long int mupperB, - long int mlowerB, BandMat JB, realtype t, - N_Vector yB, N_Vector fyB, void *cvadj_mem, - N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); -static int CVAspgmrPrecSetup(realtype t, N_Vector yB, - N_Vector fyB, booleantype jokB, - booleantype *jcurPtrB, realtype gammaB, - void *cvadj_mem, - N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); -static int CVAspgmrPrecSolve(realtype t, N_Vector yB, N_Vector fyB, - N_Vector rB, N_Vector zB, - realtype gammaB, realtype deltaB, - int lrB, void *cvadj_mem, N_Vector tmpB); -static int CVAspgmrJacTimesVec(N_Vector vB, N_Vector JvB, realtype t, - N_Vector yB, N_Vector fyB, - void *cvadj_mem, N_Vector tmpB); -static void CVArhsQ(realtype t, N_Vector yB, - N_Vector qBdot, void *cvadj_mem); - -static void CVAgloc(long int NlocalB, realtype t, N_Vector yB, N_Vector gB, - void *cvadj_mem); - -static void CVAcfn(long int NlocalB, realtype t, N_Vector yB, - void *cvadj_mem); - -/*=================================================================*/ -/*END Private Functions Prototypes */ -/*=================================================================*/ - -/*=================================================================*/ -/*BEGIN Readibility Constants */ -/*=================================================================*/ - -#define uround (ca_mem->ca_uround) -#define tinitial (ca_mem->ca_tinitial) -#define tfinal (ca_mem->ca_tfinal) -#define nckpnts (ca_mem->ca_nckpnts) -#define nsteps (ca_mem->ca_nsteps) -#define ckpntData (ca_mem->ca_ckpntData) -#define newData (ca_mem->ca_newData) -#define np (ca_mem->ca_np) -#define delta (ca_mem->ca_delta) -#define Y0 (ca_mem->ca_Y0) -#define Y1 (ca_mem->ca_Y1) -#define ytmp (ca_mem->ca_ytmp) -#define f_B (ca_mem->ca_fB) -#define f_data_B (ca_mem->ca_f_dataB) -#define djac_B (ca_mem->ca_djacB) -#define bjac_B (ca_mem->ca_bjacB) -#define jtimes_B (ca_mem->ca_jtimesB) -#define jac_data_B (ca_mem->ca_jac_dataB) -#define pset_B (ca_mem->ca_psetB) -#define psolve_B (ca_mem->ca_psolveB) -#define P_data_B (ca_mem->ca_P_dataB) -#define fQ_B (ca_mem->ca_fQB) -#define fQ_data_B (ca_mem->ca_fQ_dataB) -#define gloc_B (ca_mem->ca_glocB) -#define cfn_B (ca_mem->ca_cfnB) -#define bbd_data_B (ca_mem->ca_bbd_dataB) -#define bp_data_B (ca_mem->ca_bp_dataB) -#define t_for_quad (ca_mem->ca_t_for_quad) - -#define zn (cv_mem->cv_zn) -#define nst (cv_mem->cv_nst) -#define q (cv_mem->cv_q) -#define qprime (cv_mem->cv_qprime) -#define qwait (cv_mem->cv_qwait) -#define L (cv_mem->cv_L) -#define gammap (cv_mem->cv_gammap) -#define h (cv_mem->cv_h) -#define hprime (cv_mem->cv_hprime) -#define hscale (cv_mem->cv_hscale) -#define eta (cv_mem->cv_eta) -#define etamax (cv_mem->cv_etamax) -#define tn (cv_mem->cv_tn) -#define tau (cv_mem->cv_tau) -#define tq (cv_mem->cv_tq) -#define l (cv_mem->cv_l) -#define saved_tq5 (cv_mem->cv_saved_tq5) -#define forceSetup (cv_mem->cv_forceSetup) -#define f (cv_mem->cv_f) -#define lmm (cv_mem->cv_lmm) -#define iter (cv_mem->cv_iter) -#define itol (cv_mem->cv_itol) -#define reltol (cv_mem->cv_reltol) -#define abstol (cv_mem->cv_abstol) -#define f_data (cv_mem->cv_f_data) -#define errfp (cv_mem->cv_errfp) -#define h0u (cv_mem->cv_h0u) -#define quadr (cv_mem->cv_quadr) -#define errconQ (cv_mem->cv_errconQ) -#define znQ (cv_mem->cv_znQ) -#define itolQ (cv_mem->cv_itolQ) -#define reltolQ (cv_mem->cv_reltolQ) -#define abstolQ (cv_mem->cv_abstolQ) -#define fQ (cv_mem->cv_fQ) -#define tempv (cv_mem->cv_tempv) -#define tempvQ (cv_mem->cv_tempvQ) - -#define t0_ (ck_mem->ck_t0) -#define t1_ (ck_mem->ck_t1) -#define zn_ (ck_mem->ck_zn) -#define znQ_ (ck_mem->ck_znQ) -#define quadr_ (ck_mem->ck_quadr) -#define zqm_ (ck_mem->ck_zqm) -#define nst_ (ck_mem->ck_nst) -#define q_ (ck_mem->ck_q) -#define qprime_ (ck_mem->ck_qprime) -#define qwait_ (ck_mem->ck_qwait) -#define L_ (ck_mem->ck_L) -#define gammap_ (ck_mem->ck_gammap) -#define h_ (ck_mem->ck_h) -#define hprime_ (ck_mem->ck_hprime) -#define hscale_ (ck_mem->ck_hscale) -#define eta_ (ck_mem->ck_eta) -#define etamax_ (ck_mem->ck_etamax) -#define tau_ (ck_mem->ck_tau) -#define tq_ (ck_mem->ck_tq) -#define l_ (ck_mem->ck_l) -#define saved_tq5_ (ck_mem->ck_saved_tq5) -#define next_ (ck_mem->ck_next) - -/*=================================================================*/ -/*END Readibility Constants */ -/*=================================================================*/ - -/*=================================================================*/ -/*BEGIN Exported Functions */ -/*=================================================================*/ - -/*------------------ CVadjMalloc --------------------------*/ -/* - This routine allocates space for the global CVODEA memory - structure. -*/ -/*-----------------------------------------------------------------*/ - -void *CVadjMalloc(void *cvode_mem, long int steps) -{ - CVadjMem ca_mem; - CVodeMem cv_mem; - - /* Check arguments */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGAM_NO_MEM); - return(NULL); - } - if (steps <= 0) { - fprintf(stderr, MSGAM_BAD_STEPS); - return(NULL); - } - - /* Allocate memory block */ - ca_mem = (CVadjMem) malloc(sizeof(struct CVadjMemRec)); - if (ca_mem == NULL) { - fprintf(stderr, MSGAM_MEM_FAIL); - return(NULL); - } - - /* Attach CVODE memory for forward runs */ - cv_mem = (CVodeMem)cvode_mem; - ca_mem->cv_mem = cv_mem; - - /* Initialize Check Points linked list */ - ca_mem->ck_mem = CVAckpntInit(cv_mem); - if (ca_mem->ck_mem == NULL) { - free(ca_mem); - fprintf(stderr, MSGAM_MEM_FAIL); - return(NULL); - } - - /* Allocate Data Points memory */ - ca_mem->dt_mem = CVAdataMalloc(cv_mem, steps); - if (ca_mem->dt_mem == NULL) { - CVAckpntDelete(&(ca_mem->ck_mem)); - free(ca_mem); - fprintf(stderr, MSGAM_MEM_FAIL); - return(NULL); - } - - /* Workspace memory */ - Y0 = N_VClone(tempv); - if (Y0 == NULL) { - CVAdataFree(ca_mem->dt_mem, steps); - CVAckpntDelete(&(ca_mem->ck_mem)); - free(ca_mem); - fprintf(stderr, MSGAM_MEM_FAIL); - return(NULL); - } - - Y1 = N_VClone(tempv); - if (Y1 == NULL) { - N_VDestroy(Y0); - CVAdataFree(ca_mem->dt_mem, steps); - CVAckpntDelete(&(ca_mem->ck_mem)); - free(ca_mem); - fprintf(stderr, MSGAM_MEM_FAIL); - return(NULL); - } - - ytmp = N_VClone(tempv); - if (ytmp == NULL) { - N_VDestroy(Y0); - N_VDestroy(Y1); - CVAdataFree(ca_mem->dt_mem, steps); - CVAckpntDelete(&(ca_mem->ck_mem)); - free(ca_mem); - fprintf(stderr, MSGAM_MEM_FAIL); - return(NULL); - } - - /* Other entries in ca_mem */ - uround = cv_mem->cv_uround; - nsteps = steps; - tinitial = tn; - - /* Initialize nckpnts to ZERO */ - nckpnts = 0; - - /* Initialize backward cvode memory to NULL */ - ca_mem->cvb_mem = NULL; - - ca_mem->ca_f_dataB = NULL; - ca_mem->ca_fQ_dataB = NULL; - ca_mem->ca_jac_dataB = NULL; - ca_mem->ca_P_dataB = NULL; - ca_mem->ca_bp_dataB = NULL; - ca_mem->ca_bbd_dataB = NULL; - - - return((void *)ca_mem); -} - -/*=================================================================*/ -/*BEGIN Wrappers for CVODEA */ -/*=================================================================*/ - -/*------------------ CVodeF --------------------------*/ -/* - This routine integrates to tout and returns solution into yout. - In the same time, it stores check point data every 'steps' steps. - - CVodeF can be called repeatedly by the user. - - ncheckPtr points to the number of check points stored so far. -*/ -/*-----------------------------------------------------------------*/ - -int CVodeF(void *cvadj_mem, realtype tout, N_Vector yout, - realtype *tret, int itask, int *ncheckPtr) -{ - CVadjMem ca_mem; - CVodeMem cv_mem; - CkpntMem tmp; - DtpntMem *dt_mem; - int cv_itask, flag; - booleantype iret, istop; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - cv_mem = ca_mem->cv_mem; - dt_mem = ca_mem->dt_mem; - - iret = TRUE; - cv_itask = CV_ONE_STEP; - - /* Interpret itask */ - switch (itask) { - case CV_NORMAL: - iret = FALSE; - istop = FALSE; - cv_itask = CV_ONE_STEP; - break; - case CV_ONE_STEP: - iret = TRUE; - istop = FALSE; - cv_itask = CV_ONE_STEP; - break; - case CV_NORMAL_TSTOP: - iret = FALSE; - istop = TRUE; - cv_itask = CV_ONE_STEP_TSTOP; - break; - case CV_ONE_STEP_TSTOP: - iret = TRUE; - istop = TRUE; - cv_itask = CV_ONE_STEP_TSTOP; - break; - } - - /* On the first step, load dt_mem[0] */ - if ( nst == 0) { - dt_mem[0]->t = ca_mem->ck_mem->ck_t0; - N_VScale(ONE, ca_mem->ck_mem->ck_zn[0], dt_mem[0]->y); - N_VScale(ONE, ca_mem->ck_mem->ck_zn[1], dt_mem[0]->yd); - } - - /* Integrate to tout (in CV_ONE_STEP mode) while loading check points */ - - loop { - - /* Perform one step of the integration */ - - flag = CVode(cv_mem, tout, yout, tret, cv_itask); - if (flag < 0) break; - - /* Test if a new check point is needed */ - - if ( nst % nsteps == 0 ) { - - ca_mem->ck_mem->ck_t1 = *tret; - - /* Create a new check point, load it, and append it to the list */ - tmp = CVAckpntNew(cv_mem); - if (tmp == NULL) { - flag = CV_MEM_FAIL; - break; - } - tmp->ck_next = ca_mem->ck_mem; - ca_mem->ck_mem = tmp; - nckpnts++; - forceSetup = TRUE; - - /* Reset i=0 and load dt_mem[0] */ - dt_mem[0]->t = ca_mem->ck_mem->ck_t0; - N_VScale(ONE, ca_mem->ck_mem->ck_zn[0], dt_mem[0]->y); - N_VScale(ONE, ca_mem->ck_mem->ck_zn[1], dt_mem[0]->yd); - - } else { - - /* Load next point in dt_mem */ - dt_mem[nst%nsteps]->t = *tret; - N_VScale(ONE, yout, dt_mem[nst%nsteps]->y); - CVodeGetDky(cv_mem, *tret, 1, dt_mem[nst%nsteps]->yd); - - } - - /* Set t1 field of the current ckeck point structure - for the case in which there will be no future - check points */ - ca_mem->ck_mem->ck_t1 = *tret; - - /* tfinal is now set to *tret */ - tfinal = *tret; - - /* Return if in CV_ONE_STEP mode */ - if (iret) - break; - - /* Return if tout reached */ - if ( (*tret - tout)*h >= ZERO ) { - *tret = tout; - CVodeGetDky(cv_mem, tout, 0, yout); - break; - } - - } /* end of loop() */ - - /* Get ncheck from ca_mem */ - *ncheckPtr = nckpnts; - - /* Data is available for the last interval */ - newData = TRUE; - ckpntData = ca_mem->ck_mem; - np = nst % nsteps + 1; - - return(flag); - -} - -/*-- CVodeCreateB, CVodeSet*B, CVodeMallocB, and CVodeReInitB -----*/ -/*-----------------------------------------------------------------*/ - -int CVodeCreateB(void *cvadj_mem, int lmmB, int iterB) -{ - CVadjMem ca_mem; - void *cvode_mem; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - - ca_mem = (CVadjMem) cvadj_mem; - - cvode_mem = CVodeCreate(lmmB, iterB); - - if (cvode_mem == NULL) return(CV_MEM_FAIL); - - ca_mem->cvb_mem = (CVodeMem) cvode_mem; - - return(CV_SUCCESS); - -} - -/*-----------------------------------------------------------------*/ - -int CVodeSetIterTypeB(void *cvadj_mem, int iterB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - cvode_mem = (void *)ca_mem->cvb_mem; - - flag = CVodeSetIterType(cvode_mem, iterB); - - return(flag); -} - -int CVodeSetFdataB(void *cvadj_mem, void *f_dataB) -{ - CVadjMem ca_mem; - - ca_mem = (CVadjMem) cvadj_mem; - - f_data_B = f_dataB; - - return(CV_SUCCESS); -} - -int CVodeSetErrFileB(void *cvadj_mem, FILE *errfpB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - cvode_mem = (void *)ca_mem->cvb_mem; - - flag = CVodeSetErrFile(cvode_mem, errfpB); - - return(flag); -} - -int CVodeSetMaxOrdB(void *cvadj_mem, int maxordB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - cvode_mem = (void *)ca_mem->cvb_mem; - - flag = CVodeSetMaxOrd(cvode_mem, maxordB); - - return(flag); -} - - -int CVodeSetMaxNumStepsB(void *cvadj_mem, long int mxstepsB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - cvode_mem = (void *)ca_mem->cvb_mem; - - flag = CVodeSetMaxNumSteps(cvode_mem, mxstepsB); - - return(flag); -} - -int CVodeSetStabLimDetB(void *cvadj_mem, booleantype stldetB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - cvode_mem = (void *)ca_mem->cvb_mem; - - flag = CVodeSetStabLimDet(cvode_mem, stldetB); - - return(flag); -} - -int CVodeSetInitStepB(void *cvadj_mem, realtype hinB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - cvode_mem = (void *)ca_mem->cvb_mem; - - flag = CVodeSetInitStep(cvode_mem, hinB); - - return(flag); -} - -int CVodeSetMinStepB(void *cvadj_mem, realtype hminB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - cvode_mem = (void *)ca_mem->cvb_mem; - - flag = CVodeSetMinStep(cvode_mem, hminB); - - return(flag); -} - -int CVodeSetMaxStepB(void *cvadj_mem, realtype hmaxB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - cvode_mem = (void *)ca_mem->cvb_mem; - - flag = CVodeSetMaxStep(cvode_mem, hmaxB); - - return(flag); -} - - -/*-----------------------------------------------------------------*/ - -int CVodeMallocB(void *cvadj_mem, CVRhsFnB fB, - realtype tB0, N_Vector yB0, - int itolB, realtype *reltolB, void *abstolB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int sign, flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - - ca_mem = (CVadjMem) cvadj_mem; - - sign = (tfinal - tinitial > ZERO) ? 1 : -1; - if ( (sign*(tB0-tinitial) < ZERO) || (sign*(tfinal-tB0) < ZERO) ) - return(CV_BAD_TB0); - - f_B = fB; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVodeMalloc(cvode_mem, CVArhs, tB0, yB0, - itolB, reltolB, abstolB); - - if (flag != CV_SUCCESS) return(flag); - - CVodeSetMaxHnilWarns(cvode_mem, -1); - CVodeSetFdata(cvode_mem, cvadj_mem); - - return(CV_SUCCESS); - -} - -/*-----------------------------------------------------------------*/ - -int CVodeReInitB(void *cvadj_mem, CVRhsFnB fB, - realtype tB0, N_Vector yB0, - int itolB, realtype *reltolB, void *abstolB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int sign, flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - - ca_mem = (CVadjMem) cvadj_mem; - - sign = (tfinal - tinitial > ZERO) ? 1 : -1; - if ( (sign*(tB0-tinitial) < ZERO) || (sign*(tfinal-tB0) < ZERO) ) - return(CV_BAD_TB0); - - f_B = fB; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVodeReInit(cvode_mem, CVArhs, tB0, yB0, - itolB, reltolB, abstolB); - - if (flag != CV_SUCCESS) return(flag); - - CVodeSetMaxHnilWarns(cvode_mem, -1); - CVodeSetFdata(cvode_mem, cvadj_mem); - - return(CV_SUCCESS); - -} - -/*-- CVodeSetQuad*B, CVodeQuadMallocB, and CVodeQuadReInitB -------*/ -/*-----------------------------------------------------------------*/ - -int CVodeSetQuadErrConB(void *cvadj_mem, booleantype errconQB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - cvode_mem = (void *)ca_mem->cvb_mem; - - flag = CVodeSetQuadErrCon(cvode_mem, errconQB); - - return(flag); -} - -int CVodeSetQuadFdataB(void *cvadj_mem, void *fQ_dataB) -{ - CVadjMem ca_mem; - - ca_mem = (CVadjMem) cvadj_mem; - - fQ_data_B = fQ_dataB; - - return(CV_SUCCESS); -} - -int CVodeSetQuadTolerancesB(void *cvadj_mem, int itolQB, - realtype *reltolQB, void *abstolQB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - cvode_mem = (void *)ca_mem->cvb_mem; - - flag = CVodeSetQuadTolerances(cvode_mem, itolQB, reltolQB, abstolQB); - - return(flag); -} - -/*-----------------------------------------------------------------*/ - -int CVodeQuadMallocB(void *cvadj_mem, CVQuadRhsFnB fQB, N_Vector yQB0) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - - ca_mem = (CVadjMem) cvadj_mem; - - fQ_B = fQB; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVodeQuadMalloc(cvode_mem, CVArhsQ, yQB0); - if (flag != CV_SUCCESS) return(flag); - - flag = CVodeSetQuadFdata(cvode_mem, cvadj_mem); - - return(flag); - -} - -/*-----------------------------------------------------------------*/ - -int CVodeQuadReInitB(void *cvadj_mem, CVQuadRhsFnB fQB, N_Vector yQB0) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - - ca_mem = (CVadjMem) cvadj_mem; - - fQ_B = fQB; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVodeQuadReInit(cvode_mem, CVArhsQ, yQB0); - - return(flag); - -} - -/*--------- CVDenseB and CVdenseSet*B -------------------------*/ -/*-----------------------------------------------------------------*/ - -int CVDenseB(void *cvadj_mem, long int nB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVDense(cvode_mem, nB); - - return(flag); -} - -int CVDenseSetJacFnB(void *cvadj_mem, CVDenseJacFnB djacB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - djac_B = djacB; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVDenseSetJacData(cvode_mem, cvadj_mem); - if (flag != CVDENSE_SUCCESS) return(flag); - - CVDenseSetJacFn(cvode_mem, CVAdenseJac); - - return(CVDENSE_SUCCESS); -} - -int CVDenseSetJacDataB(void *cvadj_mem, void *jac_dataB) -{ - CVadjMem ca_mem; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - jac_data_B = jac_dataB; - - return(CVDENSE_SUCCESS); -} - -/*----------------- CVDiagB -----------------------------------*/ -/*-----------------------------------------------------------------*/ - -int CVDiagB(void *cvadj_mem) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVDiag(cvode_mem); - - return(flag); -} - -/*----------- CVBandB and CVBandSet*B -----------------------*/ -/*-----------------------------------------------------------------*/ - -int CVBandB(void *cvadj_mem, long int nB, - long int mupperB, long int mlowerB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVBand(cvode_mem, nB, mupperB, mlowerB); - - return(flag); -} - -int CVBandSetJacFnB(void *cvadj_mem, CVBandJacFnB bjacB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - bjac_B = bjacB; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVBandSetJacData(cvode_mem, cvadj_mem); - if (flag != CVBAND_SUCCESS) return(flag); - - CVBandSetJacFn(cvode_mem, CVAbandJac); - - return(CVBAND_SUCCESS); -} - -int CVBandSetJacDataB(void *cvadj_mem, void *jac_dataB) -{ - CVadjMem ca_mem; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - jac_data_B = jac_dataB; - - return(CVBAND_SUCCESS); -} - -/*------------ CVSpgmrB and CVSpgmrSet*B ---------------------*/ -/*-----------------------------------------------------------------*/ -int CVSpgmrB(void *cvadj_mem, int pretypeB, int maxlB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVSpgmr(cvode_mem, pretypeB, maxlB); - - return(flag); -} - -int CVSpgmrSetPrecTypeB(void *cvadj_mem, int pretypeB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVSpgmrSetPrecType(cvode_mem, pretypeB); - - return(flag); -} - -int CVSpgmrSetGSTypeB(void *cvadj_mem, int gstypeB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVSpgmrSetGSType(cvode_mem,gstypeB); - - return(flag); -} - -int CVSpgmrSetDeltB(void *cvadj_mem, realtype deltB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVSpgmrSetDelt(cvode_mem,deltB); - - return(flag); -} - -int CVSpgmrSetPrecSetupFnB(void *cvadj_mem, CVSpgmrPrecSetupFnB psetB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - pset_B = psetB; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVSpgmrSetPrecData(cvode_mem, cvadj_mem); - if (flag != CVSPGMR_SUCCESS) return(flag); - - CVSpgmrSetPrecSetupFn(cvode_mem, CVAspgmrPrecSetup); - - return(CVSPGMR_SUCCESS); -} - -int CVSpgmrSetPrecSolveFnB(void *cvadj_mem, CVSpgmrPrecSolveFnB psolveB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - psolve_B = psolveB; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVSpgmrSetPrecData(cvode_mem, cvadj_mem); - if (flag != CVSPGMR_SUCCESS) return(flag); - - CVSpgmrSetPrecSolveFn(cvode_mem, CVAspgmrPrecSolve); - - return(CVSPGMR_SUCCESS); -} - -int CVSpgmrSetJacTimesVecFnB(void *cvadj_mem, CVSpgmrJacTimesVecFnB jtimesB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - jtimes_B = jtimesB; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVSpgmrSetJacData(cvode_mem, cvadj_mem); - if (flag != CVSPGMR_SUCCESS) return(flag); - - CVSpgmrSetJacTimesVecFn(cvode_mem, CVAspgmrJacTimesVec); - - return(CVSPGMR_SUCCESS); -} - -int CVSpgmrSetPrecDataB(void *cvadj_mem, void *P_dataB) -{ - CVadjMem ca_mem; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - P_data_B = P_dataB; - - return(CVSPGMR_SUCCESS); -} - -int CVSpgmrSetJacDataB(void *cvadj_mem, void *jac_dataB) -{ - CVadjMem ca_mem; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - jac_data_B = jac_dataB; - - return(CVSPGMR_SUCCESS); -} - -/*- CVBandPrecAllocB, CVBPSpgmrB, CVBandPrecFreeB -*/ -/*----------------------------------------------------------------------*/ - -int CVBandPrecAllocB(void *cvadj_mem, long int nB, - long int muB, long int mlB) -{ - CVadjMem ca_mem; - void *cvode_mem; - void *bp_dataB; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - cvode_mem = (void *) ca_mem->cvb_mem; - - bp_dataB = CVBandPrecAlloc(cvode_mem, nB, muB, mlB); - - if (bp_dataB == NULL) return(CV_PDATA_NULL); - - bp_data_B = bp_dataB; - - return(CV_SUCCESS); - -} - -/*-----------------------------------------------------------------*/ - -int CVBPSpgmrB(void *cvadj_mem, int pretypeB, int maxlB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVBPSpgmr(cvode_mem, pretypeB, maxlB, bp_data_B); - - return(flag); -} - -/*- CVBBDPrecAllocB, CVBPSpgmrB, CVBandPrecFreeB -*/ -/*----------------------------------------------------------------------*/ - -int CVBBDPrecAllocB(void *cvadj_mem, long int NlocalB, - long int mudqB, long int mldqB, - long int mukeepB, long int mlkeepB, - realtype dqrelyB, - CVLocalFnB glocB, CVCommFnB cfnB) -{ - CVadjMem ca_mem; - void *cvode_mem; - void *bbd_dataB; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - cvode_mem = (void *) ca_mem->cvb_mem; - - gloc_B = glocB; - cfn_B = cfnB; - - bbd_dataB = CVBBDPrecAlloc(cvode_mem, NlocalB, - mudqB, mldqB, - mukeepB, mlkeepB, - dqrelyB, - CVAgloc, CVAcfn); - - if (bbd_dataB == NULL) return(CV_PDATA_NULL); - - bbd_data_B = bbd_dataB; - - return(CV_SUCCESS); - -} - -int CVBBDSpgmrB(void *cvadj_mem, int pretypeB, int maxlB) -{ - - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVBBDSpgmr(cvode_mem, pretypeB, maxlB, bbd_data_B); - - return(flag); - -} - -int CVBBDPrecReInitB(void *cvadj_mem, long int mudqB, long int mldqB, - realtype dqrelyB, CVLocalFnB glocB, CVCommFnB cfnB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - cvode_mem = (void *) ca_mem->cvb_mem; - - gloc_B = glocB; - cfn_B = cfnB; - - flag = CVBBDPrecReInit(bbd_data_B, mudqB, mldqB, - dqrelyB, CVAgloc, CVAcfn); - - return(flag); -} - -/*------------------ CVodeB --------------------------*/ -/* - This routine performs the backward integration towards tBout. - When necessary, it performs a forward integration between two - consecutive check points to update interpolation data. - itask can be CV_NORMAL or CV_ONE_STEP only. -*/ -/*-----------------------------------------------------------------*/ - -int CVodeB(void *cvadj_mem, realtype tBout, N_Vector yBout, - realtype *tBret, int itaskB) -{ - CVadjMem ca_mem; - CkpntMem ck_mem; - CVodeMem cvb_mem; - int sign, flag, cv_itask; - realtype tBn; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - - cvb_mem = ca_mem->cvb_mem; - if (cvb_mem == NULL) return(CV_BCKMEM_NULL); - - if (itaskB == CV_NORMAL) - cv_itask = CV_NORMAL_TSTOP; - else if (itaskB == CV_ONE_STEP) - cv_itask = CV_ONE_STEP_TSTOP; - else - return(CV_BAD_ITASK); - - ck_mem = ca_mem->ck_mem; - - sign = (tfinal - tinitial > ZERO) ? 1 : -1; - - if ( (sign*(tBout-tinitial) < ZERO) || (sign*(tfinal-tBout) < ZERO) ) - return(CV_BAD_TBOUT); - - tBn = cvb_mem->cv_tn; - while ( sign*(tBn - t0_) <= ZERO ) ck_mem = next_; - - loop { - - /* Store interpolation data if not available */ - if (ck_mem != ckpntData) { - flag = CVAdataStore(ca_mem, ck_mem); - if (flag != CV_SUCCESS) return(flag); - } - - /* Backward integration */ - CVodeSetStopTime((void *)cvb_mem, t0_); - flag = CVode(cvb_mem, tBout, yBout, tBret, cv_itask); - - /* If an error occured, return now */ - if (flag < 0) return(flag); - - /* Set the time at which CVodeGetQuadB will evaluate any quadratures */ - t_for_quad = *tBret; - - /* If in CV_ONE_STEP mode, return now (flag=CV_SUCCESS or flag=CV_TSTOP_RETURN) */ - if (itaskB == CV_ONE_STEP) return(flag); - - /* If succesfully reached tBout, return now */ - if (*tBret == tBout) return(flag); - - /* Move check point in linked list to next one */ - ck_mem = next_; - - } - - - return(CV_SUCCESS); - -} - -/*------------------ CVodeGetQuadB ------------------------------*/ -/*-----------------------------------------------------------------*/ - -int CVodeGetQuadB(void *cvadj_mem, N_Vector qB) -{ - CVadjMem ca_mem; - void *cvode_mem; - int flag; - - if (cvadj_mem == NULL) return(CV_ADJMEM_NULL); - ca_mem = (CVadjMem) cvadj_mem; - cvode_mem = (void *) ca_mem->cvb_mem; - - flag = CVodeGetQuad(cvode_mem, t_for_quad, qB); - - return(flag); -} - -/*=================================================================*/ -/*END Wrappers for CVODEA */ -/*=================================================================*/ - -/*------------------ CVAdjFree --------------------------*/ -/* - This routine frees the memory allocated by CVadjMalloc. -*/ -/*-----------------------------------------------------------------*/ - -void CVadjFree(void *cvadj_mem) -{ - CVadjMem ca_mem; - - ca_mem = (CVadjMem) cvadj_mem; - - /* Delete check points one by one */ - while (ca_mem->ck_mem != NULL) { - CVAckpntDelete(&(ca_mem->ck_mem)); - } - - /* Free vectors at each data point */ - CVAdataFree(ca_mem->dt_mem, nsteps); - free(ca_mem->dt_mem); - - /* Free vectors in ca_mem */ - N_VDestroy(Y0); - N_VDestroy(Y1); - N_VDestroy(ytmp); - - /* Free CVODES memory for backward run */ - CVodeFree(ca_mem->cvb_mem); - - /* Free preconditioner data (the routines below check for non-NULL data) */ - CVBandPrecFree(bp_data_B); - CVBBDPrecFree(bbd_data_B); - - /* Free CVODEA memory */ - free(ca_mem); - -} - -/*------------------ CVadjGetCVodeBmem --------------------------*/ -/* - CVadjGetCVodeBmem returns a (void *) pointer to the CVODES - memory allocated for the backward problem. This pointer can - then be used to call any of the CVodeGet* CVODES routines to - extract optional output for the backward integration phase. -*/ -/*-----------------------------------------------------------------*/ - -void *CVadjGetCVodeBmem(void *cvadj_mem) -{ - CVadjMem ca_mem; - void *cvode_mem; - - if (cvadj_mem == NULL) return(NULL); - ca_mem = (CVadjMem) cvadj_mem; - cvode_mem = (void *) ca_mem->cvb_mem; - - return(cvode_mem); -} - -/*------------------ CVAdjGetY --------------------------*/ -/* - This routine uses cubic piece-wise Hermite interpolation for - the forward solution vector. - It is typically called by the wrapper routines before calling - user provided routines (fB, djacB, bjacB, jtimesB, psolB) but - can be directly called by the user if memory for the bacward - run is allocated through CVODE calls and not through CVODEA - calls. -*/ -/*-----------------------------------------------------------------*/ - -int CVadjGetY(void *cvadj_mem, realtype t, N_Vector y) -{ - CVadjMem ca_mem; - DtpntMem *dt_mem; - static long int i; - long int inew; - int sign; - booleantype to_left, to_right; - realtype troundoff; - - ca_mem = (CVadjMem) cvadj_mem; - dt_mem = ca_mem->dt_mem; - - sign = (tfinal - tinitial > ZERO) ? 1 : -1; - - if ( newData ) { - i = np-1; - CVAhermitePrepare(ca_mem, dt_mem, i); - newData = FALSE; - } - - /* Search for inew starting from last i */ - to_left = ( sign*(t - dt_mem[i-1]->t) < ZERO); - to_right = ( sign*(t - dt_mem[i]->t) > ZERO); - - /* Test if t is beyond left limit */ - if ( (to_left) && (i==1) ) { - /*troundoff = FUZZ_FACTOR*uround*(ABS(dt_mem[0]->t)+ABS(dt_mem[1]->t));*/ - troundoff = FUZZ_FACTOR*uround; - if ( ABS(t - dt_mem[0]->t) <= troundoff ) { - N_VScale(ONE, dt_mem[0]->y, y); - return(CV_SUCCESS); - } - else { - printf("\n TROUBLE IN GETY\n "); -#if defined(SUNDIALS_EXTENDED_PRECISION) - printf("%Lg = ABS(t-dt_mem[0]->t) > troundoff = %Lg uround = %Lg\n", - ABS(t - dt_mem[0]->t), troundoff, uround); -#elif defined(SUNDIALS_DOUBLE_PRECISION) - printf("%lg = ABS(t-dt_mem[0]->t) > troundoff = %lg uround = %lg\n", - ABS(t - dt_mem[0]->t), troundoff, uround); -#else - printf("%g = ABS(t-dt_mem[0]->t) > troundoff = %g uround = %g\n", - ABS(t - dt_mem[0]->t), troundoff, uround); -#endif - return(CV_GETY_BADT); - } - } - - inew = i; - if ( to_left ) { - /* Search to the left */ - inew--; - loop { - if ( inew == 1 ) break; - if ( sign*(t - dt_mem[inew-1]->t) <= ZERO) inew--; - else break; - } - } else if ( to_right ) { - /* Search to the right */ - inew++; - loop { - if ( sign*(t - dt_mem[inew]->t) > ZERO) inew++; - else break; - } - } - - if ( inew != i ) - CVAhermitePrepare(ca_mem, dt_mem, inew); - - CVAhermiteInterpolate(ca_mem, dt_mem, inew, t, y); - - i = inew; - - return(CV_SUCCESS); - -} - -/*------------------ CVAdjGetCheckPointsList ---------------------*/ -/* - This routine lists the linked list of check point structures. - For debugging.... -*/ -/*-----------------------------------------------------------------*/ - -void CVadjGetCheckPointsList(void *cvadj_mem) -{ - CVadjMem ca_mem; - CkpntMem ck_mem; - int i; - - ca_mem = (CVadjMem) cvadj_mem; - ck_mem = ca_mem->ck_mem; - i = 0; - - while (ck_mem != NULL) { -#if defined(SUNDIALS_EXTENDED_PRECISION) - printf("%2d addr: %p time = [ %9.3Le %9.3Le ] next: %p\n", - nckpnts-i, (void *)ck_mem, t0_, t1_, (void *)next_ ); -#elif defined(SUNDIALS_DOUBLE_PRECISION) - printf("%2d addr: %p time = [ %9.3le %9.3le ] next: %p\n", - nckpnts-i, (void *)ck_mem, t0_, t1_, (void *)next_ ); -#else - printf("%2d addr: %p time = [ %9.3e %9.3e ] next: %p\n", - nckpnts-i, (void *)ck_mem, t0_, t1_, (void *)next_ ); -#endif - ck_mem = next_; - i++; - } - -} - -/*------------------ CVAdjGetStoredData ------------------------*/ -/* - This routine returns the solution stored in the data structure - at the 'which' data point. - For debugging.... -*/ -/*-----------------------------------------------------------------*/ - -void CVadjGetStoredData(void *cvadj_mem, long int which, - realtype *t, N_Vector yout, N_Vector ydout) -{ - CVadjMem ca_mem; - DtpntMem *dt_mem; - - ca_mem = (CVadjMem) cvadj_mem; - dt_mem = ca_mem->dt_mem; - - *t = dt_mem[which]->t; - - if (yout != NULL) - N_VScale(ONE, dt_mem[which]->y, yout); - - if (ydout != NULL) - N_VScale(ONE, dt_mem[which]->yd, ydout); - -} - -/*=================================================================*/ -/*BEGIN Exported Functions */ -/*=================================================================*/ - -/*=================================================================*/ -/*BEGIN Private Functions Implementation */ -/*=================================================================*/ - -/*------------------ CVAckpntInit --------------------------*/ -/* - This routine initializes the check point linked list with - information from the initial time. -*/ -/*-----------------------------------------------------------------*/ - -static CkpntMem CVAckpntInit(CVodeMem cv_mem) -{ - CkpntMem ck_mem; - - /* Allocate space for ckdata */ - ck_mem = (CkpntMem) malloc(sizeof(struct CkpntMemRec)); - - zn_[0] = N_VClone(tempv); - zn_[1] = N_VClone(tempv); - - /* zn_[qmax] was not allocated */ - zqm_ = 0; - - /* Load ckdata from cv_mem */ - N_VScale(ONE, zn[0], zn_[0]); - t0_ = tn; - q_ = 1; - /* Compute zn_[1] by calling the user f routine */ - f(t0_, zn_[0], zn_[1], f_data); - - /* Do we need to carry quadratures */ - quadr_ = quadr && errconQ; - - if (quadr_) { - znQ_[0] = N_VClone(tempvQ); - N_VScale(ONE, znQ[0], znQ_[0]); - } - - /* Next in list */ - next_ = NULL; - - return(ck_mem); -} - -/*------------------ CVAckpntNew --------------------------*/ -/* - This routine allocates space for a new check point and sets - its data from current values in cv_mem. -*/ -/*-----------------------------------------------------------------*/ - -static CkpntMem CVAckpntNew(CVodeMem cv_mem) -{ - CkpntMem ck_mem; - int j; - int qmax; - - /* Allocate space for ckdata */ - ck_mem = (CkpntMem) malloc(sizeof(struct CkpntMemRec)); - if (ck_mem == NULL) return(NULL); - - /* Test if we need to allocate space for the last zn. - NOTE: zn(qmax) may be needed for a hot restart, if an order - increase is deemed necessary at the first step after a check - point */ - qmax = cv_mem->cv_qmax; - zqm_ = (q < qmax) ? qmax : 0; - - for (j=0; j<=q; j++) { - zn_[j] = N_VClone(tempv); - if(zn_[j] == NULL) return(NULL); - } - - if ( q < qmax) { - zn_[qmax] = N_VClone(tempv); - if ( zn_[qmax] == NULL ) return(NULL); - } - - /* Test if we need to carry quadratures */ - quadr_ = quadr && errconQ; - - if (quadr_) { - for (j=0; j<=q; j++) { - znQ_[j] = N_VClone(tempvQ); - if(znQ_[j] == NULL) return(NULL); - } - - if ( q < qmax) { - znQ_[qmax] = N_VClone(tempvQ); - if ( znQ_[qmax] == NULL ) return(NULL); - } - } - - /* Load check point data from cv_mem */ - - for (j=0; j<=q; j++) N_VScale(ONE, zn[j], zn_[j]); - if ( q < qmax ) N_VScale(ONE, zn[qmax], zn_[qmax]); - - if(quadr_) { - for (j=0; j<=q; j++) N_VScale(ONE, znQ[j], znQ_[j]); - if ( q < qmax ) N_VScale(ONE, znQ[qmax], znQ_[qmax]); - } - - for (j=0; j<=L_MAX; j++) tau_[j] = tau[j]; - for (j=0; j<=NUM_TESTS; j++) tq_[j] = tq[j]; - for (j=0; j<=q; j++) l_[j] = l[j]; - nst_ = nst; - q_ = q; - qprime_ = qprime; - qwait_ = qwait; - L_ = L; - gammap_ = gammap; - h_ = h; - hprime_ = hprime; - hscale_ = hscale; - eta_ = eta; - etamax_ = etamax; - t0_ = tn; - saved_tq5_ = saved_tq5; - - return(ck_mem); -} - -/*------------------ CVAckpntDelete --------------------------*/ -/* - This routine deletes the first check point in list. -*/ -/*-----------------------------------------------------------------*/ - -static void CVAckpntDelete(CkpntMem *ck_memPtr) -{ - CkpntMem tmp; - int j; - - if (*ck_memPtr != NULL) { - - /* store head of list */ - tmp = *ck_memPtr; - - /* move head of list */ - *ck_memPtr = (*ck_memPtr)->ck_next; - - /* free N_Vectors in tmp */ - for (j=0;j<=tmp->ck_q;j++) N_VDestroy(tmp->ck_zn[j]); - if (tmp->ck_zqm != 0) N_VDestroy(tmp->ck_zn[tmp->ck_zqm]); - - /* free N_Vectors for quadratures in tmp - Note that at the check point at t_initial, only znQ_[0] - was allocated*/ - if(tmp->ck_quadr) { - if(tmp->ck_next != NULL) { - for (j=0;j<=tmp->ck_q;j++) N_VDestroy(tmp->ck_znQ[j]); - if (tmp->ck_zqm != 0) N_VDestroy(tmp->ck_znQ[tmp->ck_zqm]); - } else { - N_VDestroy(tmp->ck_znQ[0]); - } - } - - free(tmp); - - } - -} - -/*------------------ CVAdataMalloc --------------------------*/ -/* - This routine allocates memory for storing information at all - intermediate points between two consecutive check points. - This data is then used to interpolate the forward solution - at any other time. -*/ -/*-----------------------------------------------------------------*/ - -static DtpntMem *CVAdataMalloc(CVodeMem cv_mem, long int steps) -{ - DtpntMem *dt_mem; - long int i; - - dt_mem = (DtpntMem *)malloc((steps+1)*sizeof(struct DtpntMemRec *)); - - for (i=0; i<=steps; i++) { - dt_mem[i] = (DtpntMem)malloc(sizeof(struct DtpntMemRec)); - dt_mem[i]->y = N_VClone(tempv); - dt_mem[i]->yd = N_VClone(tempv); - } - - return(dt_mem); - -} - -/*------------------ CVAdataFree --------------------------*/ -/* - This routine frees the memeory allocated for data storage. -*/ -/*-----------------------------------------------------------------*/ - -static void CVAdataFree(DtpntMem *dt_mem, long int steps) -{ - long int i; - - for (i=0; i<=steps; i++) { - N_VDestroy(dt_mem[i]->y); - N_VDestroy(dt_mem[i]->yd); - free(dt_mem[i]); - } - -} - -/*------------------ CVAdataStore --------------------------*/ -/* - This routine integrates the forward model starting at the check - point ck_mem and stores y and yprime at all intermediate steps. - - Return values: - CV_SUCCESS - CV_REIFWD_FAIL - CV_FWD_FAIL -*/ -/*-----------------------------------------------------------------*/ - -int CVAdataStore(CVadjMem ca_mem, CkpntMem ck_mem) -{ - CVodeMem cv_mem; - DtpntMem *dt_mem; - realtype t; - long int i; - int flag; - - cv_mem = ca_mem->cv_mem; - dt_mem = ca_mem->dt_mem; - - /* Initialize cv_mem with data from ck_mem */ - flag = CVAckpntGet(cv_mem, ck_mem); - if (flag != CV_SUCCESS) return(CV_REIFWD_FAIL); - - /* Set first structure in dt_mem[0] */ - dt_mem[0]->t = t0_; - N_VScale(ONE, zn_[0], dt_mem[0]->y); - N_VScale(ONE, zn_[1], dt_mem[0]->yd); - - /* Run CVode to set following structures in dt_mem[i] */ - - i = 1; - do { - flag = CVode(cv_mem, t1_, dt_mem[i]->y, &t, CV_ONE_STEP); - if (flag < 0) return(CV_FWD_FAIL); - dt_mem[i]->t = t; - flag = CVodeGetDky(cv_mem, t, 1, dt_mem[i]->yd); - if (flag != CV_SUCCESS) return(CV_FWD_FAIL); - i++; - } while (tcv_qmax; - - /* Copy parameters from check point data structure */ - nst = nst_; - q = q_; - qprime = qprime_; - qwait = qwait_; - L = L_; - gammap = gammap_; - h = h_; - hprime = hprime_; - hscale = hscale_; - eta = eta_; - etamax = etamax_; - tn = t0_; - saved_tq5 = saved_tq5_; - - /* Copy the arrays from check point data structure */ - for (j=0; j<=q; j++) N_VScale(ONE, zn_[j], zn[j]); - if ( q < qmax ) N_VScale(ONE, zn_[qmax], zn[qmax]); - if(quadr_) { - for (j=0; j<=q; j++) N_VScale(ONE, znQ_[j], znQ[j]); - if ( q < qmax ) N_VScale(ONE, znQ_[qmax], znQ[qmax]); - } - for (j=0; j<=L_MAX; j++) tau[j] = tau_[j]; - for (j=0; j<=NUM_TESTS; j++) tq[j] = tq_[j]; - for (j=0; j<=q; j++) l[j] = l_[j]; - - /* Force a call to setup */ - forceSetup = TRUE; - - } - - return(CV_SUCCESS); -} - -/*------------------ CVAhermitePrepare --------------------------*/ -/* - This routine computes quantities required by the Hermite - interpolation that are independent of the interpolation point. -*/ -/*-----------------------------------------------------------------*/ - -static void CVAhermitePrepare(CVadjMem ca_mem, DtpntMem *dt_mem, long int i) -{ - realtype t0, t1; - N_Vector y0, y1, yd0, yd1; - - t0 = dt_mem[i-1]->t; - y0 = dt_mem[i-1]->y; - yd0 = dt_mem[i-1]->yd; - - t1 = dt_mem[i]->t; - y1 = dt_mem[i]->y; - yd1 = dt_mem[i]->yd; - - delta = t1 - t0; - - N_VLinearSum(ONE, y1, -ONE, y0, Y0); - N_VLinearSum(ONE, yd1, ONE, yd0, Y1); - N_VLinearSum(delta, Y1, -TWO, Y0, Y1); - N_VLinearSum(ONE, Y0, -delta, yd0, Y0); -} - -/*------------------ CVAhermiteInterpolate ----------------------*/ -/* - This routine performs the Hermite interpolation. -*/ -/*-----------------------------------------------------------------*/ - -static void CVAhermiteInterpolate(CVadjMem ca_mem, DtpntMem *dt_mem, - long int i, realtype t, N_Vector y) -{ - realtype t0, t1; - N_Vector y0, yd0; - realtype factor; - - t0 = dt_mem[i-1]->t; - t1 = dt_mem[i]->t; - y0 = dt_mem[i-1]->y; - yd0 = dt_mem[i-1]->yd; - - factor = t - t0; - N_VLinearSum(ONE, y0, factor, yd0, y); - - factor = factor/delta; - factor = factor*factor; - N_VLinearSum(ONE, y, factor, Y0, y); - - factor = factor*(t-t1)/delta; - N_VLinearSum(ONE, y, factor, Y1, y); -} - -/*=================================================================*/ -/*BEGIN Wrappers for adjoint system */ -/*=================================================================*/ - -/*------------------ CVArhs --------------------------*/ -/* - This routine interfaces to the CVRhsFnB routine provided by - the user. - NOTE: f_data actually contains cvadj_mem -*/ -/*-----------------------------------------------------------------*/ - -static void CVArhs(realtype t, N_Vector yB, - N_Vector yBdot, void *cvadj_mem) -{ - CVadjMem ca_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - - /* Forward solution from Hermite interpolation */ - flag = CVadjGetY(ca_mem, t, ytmp); - if (flag != CV_SUCCESS) { - printf("\n\nBad t in interpolation\n\n"); - exit(1); - } - - /* Call user's adjoint RHS routine */ - f_B(t, ytmp, yB, yBdot, f_data_B); - -} - -/*------------------ CVArhsQ --------------------------*/ -/* - This routine interfaces to the CVQuadRhsFnB routine provided by - the user. - NOTE: fQ_data actually contains cvadj_mem -*/ -/*-----------------------------------------------------------------*/ - -static void CVArhsQ(realtype t, N_Vector yB, - N_Vector qBdot, void *cvadj_mem) -{ - CVadjMem ca_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - - /* Forward solution from Hermite interpolation */ - flag = CVadjGetY(ca_mem, t, ytmp); - if (flag != CV_SUCCESS) { - printf("\n\nBad t in interpolation\n\n"); - exit(1); - } - - /* Call user's adjoint RHS routine */ - fQ_B(t, ytmp, yB, qBdot, fQ_data_B); - -} - -/*------------------ CVAdenseJac --------------------------*/ -/* - This routine interfaces to the CVDenseJacFnB routine provided - by the user. - NOTE: jac_data actually contains cvadj_mem -*/ -/*-----------------------------------------------------------------*/ - -static void CVAdenseJac(long int nB, DenseMat JB, realtype t, - N_Vector yB, N_Vector fyB, void *cvadj_mem, - N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) -{ - CVadjMem ca_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - - /* Forward solution from Hermite interpolation */ - flag = CVadjGetY(ca_mem, t, ytmp); - if (flag != CV_SUCCESS) { - printf("\n\nBad t in interpolation\n\n"); - exit(1); - } - - /* Call user's adjoint dense djacB routine */ - djac_B(nB, JB, t, ytmp, yB, fyB, jac_data_B, - tmp1B, tmp2B, tmp3B); - -} - -/*------------------ CVAbandJac --------------------------*/ -/* - This routine interfaces to the CVBandJacFnB routine provided - by the user. - NOTE: jac_data actually contains cvadj_mem -*/ -/*-----------------------------------------------------------------*/ - -static void CVAbandJac(long int nB, long int mupperB, - long int mlowerB, BandMat JB, realtype t, - N_Vector yB, N_Vector fyB, void *cvadj_mem, - N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) -{ - CVadjMem ca_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - - /* Forward solution from Hermite interpolation */ - flag = CVadjGetY(ca_mem, t, ytmp); - if (flag != CV_SUCCESS) { - printf("\n\nBad t in interpolation\n\n"); - exit(1); - } - - /* Call user's adjoint band bjacB routine */ - bjac_B(nB, mupperB, mlowerB, JB, t, ytmp, yB, fyB, jac_data_B, - tmp1B, tmp2B, tmp3B); - -} - -/*------------------ CVAspgmrPrecSetup ------------------------*/ -/* - This routine interfaces to the CVSpgmrPrecSetupFnB routine - provided by the user. - NOTE: p_data actually contains cvadj_mem -*/ -/*-----------------------------------------------------------------*/ - -static int CVAspgmrPrecSetup(realtype t, N_Vector yB, - N_Vector fyB, booleantype jokB, - booleantype *jcurPtrB, realtype gammaB, - void *cvadj_mem, - N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) -{ - CVadjMem ca_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - - /* Forward solution from Hermite interpolation */ - flag = CVadjGetY(ca_mem, t, ytmp); - if (flag != CV_SUCCESS) { - printf("\n\nBad t in interpolation\n\n"); - exit(1); - } - - /* Call user's adjoint precondB routine */ - flag = pset_B(t, ytmp, yB, fyB, jokB, jcurPtrB, gammaB, - P_data_B, tmp1B, tmp2B, tmp3B); - - return(flag); -} - -/*---------------- CVAspgmrPrecSolve -------------------------*/ -/* - This routine interfaces to the CVSpgmrPrecSolveFnB routine - provided by the user. - NOTE: p_data actually contains cvadj_mem -*/ -/*-----------------------------------------------------------------*/ - -static int CVAspgmrPrecSolve(realtype t, N_Vector yB, N_Vector fyB, - N_Vector rB, N_Vector zB, - realtype gammaB, realtype deltaB, - int lrB, void *cvadj_mem, N_Vector tmpB) -{ - CVadjMem ca_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - - /* Forward solution from Hermite interpolation */ - flag = CVadjGetY(ca_mem, t, ytmp); - if (flag != CV_SUCCESS) { - printf("\n\nBad t in interpolation\n\n"); - exit(1); - } - - /* Call user's adjoint psolveB routine */ - flag = psolve_B(t, ytmp, yB, fyB, rB, zB, gammaB, deltaB, - lrB, P_data_B, tmpB); - - return(flag); -} - -/*------------------ CVAspgmrJacTimesVec ---------------------*/ -/* - This routine interfaces to the CVSpgmrJacTimesVecFnB routine - provided by the user. - NOTE: jac_data actually contains cvadj_mem -*/ -/*-----------------------------------------------------------------*/ - -static int CVAspgmrJacTimesVec(N_Vector vB, N_Vector JvB, realtype t, - N_Vector yB, N_Vector fyB, - void *cvadj_mem, N_Vector tmpB) -{ - CVadjMem ca_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - - /* Forward solution from Hermite interpolation */ - flag = CVadjGetY(ca_mem, t, ytmp); - if (flag != CV_SUCCESS) { - printf("\n\nBad t in interpolation\n\n"); - exit(1); - } - - /* Call user's adjoint jtimesB routine */ - flag = jtimes_B(vB, JvB, t, ytmp, yB, fyB, jac_data_B, tmpB); - - return(flag); -} - -/*------------------- CVAgloc --------------------------------*/ -/* - This routine interfaces to the CVLocalFnB routine - provided by the user. - NOTE: f_data actually contains cvadj_mem -*/ -/*-----------------------------------------------------------------*/ - -static void CVAgloc(long int NlocalB, realtype t, N_Vector yB, N_Vector gB, - void *cvadj_mem) -{ - CVadjMem ca_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - - /* Forward solution from Hermite interpolation */ - flag = CVadjGetY(ca_mem, t, ytmp); - if (flag != CV_SUCCESS) { - printf("\n\nBad t in interpolation\n\n"); - exit(1); - } - - /* Call user's adjoint glocB routine */ - gloc_B(NlocalB, t, ytmp, yB, gB, f_data_B); - -} - -/*------------------- CVAcfn ---------------------------------*/ -/* - This routine interfaces to the CVCommFnB routine - provided by the user. - NOTE: f_data actually contains cvadj_mem -*/ -/*-----------------------------------------------------------------*/ - -static void CVAcfn(long int NlocalB, realtype t, N_Vector yB, - void *cvadj_mem) -{ - CVadjMem ca_mem; - int flag; - - ca_mem = (CVadjMem) cvadj_mem; - - /* Forward solution from Hermite interpolation */ - flag = CVadjGetY(ca_mem, t, ytmp); - if (flag != CV_SUCCESS) { - printf("\n\nBad t in interpolation\n\n"); - exit(1); - } - - /* Call user's adjoint cfnB routine */ - if(cfn_B != NULL) - cfn_B(NlocalB, t, ytmp, yB, f_data_B); - -} - - -/*=================================================================*/ -/*END Wrappers for adjoint system */ -/*=================================================================*/ - -/*=================================================================*/ -/*END Private Functions Implementation */ -/*=================================================================*/ diff --git a/src/sundials/cvodes/cvodea.h b/src/sundials/cvodes/cvodea.h deleted file mode 100755 index a0c5da0491..0000000000 --- a/src/sundials/cvodes/cvodea.h +++ /dev/null @@ -1,449 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This is the interface file for the CVODEA adjoint integrator. - * - * Function types: - * CVRhsFnB - * CVQuadRhsFnB - * CVDenseJacFnB - * CVBandJacFnB - * CVSpgmrPrecSetupFnB - * CVSpgmrPrecSolveB - * CVSpgmrJacTimesVecFnB - * Exported functions prototypes: - * CVadjMalloc - * CVodeF - * CVodeCreateB - * CVodeMallocB - * CVDenseB - * CVBandB - * CVSpgmrB - * CVBandPrecAllocB - * CVBPSpgmrB - * CVBBDPrecAllocB - * CVBBDPrecReInit - * CVBBDSpgmrB - * CVodeB - * CVadjFree - * CVadjGetY - * CVadjCheckPointsList - * CVadjDataExtract - * Type definitions: - * struct CkpntMemRec, CkpntMem - * struct DtpntMemRec, DtpntMem - * struct CVadjMemRec, CVadjMem - * ----------------------------------------------------------------- - */ - -#ifndef _CVODEA_H -#define _CVODEA_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include - -#include "dense.h" -#include "band.h" -#include "spgmr.h" -#include "sundialstypes.h" -#include "nvector.h" - -/* - * ----------------------------------------------------------------- - * Type : CVRhsFnB - * ----------------------------------------------------------------- - * The fB function which defines the right hand side of the - * ODE systems to be integrated backwards must have type CVRhsFnB. - * ----------------------------------------------------------------- - */ - -typedef void (*CVRhsFnB)(realtype t, N_Vector y, - N_Vector yB, N_Vector yBdot, - void *f_dataB); - -/* - * ----------------------------------------------------------------- - * Type : CVQuadRhsFnB - * ----------------------------------------------------------------- - * The fQB function which defines the quadratures to be integrated - * backwards must have type CVQuadRhsFnB. - * ----------------------------------------------------------------- - */ - -typedef void (*CVQuadRhsFnB)(realtype t, N_Vector y, - N_Vector yB, N_Vector qBdot, - void *fQ_dataB); - -/* - * ----------------------------------------------------------------- - * Type : CVDenseJacFnB - * ----------------------------------------------------------------- - * A dense Jacobian approximation function djacB for the backward - * integration must have the prototype given below. - * ----------------------------------------------------------------- - */ - -typedef void (*CVDenseJacFnB)(long int nB, DenseMat JB, realtype t, - N_Vector y, N_Vector yB, N_Vector fyB, - void *jac_dataB, N_Vector tmp1B, - N_Vector tmp2B, N_Vector tmp3B); - -/* - * ----------------------------------------------------------------- - * Type : CVBandJacFnB - * ----------------------------------------------------------------- - * A band Jacobian approximation function bjacB for the backward - * integration must have the prototype given below. - * ----------------------------------------------------------------- - */ - -typedef void (*CVBandJacFnB)(long int nB, long int mupperB, - long int mlowerB, BandMat JB, - realtype t, N_Vector y, - N_Vector yB, N_Vector fyB, - void *jac_dataB, N_Vector tmp1B, - N_Vector tmp2B, N_Vector tmp3B); - -/* - * ----------------------------------------------------------------- - * Type : CVSpgmrPrecSetupFnB - * ----------------------------------------------------------------- - * A preconditioner setup function precondB for the backward - * integration must have the prototype given below. - * ----------------------------------------------------------------- - */ - -typedef int (*CVSpgmrPrecSetupFnB)(realtype t, N_Vector y, - N_Vector yB, N_Vector fyB, - booleantype jokB, - booleantype *jcurPtrB, realtype gammaB, - void *P_dataB, - N_Vector tmp1B, N_Vector tmp2B, - N_Vector tmp3B); - -/* - * ----------------------------------------------------------------- - * Type : CVSpgmrPrecSolveFnB - * ----------------------------------------------------------------- - * A preconditioner solve function psolveB for the backward - * integration must have the prototype given below. - * ----------------------------------------------------------------- - */ - -typedef int (*CVSpgmrPrecSolveFnB)(realtype t, N_Vector y, - N_Vector yB, N_Vector fyB, - N_Vector rB, N_Vector zB, - realtype gammaB, realtype deltaB, - int lrB, void *P_dataB, N_Vector tmpB); - -/* - * ----------------------------------------------------------------- - * Type : CVSpgmrJacTimesVecFnB - * ----------------------------------------------------------------- - * A Jacobian times vector function jtimesB for the backward - * integration must have the prototype given below. - * ----------------------------------------------------------------- - */ - -typedef int (*CVSpgmrJacTimesVecFnB)(N_Vector vB, N_Vector JvB, realtype t, - N_Vector y, N_Vector yB, N_Vector fyB, - void *jac_dataB, N_Vector tmpB); - -/* - * ----------------------------------------------------------------- - * Type : CVLocalFnB and CVCommFnB - * ----------------------------------------------------------------- - * Local approximation function and inter-process communication - * function for the BBD preconditioner on the backward phase. - * ----------------------------------------------------------------- - */ - -typedef void (*CVLocalFnB)(long int NlocalB, realtype t, - N_Vector y, N_Vector yB, N_Vector gB, - void *f_dataB); - -typedef void (*CVCommFnB)(long int NlocalB, realtype t, - N_Vector y, N_Vector yB, - void *f_dataB); - -/* - * ----------------------------------------------------------------- - * Function : CVadjMalloc - * ----------------------------------------------------------------- - * CVadjMalloc space for the global CVODEA memory structure. - * ----------------------------------------------------------------- - */ - -void *CVadjMalloc(void *cvode_mem, long int steps); - -/* - * ----------------------------------------------------------------- - * Function : CVodeF - * ----------------------------------------------------------------- - * CVodeF integrates towards tout and returns solution into yout. - * In the same time, it stores check point data every 'steps'. - * - * CVodeF can be called repeatedly by the user. - * - * ncheckPtr points to the number of check points stored so far. - * - * Return values: - * SUCCESS - * CVADJ_MEM_FAIL - * any CVode return value - * ----------------------------------------------------------------- - */ - -int CVodeF(void *cvadj_mem, realtype tout, N_Vector yout, - realtype *tret, int itask, int *ncheckPtr); - -/* - * ----------------------------------------------------------------- - * Function : CVodeCreateB, CVodeMallocB, CVodeSet*B - * ----------------------------------------------------------------- - * These functions are just wrappers around the corresponding - * functions in cvodes.h, with some particularizations for the - * backward integration. - * ----------------------------------------------------------------- - */ - -int CVodeCreateB(void *cvadj_mem, int lmmB, int iterB); - -int CVodeSetIterTypeB(void *cvadj_mem, int iterB); - -int CVodeSetFdataB(void *cvadj_mem, void *f_dataB); -int CVodeSetErrFileB(void *cvadj_mem, FILE *errfpB); -int CVodeSetMaxOrdB(void *cvadj_mem, int maxordB); -int CVodeSetMaxNumStepsB(void *cvadj_mem, long int mxstepsB); -int CVodeSetStabLimDetB(void *cvadj_mem, booleantype stldetB); -int CVodeSetInitStepB(void *cvadj_mem, realtype hinB); -int CVodeSetMinStepB(void *cvadj_mem, realtype hminB); -int CVodeSetMaxStepB(void *cvadj_mem, realtype hmaxB); - -int CVodeMallocB(void *cvadj_mem, CVRhsFnB fB, - realtype tB0, N_Vector yB0, - int itolB, realtype *reltolB, void *abstolB); - -int CVodeReInitB(void *cvadj_mem, CVRhsFnB fB, - realtype tB0, N_Vector yB0, - int itolB, realtype *reltolB, void *abstolB); - -/* - * ----------------------------------------------------------------- - * Function : CVodeSetQuad*B, CVodeQuadMallocB, CVodeQuadReInitB - * ----------------------------------------------------------------- - */ - -int CVodeSetQuadFdataB(void *cvadj_mem, void *fQ_dataB); -int CVodeSetQuadErrConB(void *cvadj_mem, int errconQB); -int CVodeSetQuadTolerancesB(void *cvadj_mem, int itolQB, - realtype *reltolQB, void *abstolQB); -int CVodeQuadMallocB(void *cvadj_mem, CVQuadRhsFnB fQB, N_Vector yQB0); -int CVodeQuadReInitB(void *cvadj_mem, CVQuadRhsFnB fQB, N_Vector yQB0); - -/* - * ----------------------------------------------------------------- - * Function : CVDenseB, CVDenseSet*B - * ----------------------------------------------------------------- - * CVDenseB links the main CVODE integrator with the CVDENSE - * linear solver for the backward integration. - * ----------------------------------------------------------------- - */ - -int CVDenseB(void *cvadj_mem, long int nB); - -int CVDenseSetJacFnB(void *cvadj_mem, CVDenseJacFnB djacB); -int CVDenseSetJacDataB(void *cvadj_mem, void *jac_dataB); - -/* - * ----------------------------------------------------------------- - * Function : CVDiagB - * ----------------------------------------------------------------- - * CVDiagB links the main CVODE integrator with the CVDIAG - * linear solver for the backward integration. - * ----------------------------------------------------------------- - */ - -int CVDiagB(void *cvadj_mem); - -/* - * ----------------------------------------------------------------- - * Function : CVBandB, CVBandSet*B - * ----------------------------------------------------------------- - * CVBandB links the main CVODE integrator with the CVBAND - * linear solver for the backward integration. - * ----------------------------------------------------------------- - */ - -int CVBandB(void *cvadj_mem, long int nB, - long int mupperB, long int mlowerB); - -int CVBandSetJacFnB(void *cvadj_mem, CVBandJacFnB bjacB); -int CVBandSetJacDataB(void *cvadj_mem, void *jac_dataB); - -/* - * ----------------------------------------------------------------- - * Function : CVSpgmrB, CVSpgmrSet*B - * ----------------------------------------------------------------- - * CVSpgmrB links the main CVODE integrator with the CVSPGMR - * linear solver for the backward integration. - * ----------------------------------------------------------------- - */ - -int CVSpgmrB(void *cvadj_mem, int pretypeB, int maxlB); - -int CVSpgmrSetPrecTypeB(void *cvadj_mem, int pretypeB); - -int CVSpgmrSetGSTypeB(void *cvadj_mem, int gstypeB); -int CVSpgmrSetDeltB(void *cvadj_mem, realtype deltB); -int CVSpgmrSetPrecSetupFnB(void *cvadj_mem, CVSpgmrPrecSetupFnB psetB); -int CVSpgmrSetPrecSolveFnB(void *cvadj_mem, CVSpgmrPrecSolveFnB psolveB); -int CVSpgmrSetJacTimesVecFnB(void *cvadj_mem, CVSpgmrJacTimesVecFnB jtimesB); -int CVSpgmrSetPrecDataB(void *cvadj_mem, void *P_dataB); -int CVSpgmrSetJacDataB(void *cvadj_mem, void *jac_dataB); - -/* - * ----------------------------------------------------------------- - * Function: CVBandPrecAllocB, CVBPSpgmrB - * ----------------------------------------------------------------- - * CVBandPrecAllocB interfaces to the CVBANDPRE preconditioner for - * the backward integration. The pointer to the structure - * returned by this routine should then be used in the call to - * CVBPSpgmrB which interfaces to CVBPSpgmr. - * ----------------------------------------------------------------- - */ - -int CVBandPrecAllocB(void *cvadj_mem, long int nB, - long int muB, long int mlB); - -int CVBPSpgmrB(void *cvadj_mem, int pretypeB, int maxlB); - -/* - * ----------------------------------------------------------------- - * Functions: CVBBDPrecAllocB, CVBBDSpgmrB, CVBBDPrecReInit - * ----------------------------------------------------------------- - * Interface functions for the BBD preconditioner to be used on - * the backward phase. - * ----------------------------------------------------------------- - */ - -int CVBBDPrecAllocB(void *cvadj_mem, long int NlocalB, - long int mudqB, long int mldqB, - long int mukeepB, long int mlkeepB, - realtype dqrelyB, - CVLocalFnB glocB, CVCommFnB cfnB); - -int CVBBDSpgmrB(void *cvadj_mem, int pretypeB, int maxlB); - -int CVBBDPrecReInitB(void *cvadj_mem, long int mudqB, long int mldqB, - realtype dqrelyB, CVLocalFnB glocB, CVCommFnB cfnB); - -/* - * ----------------------------------------------------------------- - * Function : CVodeB - * ----------------------------------------------------------------- - * CVodeB performs the backward integration from tfinal to - * tinitial through a sequence of forward-backward runs in - * between consecutive check points. It returns the values of - * the adjoint variables and any existing quadrature variables - * at tinitial. - * ----------------------------------------------------------------- - */ - -int CVodeB(void *cvadj_mem, realtype tBout, N_Vector yBout, - realtype *tBret, int itaskB); - -/* - * ----------------------------------------------------------------- - * Function : CVodeGetQuadB - * ----------------------------------------------------------------- - * CVodeGetQuadB extracts values for quadrature variables in - * the N_Vector qB. - * ----------------------------------------------------------------- - */ - -int CVodeGetQuadB(void *cvadj_mem, N_Vector qB); - -/* - * ----------------------------------------------------------------- - * Function : CVadjFree - * ----------------------------------------------------------------- - * CVadjFree frees the memory allocated by CVadjMalloc. - * ----------------------------------------------------------------- - */ - -void CVadjFree(void *cvadj_mem); - -/* - * ----------------------------------------------------------------- - * Function : CVadjGetCVodeBmem - * ----------------------------------------------------------------- - * CVadjGetCVodeBmem returns a (void *) pointer to the CVODES - * memory allocated for the backward problem. This pointer can - * then be used to call any of the CVodeGet* CVODES routines to - * extract optional output for the backward integration phase. - * ----------------------------------------------------------------- - */ - -void *CVadjGetCVodeBmem(void *cvadj_mem); - -/* - * ----------------------------------------------------------------- - * Function : CVadjGetY - * ----------------------------------------------------------------- - * This routine uses cubic piece-wise Hermite interpolation for - * the forward solution vector. - * ----------------------------------------------------------------- - */ - -int CVadjGetY(void *cvadj_mem, realtype t, N_Vector y); - -/* - * ----------------------------------------------------------------- - * Function : CVadjGetCheckPointsList - * ----------------------------------------------------------------- - */ - -void CVadjGetCheckPointsList(void *cvadj_mem); - -/* - * ----------------------------------------------------------------- - * Function : CVadjGetStoredData - * ----------------------------------------------------------------- - */ - -void CVadjGetStoredData(void *cvadj_mem, long int which, - realtype *t, N_Vector yout, N_Vector ydout); - -/* - * ----------------------------------------------------------------- - * CVODEA return values - * ----------------------------------------------------------------- - */ - -#define CV_ADJMEM_NULL -101 -#define CV_BAD_TB0 -103 -#define CV_BCKMEM_NULL -104 -#define CV_REIFWD_FAIL -105 -#define CV_FWD_FAIL -106 -#define CV_BAD_ITASK -107 -#define CV_BAD_TBOUT -108 -#define CV_GETY_BADT -109 - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/cvodes/cvodea_impl.h b/src/sundials/cvodes/cvodea_impl.h deleted file mode 100755 index 0e06306f28..0000000000 --- a/src/sundials/cvodes/cvodea_impl.h +++ /dev/null @@ -1,223 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * Implementation header file for the CVODEA adjoint integrator. - * ----------------------------------------------------------------- - */ - -#ifndef _CVODEA_IMPL_H -#define _CVODEA_IMPL_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include - -#include "cvodea.h" -#include "cvodes_impl.h" -#include "cvdense_impl.h" -#include "cvband_impl.h" -#include "cvspgmr_impl.h" -#include "cvbandpre_impl.h" -#include "cvbbdpre_impl.h" - -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Types : struct CkpntMemRec, CkpntMem - * ----------------------------------------------------------------- - * The type CkpntMem is type pointer to struct CkpntMemRec. - * This structure contains fields to store all information at a - * check point that is needed to 'hot' start cvodes. - * ----------------------------------------------------------------- - */ - -typedef struct CkpntMemRec { - - /* Integration limits */ - realtype ck_t0; - realtype ck_t1; - - /* Nordsieck History Array */ - N_Vector ck_zn[L_MAX]; - - /* Nordsieck History Array for quadratures */ - N_Vector ck_znQ[L_MAX]; - - /* Do we need to carry quadratures? */ - booleantype ck_quadr; - - /* Was ck_zn[qmax] allocated? - ck_zqm = 0 - no - ck_zqm = qmax - yes */ - int ck_zqm; - - /* Step data */ - long int ck_nst; - int ck_q; - int ck_qprime; - int ck_qwait; - int ck_L; - realtype ck_gammap; - realtype ck_h; - realtype ck_hprime; - realtype ck_hscale; - realtype ck_eta; - realtype ck_etamax; - realtype ck_tau[L_MAX+1]; - realtype ck_tq[NUM_TESTS+1]; - realtype ck_l[L_MAX]; - - /* Saved values */ - realtype ck_saved_tq5; - - /* Pointer to next structure in list */ - struct CkpntMemRec *ck_next; - -} *CkpntMem; - -/* - * ----------------------------------------------------------------- - * Types : struct DtpntMemRec, DtpntMem - * ----------------------------------------------------------------- - * The type DtpntMem is type pointer to struct DtpntMemRec. - * This structure contains fields to store all information at a - * data point that is needed to interpolate solution of forward - * simulations. - * ----------------------------------------------------------------- - */ - -typedef struct DtpntMemRec { - - /* time */ - realtype t; - - /* solution */ - N_Vector y; - - /* solution derivative */ - N_Vector yd; - -} *DtpntMem; - -/* - * ----------------------------------------------------------------- - * Types : struct CVadjMemRec, CVadjMem - * ----------------------------------------------------------------- - * The type CVadjMem is type pointer to struct CVadjMemRec. - * This structure contins fields to store all information - * necessary for adjoint sensitivity analysis. - * ----------------------------------------------------------------- - */ - -typedef struct CVadjMemRec { - - /* CVODE memory for forward runs */ - struct CVodeMemRec *cv_mem; - - /* CVODE memory for backward run */ - struct CVodeMemRec *cvb_mem; - - /* Storage for check point information */ - struct CkpntMemRec *ck_mem; - - /* Storage for data from forward runs */ - struct DtpntMemRec **dt_mem; - - /* Right hand side function (fB) for backward run */ - CVRhsFnB ca_fB; - - /* Right hand side quadrature function (fQB) for backward run */ - CVQuadRhsFnB ca_fQB; - - /* Dense Jacobian function (djacB) for backward run */ - CVDenseJacFnB ca_djacB; - - /* Banded Jacobian function (bjacB) for backward run */ - CVBandJacFnB ca_bjacB; - - /* Jac times vec routine (jtimesB) for backward run */ - CVSpgmrJacTimesVecFnB ca_jtimesB; - - /* Preconditioner routines (precondB and psolveB) for backward run */ - CVSpgmrPrecSetupFnB ca_psetB; - CVSpgmrPrecSolveFnB ca_psolveB; - - /* BBD user functions (glocB and cfnB) for backward run */ - CVLocalFnB ca_glocB; - CVCommFnB ca_cfnB; - - /* User f_dataB */ - void *ca_f_dataB; - - /* User fQ_dataB */ - void *ca_fQ_dataB; - - /* User jac_dataB */ - void *ca_jac_dataB; - - /* User P_dataB */ - void *ca_P_dataB; - - /* BP prec data */ - void *ca_bp_dataB; - - /* BBD prec data */ - void *ca_bbd_dataB; - - /* Unit roundoff */ - realtype ca_uround; - - /* Integration interval */ - realtype ca_tinitial, ca_tfinal; - - /* Time at which to extract quadratures */ - realtype ca_t_for_quad; - - /* Number of check points */ - int ca_nckpnts; - - /* Number of steps between 2 check points */ - long int ca_nsteps; - - /* Flag to indicate that data in dt_mem is new */ - booleantype ca_newData; - - /* address of the check point structure for which data is available */ - struct CkpntMemRec *ca_ckpntData; - - /* Actual number of data points saved in current dt_mem */ - /* Commonly, np = nsteps+1 */ - long int ca_np; - - /* Temporary space used by the Hermite interpolation */ - realtype ca_delta; - N_Vector ca_Y0, ca_Y1; - N_Vector ca_ytmp; - -} *CVadjMem; - -/* Error Messages */ - -#define _CVAM_ "CVadjMalloc-- " -#define MSGAM_NO_MEM _CVAM_ "cvode_mem = NULL illegal.\n\n" -#define MSGAM_BAD_STEPS _CVAM_ "Steps non-positive illegal.\n\n" -#define MSGAM_MEM_FAIL _CVAM_ "A memory request failed.\n\n" - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/cvodes/cvodes.c b/src/sundials/cvodes/cvodes.c deleted file mode 100755 index 48a96db636..0000000000 --- a/src/sundials/cvodes/cvodes.c +++ /dev/null @@ -1,6614 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for the main CVODES integrator - * with sensitivity analysis capabilities. - * It is independent of the CVODES linear solver in use. - * ----------------------------------------------------------------- - */ - -/*=================================================================*/ -/* Import Header Files */ -/*=================================================================*/ - -#include -#include - -#include "cvodes_impl.h" -#include "sundialsmath.h" -#include "sundialstypes.h" - -/*=================================================================*/ -/* Macros */ -/*=================================================================*/ - -/* Macro: loop */ -#define loop for(;;) - -/*=================================================================*/ -/* CVODES Private Constants */ -/*=================================================================*/ - -#define ZERO RCONST(0.0) /* real 0.0 */ -#define TINY RCONST(1.0e-10) /* small number */ -#define TENTH RCONST(0.1) /* real 0.1 */ -#define FOURTH RCONST(0.25) /* real 0.25 */ -#define HALF RCONST(0.5) /* real 0.5 */ -#define ONE RCONST(1.0) /* real 1.0 */ -#define TWO RCONST(2.0) /* real 2.0 */ -#define THREE RCONST(3.0) /* real 3.0 */ -#define FOUR RCONST(4.0) /* real 4.0 */ -#define FIVE RCONST(5.0) /* real 5.0 */ -#define TWELVE RCONST(12.0) /* real 12.0 */ -#define HUN RCONST(100.0) /* real 100.0 */ - -/*=================================================================*/ -/* CVODES Default Constants */ -/*=================================================================*/ - -#define HMIN_DEFAULT ZERO /* hmin default value */ -#define HMAX_INV_DEFAULT ZERO /* hmax_inv default value */ -#define MXHNIL_DEFAULT 10 /* mxhnil default value */ -#define MXSTEP_DEFAULT 500 /* mxstep default value */ - -/*=================================================================*/ -/* CVODES Routine-Specific Constants */ -/*=================================================================*/ - -/* CVodeGetDky and CVStep */ - -#define FUZZ_FACTOR RCONST(100.0) - -/* CVHin */ - -#define HLB_FACTOR RCONST(100.0) -#define HUB_FACTOR RCONST(0.1) -#define H_BIAS HALF -#define MAX_ITERS 4 - -/* CVSet */ - -#define CORTES RCONST(0.1) - -/* CVStep return values */ - -#define SUCCESS_STEP 0 -#define REP_ERR_FAIL -1 -#define REP_CONV_FAIL -2 -#define SETUP_FAILED -3 -#define SOLVE_FAILED -4 - -/* CVStep control constants */ - -#define PREDICT_AGAIN -5 -#define DO_ERROR_TEST 1 - -/* CVStep */ - -#define THRESH RCONST(1.5) -#define ETAMX1 RCONST(10000.0) -#define ETAMX2 RCONST(10.0) -#define ETAMX3 RCONST(10.0) -#define ETAMXF RCONST(0.2) -#define ETAMIN RCONST(0.1) -#define ETACF RCONST(0.25) -#define ADDON RCONST(0.000001) -#define BIAS1 RCONST(6.0) -#define BIAS2 RCONST(6.0) -#define BIAS3 RCONST(10.0) -#define ONEPSM RCONST(1.000001) - -#define SMALL_NST 10 /* nst > SMALL_NST => use ETAMX3 */ -#define MXNCF 10 /* max no. of convergence failures during - one step try */ -#define MXNEF 7 /* max no. of error test failures during - one step try */ -#define MXNEF1 3 /* max no. of error test failures before - forcing a reduction of order */ -#define SMALL_NEF 2 /* if an error failure occurs and - SMALL_NEF <= nef <= MXNEF1, then - reset eta = MIN(eta, ETAMXF) */ -#define LONG_WAIT 10 /* number of steps to wait before - considering an order change when - q==1 and MXNEF1 error test failures - have occurred */ - -/* CVNls return values */ - -#define SOLVED 0 -#define CONV_FAIL -1 -#define SETUP_FAIL_UNREC -2 -#define SOLVE_FAIL_UNREC -3 - -/* CVNls input flags */ - -#define FIRST_CALL 0 -#define PREV_CONV_FAIL -1 -#define PREV_ERR_FAIL -2 - -/* CVNls other constants */ - -#define NLS_MAXCOR 3 /* maximum no. of corrector iterations for the - nonlinear solver */ -#define CRDOWN RCONST(0.3) /* constant used in the estimation of the - convergence rate (crate) of the - iterates for the nonlinear equation */ -#define DGMAX RCONST(0.3) /* iter == CV_NEWTON, |gamma/gammap-1| > DGMAX - => call lsetup */ - -#define RDIV TWO /* declare divergence if ratio del/delp > RDIV */ -#define MSBP 20 /* max no. of steps between lsetup calls */ - -#define TRY_AGAIN 99 /* control constant for CVNlsNewton - should be - distinct from CVNls return values */ - -/* CVRcheck* return values */ - -#define INITROOT -1 -#define CLOSERT -2 -#define RTFOUND 1 - -/* CVSensRhs1DQ finite difference methods */ - -#define CENTERED1 0 -#define CENTERED2 1 -#define FORWARD1 2 -#define FORWARD2 3 - -/*=================================================================*/ -/* Private Helper Functions Prototypes */ -/*=================================================================*/ - -static booleantype CVCheckNvector(N_Vector tmpl); - -static int CVInitialSetup(CVodeMem cv_mem); - -static booleantype CVAllocVectors(CVodeMem cv_mem, N_Vector tmpl); -static void CVFreeVectors(CVodeMem cv_mem); - -static booleantype CVEwtSet(CVodeMem cv_mem, N_Vector ycur); -static booleantype CVEwtSetSS(CVodeMem cv_mem, N_Vector ycur); -static booleantype CVEwtSetSV(CVodeMem cv_mem, N_Vector ycur); - -static booleantype CVHin(CVodeMem cv_mem, realtype tout); -static realtype CVUpperBoundH0(CVodeMem cv_mem, realtype tdist); -static realtype CVYddNorm(CVodeMem cv_mem, realtype hg); - -static int CVStep(CVodeMem cv_mem); - -static int CVsldet(CVodeMem cv_mem); - -static void CVAdjustParams(CVodeMem cv_mem); -static void CVAdjustOrder(CVodeMem cv_mem, int deltaq); -static void CVAdjustAdams(CVodeMem cv_mem, int deltaq); -static void CVAdjustBDF(CVodeMem cv_mem, int deltaq); -static void CVIncreaseBDF(CVodeMem cv_mem); -static void CVDecreaseBDF(CVodeMem cv_mem); - -static void CVRescale(CVodeMem cv_mem); - -static void CVPredict(CVodeMem cv_mem); - -static void CVSet(CVodeMem cv_mem); -static void CVSetAdams(CVodeMem cv_mem); -static realtype CVAdamsStart(CVodeMem cv_mem, realtype m[]); -static void CVAdamsFinish(CVodeMem cv_mem, realtype m[], realtype M[], realtype hsum); -static realtype CVAltSum(int iend, realtype a[], int k); -static void CVSetBDF(CVodeMem cv_mem); -static void CVSetTqBDF(CVodeMem cv_mem, realtype hsum, realtype alpha0, - realtype alpha0_hat, realtype xi_inv, realtype xistar_inv); - -static int CVNls(CVodeMem cv_mem, int nflag); -static int CVNlsFunctional(CVodeMem cv_mem); -static int CVNlsNewton(CVodeMem cv_mem, int nflag); -static int CVNewtonIteration(CVodeMem cv_mem); - -static int CVHandleNFlag(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, - int *ncfPtr, long int *ncfnPtr); - -static void CVRestore(CVodeMem cv_mem, realtype saved_t); - -static booleantype CVDoErrorTest(CVodeMem cv_mem, int *nflagPtr, int *kflagPtr, - realtype saved_t, int *nefPtr, realtype *dsmPtr); - -static void CVCompleteStep(CVodeMem cv_mem); - -static void CVPrepareNextStep(CVodeMem cv_mem, realtype dsm); -static void CVSetEta(CVodeMem cv_mem); -static realtype CVComputeEtaqm1(CVodeMem cv_mem); -static realtype CVComputeEtaqp1(CVodeMem cv_mem); -static void CVChooseEta(CVodeMem cv_mem); -static void CVBDFStab(CVodeMem cv_mem); - -static int CVHandleFailure(CVodeMem cv_mem,int kflag); - -/*----------------*/ - -static int CVRcheck1(CVodeMem cv_mem); -static int CVRcheck2(CVodeMem cv_mem); -static int CVRcheck3(CVodeMem cv_mem); -static int CVRootfind(CVodeMem cv_mem); - -/*----------------*/ - -static booleantype CVQuadAllocVectors(CVodeMem cv_mem, N_Vector tmpl); -static booleantype CVQuadEwtSet(CVodeMem cv_mem, N_Vector qcur); -static booleantype CVQuadEwtSetSS(CVodeMem cv_mem, N_Vector qcur); -static booleantype CVQuadEwtSetSV(CVodeMem cv_mem, N_Vector qcur); -static void CVQuadFreeVectors(CVodeMem cv_mem); - -/*----------------*/ - -static booleantype CVQuadDoErrorTest(CVodeMem cv_mem, int *nflagPtr, - int *kflagPtr, realtype saved_t, - int *nefQPtr, realtype *dsmQPtr); - -/*----------------*/ - -static realtype CVQuadUpdateNorm(CVodeMem cv_mem, realtype old_nrm, - N_Vector xQ, N_Vector wQ); -static realtype CVQuadUpdateDsm(CVodeMem cv_mem, realtype old_dsm, - realtype dsmQ); - -/*----------------*/ - -static int CVSensTestTolerances(CVodeMem cv_mem); -static int CVSensSetTolerances(CVodeMem cv_mem); -static booleantype CVSensAllocAtol(CVodeMem cv_mem, void **atolSPtr); -static void CVSensFreeAtol(CVodeMem cv_mem, void *atolS); -static booleantype CVSensSetAtolSS(CVodeMem cv_mem, realtype *atolS); -static booleantype CVSensSetAtolSV(CVodeMem cv_mem, N_Vector *atolS); - -/*----------------*/ - -static booleantype CVSensAllocVectors(CVodeMem cv_mem, N_Vector tmpl); -static void CVSensFreeVectors(CVodeMem cv_mem); - -/*----------------*/ - -static booleantype CVSensEwtSet(CVodeMem cv_mem, N_Vector *yScur); -static booleantype CVSensEwtSetSS(CVodeMem cv_mem, N_Vector *yScur); -static booleantype CVSensEwtSetSV(CVodeMem cv_mem, N_Vector *yScur); - -/*----------------*/ - -static int CVStgrNls(CVodeMem cv_mem); -static int CVStgrNlsFunctional(CVodeMem cv_mem); -static int CVStgrNlsNewton(CVodeMem cv_mem); -static int CVStgrNewtonIteration(CVodeMem cv_mem); -static int CVStgr1Nls(CVodeMem cv_mem, int is); -static int CVStgr1NlsFunctional(CVodeMem cv_mem, int is); -static int CVStgr1NlsNewton(CVodeMem cv_mem, int is); -static int CVStgr1NewtonIteration(CVodeMem cv_mem, int is); -static booleantype CVStgrDoErrorTest(CVodeMem cv_mem, int *nflagPtr, int *kflagPtr, - realtype saved_t, int *nefSPtr, realtype *dsmSPtr); - -/*----------------*/ - -static realtype CVSensNorm(CVodeMem cv_mem, N_Vector *xS, N_Vector *wS); -static realtype CVSensUpdateNorm(CVodeMem cv_mem, realtype old_nrm, - N_Vector *xS, N_Vector *wS); -static realtype CVStgrUpdateDsm(CVodeMem cv_mem, realtype old_dsm, - realtype dsmS); - -/*----------------*/ - -static void CVSensRhs(CVodeMem cv_mem, realtype time, - N_Vector ycur, N_Vector fcur, - N_Vector *yScur, N_Vector *fScur, - N_Vector temp1, N_Vector temp2); - -static void CVSensRhs1(CVodeMem cv_mem, realtype time, - N_Vector ycur, N_Vector fcur, - int is, N_Vector yScur, N_Vector fScur, - N_Vector temp1, N_Vector temp2); - -/*=================================================================*/ -/* EXPORTED FUNCTIONS IMPLEMENTATION */ -/*=================================================================*/ - -/* - * CVodeCreate - * - * CVodeCreate creates an internal memory block for a problem to - * be solved by CVODES. - * If successful, CVodeCreate returns a pointer to the problem memory. - * This pointer should be passed to CVodeMalloc. - * If an initialization error occurs, CVodeCreate prints an error - * message to standard err and returns NULL. - */ - -void *CVodeCreate(int lmm, int iter) -{ - int maxord; - CVodeMem cv_mem; - - /* Test inputs */ - - if ((lmm != CV_ADAMS) && (lmm != CV_BDF)) { - fprintf(stderr, MSGCVS_BAD_LMM); - return (NULL); - } - - if ((iter != CV_FUNCTIONAL) && (iter != CV_NEWTON)) { - fprintf(stderr, MSGCVS_BAD_ITER); - return (NULL); - } - - cv_mem = (CVodeMem) malloc(sizeof(struct CVodeMemRec)); - if (cv_mem == NULL) { - fprintf(stderr, MSGCVS_CVMEM_FAIL); - return (NULL); - } - - maxord = (lmm == CV_ADAMS) ? ADAMS_Q_MAX : BDF_Q_MAX; - - /* copy input parameters into cv_mem */ - cv_mem->cv_lmm = lmm; - cv_mem->cv_iter = iter; - - /* Set uround */ - cv_mem->cv_uround = UNIT_ROUNDOFF; - - /* Set default values for integrator optional inputs */ - cv_mem->cv_f = NULL; - cv_mem->cv_f_data = NULL; - cv_mem->cv_errfp = stderr; - cv_mem->cv_qmax = maxord; - cv_mem->cv_mxstep = MXSTEP_DEFAULT; - cv_mem->cv_mxhnil = MXHNIL_DEFAULT; - cv_mem->cv_sldeton = FALSE; - cv_mem->cv_hin = ZERO; - cv_mem->cv_hmin = HMIN_DEFAULT; - cv_mem->cv_hmax_inv = HMAX_INV_DEFAULT; - cv_mem->cv_tstopset = FALSE; - cv_mem->cv_maxcor = NLS_MAXCOR; - cv_mem->cv_maxnef = MXNEF; - cv_mem->cv_maxncf = MXNCF; - cv_mem->cv_nlscoef = CORTES; - - /* Set default values for quad. optional inputs */ - cv_mem->cv_quadr = FALSE; - cv_mem->cv_fQ = NULL; - cv_mem->cv_fQ_data = NULL; - cv_mem->cv_errconQ = FALSE; - cv_mem->cv_reltolQ = NULL; - cv_mem->cv_abstolQ = NULL; - - /* Set default values for sensi. optional inputs */ - cv_mem->cv_sensi = FALSE; - cv_mem->cv_fS_data = (void *)cv_mem; - cv_mem->cv_fS = CVSensRhsDQ; - cv_mem->cv_fS1 = CVSensRhs1DQ; - cv_mem->cv_fSDQ = TRUE; - cv_mem->cv_ifS = CV_ONESENS; - cv_mem->cv_rhomax = ZERO; - cv_mem->cv_pbar = NULL; - cv_mem->cv_plist = NULL; - cv_mem->cv_errconS = FALSE; - cv_mem->cv_maxcorS = NLS_MAXCOR; - cv_mem->cv_ncfS1 = NULL; - cv_mem->cv_ncfnS1 = NULL; - cv_mem->cv_nniS1 = NULL; - - /* By default, CVODES sets sensi tolerances */ - cv_mem->cv_setSensTol = TRUE; - cv_mem->cv_atolSallocated = FALSE; - cv_mem->cv_testSensTol = FALSE; - cv_mem->cv_reltolS = NULL; - cv_mem->cv_abstolS = NULL; - - /* No mallocs have been done yet */ - cv_mem->cv_MallocDone = FALSE; - cv_mem->cv_quadMallocDone = FALSE; - cv_mem->cv_sensMallocDone = FALSE; - - /* Return pointer to CVODES memory block */ - return((void *)cv_mem); -} - -/*-----------------------------------------------------------------*/ - -#define iter (cv_mem->cv_iter) -#define lmm (cv_mem->cv_lmm) -#define errfp (cv_mem->cv_errfp) - -/*-----------------------------------------------------------------*/ - -/* - * CVodeMalloc - * - * CVodeMalloc allocates and initializes memory for a problem. All - * problem inputs are checked for errors. If any error occurs during - * initialization, it is reported to the file whose file pointer is - * errfp and an error flag is returned. Otherwise, it returns CV_SUCCESS - */ - -int CVodeMalloc(void *cvode_mem, CVRhsFn f, realtype t0, N_Vector y0, - int itol, realtype *reltol, void *abstol) -{ - CVodeMem cv_mem; - booleantype nvectorOK, allocOK, neg_abstol; - long int lrw1, liw1; - int i,k; - - /* Check cvode_mem */ - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_CVM_NO_MEM); - return(CV_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - /* Check for legal input parameters */ - - if (y0==NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_Y0_NULL); - return(CV_ILL_INPUT); - } - - if ((itol != CV_SS) && (itol != CV_SV)) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_ITOL); - return(CV_ILL_INPUT); - } - - if (f == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_F_NULL); - return(CV_ILL_INPUT); - } - - if (reltol == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_RELTOL_NULL); - return(CV_ILL_INPUT); - } - - if (*reltol < ZERO) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_RELTOL); - return(CV_ILL_INPUT); - } - - if (abstol == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_ABSTOL_NULL); - return(CV_ILL_INPUT); - } - - /* Test if all required vector operations are implemented */ - nvectorOK = CVCheckNvector(y0); - if(!nvectorOK) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_NVECTOR); - return(CV_ILL_INPUT); - } - - /* Test absolute tolerances */ - if (itol == CV_SS) { - neg_abstol = (*((realtype *)abstol) < ZERO); - } else { - neg_abstol = (N_VMin((N_Vector)abstol) < ZERO); - } - if (neg_abstol) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_ABSTOL); - return(CV_ILL_INPUT); - } - - /* Set space requirements for one N_Vector */ - if (y0->ops->nvspace != NULL) { - N_VSpace(y0, &lrw1, &liw1); - } else { - lrw1 = 0; - liw1 = 0; - } - cv_mem->cv_lrw1 = lrw1; - cv_mem->cv_liw1 = liw1; - - /* Allocate the vectors (using y0 as a template) */ - allocOK = CVAllocVectors(cv_mem, y0); - if (!allocOK) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_MEM_FAIL); - return(CV_MEM_FAIL); - } - - /* Copy tolerances into memory */ - cv_mem->cv_itol = itol; - cv_mem->cv_reltol = reltol; - cv_mem->cv_abstol = abstol; - - /* All error checking is complete at this point */ - - /* Copy the input parameters into CVODES state */ - cv_mem->cv_f = f; - cv_mem->cv_tn = t0; - - /* Set step parameters */ - cv_mem->cv_q = 1; - cv_mem->cv_L = 2; - cv_mem->cv_qwait = cv_mem->cv_L; - cv_mem->cv_etamax = ETAMX1; - - cv_mem->cv_qu = 0; - cv_mem->cv_hu = ZERO; - cv_mem->cv_tolsf = ONE; - - /* Set the linear solver addresses to NULL. - (We check != NULL later, in CVode, if using CV_NEWTON.) */ - cv_mem->cv_linit = NULL; - cv_mem->cv_lsetup = NULL; - cv_mem->cv_lsolve = NULL; - cv_mem->cv_lfree = NULL; - cv_mem->cv_lmem = NULL; - - /* Set forceSetup to FALSE */ - cv_mem->cv_forceSetup = FALSE; - - /* Initialize zn[0] in the history array */ - N_VScale(ONE, y0, cv_mem->cv_zn[0]); - - /* Initialize all the counters */ - cv_mem->cv_nst = 0; - cv_mem->cv_nfe = 0; - cv_mem->cv_ncfn = 0; - cv_mem->cv_netf = 0; - cv_mem->cv_nni = 0; - cv_mem->cv_nsetups = 0; - cv_mem->cv_nhnil = 0; - cv_mem->cv_nstlp = 0; - cv_mem->cv_nscon = 0; - cv_mem->cv_nge = 0; - - /* Initialize root finding variables */ - cv_mem->cv_glo = NULL; - cv_mem->cv_ghi = NULL; - cv_mem->cv_groot = NULL; - cv_mem->cv_iroots = NULL; - cv_mem->cv_gfun = NULL; - cv_mem->cv_g_data = NULL; - cv_mem->cv_nrtfn = 0; - - /* Initialize Stablilty Limit Detection data */ - /* NOTE: We do this even if stab lim det was not - turned on yet. This way, the user can turn it - on at any time */ - cv_mem->cv_nor = 0; - for (i = 1; i <= 5; i++) - for (k = 1; k <= 3; k++) - cv_mem->cv_ssdat[i-1][k-1] = ZERO; - - /* Problem has been successfully initialized */ - cv_mem->cv_MallocDone = TRUE; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVodeReInit - * - * CVodeReInit re-initializes CVODES' memory for a problem, assuming - * it has already been allocated in a prior CVodeMalloc call. - * All problem specification inputs are checked for errors. - * If any error occurs during initialization, it is reported to the - * file whose file pointer is errfp. - * The return value is CV_SUCCESS = 0 if no errors occurred, or - * a negative value otherwise. - */ - -int CVodeReInit(void *cvode_mem, CVRhsFn f, realtype t0, N_Vector y0, - int itol, realtype *reltol, void *abstol) -{ - CVodeMem cv_mem; - booleantype neg_abstol; - int i,k; - - /* Check cvode_mem */ - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_CVM_NO_MEM); - return(CV_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - /* Check if cvode_mem was allocated */ - if (cv_mem->cv_MallocDone == FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_CVREI_NO_MALLOC); - return(CV_NO_MALLOC); - } - - /* Check for legal input parameters */ - - if (y0 == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_Y0_NULL); - return (CV_ILL_INPUT); - } - - if ((itol != CV_SS) && (itol != CV_SV)) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_ITOL); - return (CV_ILL_INPUT); - } - - if (f == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_F_NULL); - return (CV_ILL_INPUT); - } - - if (reltol == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_RELTOL_NULL); - return (CV_ILL_INPUT); - } - - if (*reltol < ZERO) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_RELTOL); - return (CV_ILL_INPUT); - } - - if (abstol == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_ABSTOL_NULL); - return (CV_ILL_INPUT); - } - - if (itol == CV_SS) { - neg_abstol = (*((realtype *)abstol) < ZERO); - } else { - neg_abstol = (N_VMin((N_Vector)abstol) < ZERO); - } - if (neg_abstol) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_ABSTOL); - return (CV_ILL_INPUT); - } - - /* Copy tolerances into memory and set the ewt vector */ - cv_mem->cv_itol = itol; - cv_mem->cv_reltol = reltol; - cv_mem->cv_abstol = abstol; - - /* All error checking is complete at this point */ - - /* Copy the input parameters into CVODE state */ - cv_mem->cv_f = f; - cv_mem->cv_tn = t0; - - /* Set step parameters */ - cv_mem->cv_q = 1; - cv_mem->cv_L = 2; - cv_mem->cv_qwait = cv_mem->cv_L; - cv_mem->cv_etamax = ETAMX1; - - cv_mem->cv_qu = 0; - cv_mem->cv_hu = ZERO; - cv_mem->cv_tolsf = ONE; - - /* Set forceSetup to FALSE */ - cv_mem->cv_forceSetup = FALSE; - - /* Initialize zn[0] in the history array */ - N_VScale(ONE, y0, cv_mem->cv_zn[0]); - - /* Initialize all the counters */ - cv_mem->cv_nst = 0; - cv_mem->cv_nfe = 0; - cv_mem->cv_ncfn = 0; - cv_mem->cv_netf = 0; - cv_mem->cv_nni = 0; - cv_mem->cv_nsetups = 0; - cv_mem->cv_nhnil = 0; - cv_mem->cv_nstlp = 0; - cv_mem->cv_nscon = 0; - cv_mem->cv_nge = 0; - - /* Initialize Stablilty Limit Detection data */ - cv_mem->cv_nor = 0; - for (i = 1; i <= 5; i++) - for (k = 1; k <= 3; k++) - cv_mem->cv_ssdat[i-1][k-1] = ZERO; - - /* Problem has been successfully re-initialized */ - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -#define gfun (cv_mem->cv_gfun) -#define glo (cv_mem->cv_glo) -#define ghi (cv_mem->cv_ghi) -#define groot (cv_mem->cv_groot) -#define iroots (cv_mem->cv_iroots) - -/*-----------------------------------------------------------------*/ - -/* - * CVodeRootInit - * - * CVodeRootInit initializes a rootfinding problem to be solved - * during the integration of the ODE system. It loads the root - * function pointer and the number of root functions, and allocates - * workspace memory. The return value is CV_SUCCESS = 0 if no errors - * occurred, or a negative value otherwise. - */ - -int CVodeRootInit(void *cvode_mem, CVRootFn g, int nrtfn) -{ - CVodeMem cv_mem; - int nrt; - - /* Check cvode_mem */ - if (cvode_mem==NULL) { - fprintf(stdout, MSGCVS_ROOT_NO_MEM); - return(CV_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - nrt = (nrtfn < 0) ? 0 : nrtfn; - - /* If rerunning CVodeRootInit() with a different number of root - functions (changing number of gfun components), then free - currently held memory resources */ - if ((nrt != cv_mem->cv_nrtfn) && (cv_mem->cv_nrtfn > 0)) { - free(glo); - free(ghi); - free(groot); - free(iroots); - - /* Linux version of free() routine doesn't set pointer to NULL */ - glo = ghi = groot = NULL; - iroots = NULL; - } - - /* If CVodeRootInit() was called with nrtfn == 0, then set cv_nrtfn to - zero and cv_gfun to NULL before returning */ - if (nrt == 0) { - cv_mem->cv_nrtfn = nrt; - gfun = NULL; - return(CV_SUCCESS); - } - - /* If rerunning CVodeRootInit() with the same number of root functions - (not changing number of gfun components), then check if the root - function argument has changed */ - /* If g != NULL then return as currently reserved memory resources - will suffice */ - if (nrt == cv_mem->cv_nrtfn) { - if (g != gfun) { - if (g == NULL) { - free(glo); - free(ghi); - free(groot); - free(iroots); - fprintf(errfp, MSGCVS_ROOT_FUNC_NULL); - return(CV_RTFUNC_NULL); - } - else { - gfun = g; - return(CV_SUCCESS); - } - } - else return(CV_SUCCESS); - } - - /* Set variable values in CVode memory block */ - cv_mem->cv_nrtfn = nrt; - if (g == NULL) { - fprintf(errfp, MSGCVS_ROOT_FUNC_NULL); - return(CV_RTFUNC_NULL); - } - else gfun = g; - - /* Allocate necessary memory and return */ - glo = (realtype *) malloc(nrt*sizeof(realtype)); - if (glo == NULL) { - fprintf(stdout, MSGCVS_ROOT_MEM_FAIL); - return(CV_MEM_FAIL); - } - - ghi = (realtype *) malloc(nrt*sizeof(realtype)); - if (ghi == NULL) { - free(glo); - fprintf(stdout, MSGCVS_ROOT_MEM_FAIL); - return(CV_MEM_FAIL); - } - - groot = (realtype *) malloc(nrt*sizeof(realtype)); - if (groot == NULL) { - free(glo); free(ghi); - fprintf(stdout, MSGCVS_ROOT_MEM_FAIL); - return(CV_MEM_FAIL); - } - - iroots = (int *) malloc(nrt*sizeof(int)); - if (iroots == NULL) { - free(glo); free(ghi); free(groot); - fprintf(stdout, MSGCVS_ROOT_MEM_FAIL); - return(CV_MEM_FAIL); - } - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVodeQuadMalloc - * - * CVodeQuadMalloc allocates and initializes quadrature related - * memory for a problem. All problem specification inputs are - * checked for errors. If any error occurs during initialization, - * it is reported to the file whose file pointer is errfp. - * The return value is CV_SUCCESS = 0 if no errors occurred, or - * a negative value otherwise. - */ - -int CVodeQuadMalloc(void *cvode_mem, CVQuadRhsFn fQ, N_Vector yQ0) -{ - CVodeMem cv_mem; - booleantype allocOK; - long int lrw1Q, liw1Q; - - /* Check cvode_mem */ - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_QCVM_NO_MEM); - return(CV_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - /* Set space requirements for one N_Vector */ - N_VSpace(yQ0, &lrw1Q, &liw1Q); - cv_mem->cv_lrw1Q = lrw1Q; - cv_mem->cv_liw1Q = liw1Q; - - /* Allocate the vectors (using yQ0 as a template) */ - allocOK = CVQuadAllocVectors(cv_mem, yQ0); - if (!allocOK) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_QCVM_MEM_FAIL); - return(CV_MEM_FAIL); - } - - /* Initialize znQ[0] in the history array */ - N_VScale(ONE, yQ0, cv_mem->cv_znQ[0]); - - /* Copy the input parameters into CVODES state */ - cv_mem->cv_fQ = fQ; - - /* Initialize counters */ - cv_mem->cv_nfQe = 0; - cv_mem->cv_netfQ = 0; - - /* Quadrature integration turned ON */ - cv_mem->cv_quadr = TRUE; - cv_mem->cv_quadMallocDone = TRUE; - - /* Quadrature initialization was successfull */ - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVodeQuadReInit - * - * CVodeQuadReInit re-initializes CVODES' quadrature related memory - * for a problem, assuming it has already been allocated in prior - * calls to CVodeMalloc and CvodeQuadMalloc. - * All problem specification inputs are checked for errors. - * If any error occurs during initialization, it is reported to the - * file whose file pointer is errfp. - * The return value is CV_SUCCESS = 0 if no errors occurred, or - * a negative value otherwise. - */ - -int CVodeQuadReInit(void *cvode_mem, CVQuadRhsFn fQ, N_Vector yQ0) -{ - CVodeMem cv_mem; - - /* Check cvode_mem */ - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_QCVM_NO_MEM); - return(CV_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - /* Ckeck if quadrature was initialized? */ - if (cv_mem->cv_quadMallocDone == FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_QREI_NO_QUAD); - return(CV_NO_QUAD); - } - - /* Initialize znQ[0] in the history array */ - N_VScale(ONE, yQ0, cv_mem->cv_znQ[0]); - - /* Copy the input parameters into CVODE state */ - cv_mem->cv_fQ = fQ; - - /* Initialize counters */ - cv_mem->cv_nfQe = 0; - cv_mem->cv_netfQ = 0; - - /* Quadrature integration turned ON */ - cv_mem->cv_quadr = TRUE; - - /* Quadrature re-initialization was successfull */ - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -#define ifS (cv_mem->cv_ifS) -#define fSDQ (cv_mem->cv_fSDQ) -#define stgr1alloc (cv_mem->cv_stgr1alloc) -#define nniS1 (cv_mem->cv_nniS1) -#define ncfnS1 (cv_mem->cv_ncfnS1) -#define ncfS1 (cv_mem->cv_ncfS1) - -/*-----------------------------------------------------------------*/ - -/* - * CVodeSenMalloc - * - * CVodeSensMalloc allocates and initializes sensitivity related - * memory for a problem. All problem specification inputs are - * checked for errors. If any error occurs during initialization, - * it is reported to the file whose file pointer is errfp. - * The return value is CV_SUCCESS = 0 if no errors occurred, or - * a negative value otherwise. - */ - -int CVodeSensMalloc(void *cvode_mem, int Ns, int ism, - realtype *p, int *plist, N_Vector *yS0) -{ - CVodeMem cv_mem; - booleantype allocOK; - int is; - - /* Check cvode_mem */ - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SCVM_NO_MEM); - return(CV_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - /* Check if Ns is legal */ - if (Ns<=0) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_NS); - return(CV_ILL_INPUT); - } - cv_mem->cv_Ns = Ns; - - /* Check if ism is legal */ - if ((ism!=CV_SIMULTANEOUS) && (ism!=CV_STAGGERED) && (ism!=CV_STAGGERED1)) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_ISM); - return(CV_ILL_INPUT); - } - cv_mem->cv_ism = ism; - - /* Check if p is non-null */ - if (p==NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_P_NULL); - return(CV_ILL_INPUT); - } - cv_mem->cv_p = p; - cv_mem->cv_plist = plist; - - /* Check if yS0 is non-null */ - if ((cv_mem->cv_yS = yS0) == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_YS0_NULL); - return(CV_ILL_INPUT); - } - - /* Allocate ncfS1, ncfnS1, and nniS1 if needed */ - if (ism == CV_STAGGERED1) { - stgr1alloc = TRUE; - ncfS1 = (int*)malloc(Ns*sizeof(int)); - ncfnS1 = (long int*)malloc(Ns*sizeof(long int)); - nniS1 = (long int*)malloc(Ns*sizeof(long int)); - if ( (ncfS1 == NULL) || (ncfnS1 == NULL) || (nniS1 == NULL) ) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SCVM_MEM_FAIL); - return(CV_MEM_FAIL); - } - } else { - stgr1alloc = FALSE; - } - - /* Allocate the vectors (using yS0[0] as a template) */ - allocOK = CVSensAllocVectors(cv_mem, yS0[0]); - if (!allocOK) { - if (stgr1alloc) { - free(ncfS1); - free(ncfnS1); - free(nniS1); - } - if(errfp!=NULL) fprintf(errfp, MSGCVS_SCVM_MEM_FAIL); - return(CV_MEM_FAIL); - } - - /*---------------------------------------------- - All error checking is complete at this point - -----------------------------------------------*/ - - /* Initialize znS[0] in the history array */ - for (is=0; iscv_znS[0][is]); - - /* Initialize all sensitivity related counters */ - cv_mem->cv_nfSe = 0; - cv_mem->cv_nfeS = 0; - cv_mem->cv_ncfnS = 0; - cv_mem->cv_netfS = 0; - cv_mem->cv_nniS = 0; - cv_mem->cv_nsetupsS = 0; - if (ism==CV_STAGGERED1) - for (is=0; iscv_sensi = TRUE; - cv_mem->cv_sensMallocDone = TRUE; - - /* Sensitivity initialization was successfull */ - return (CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -#define Ns (cv_mem->cv_Ns) - -/*-----------------------------------------------------------------*/ - -/* - * CVodeSensReInit - * - * CVodeSensReInit re-initializes CVODES' sensitivity related memory - * for a problem, assuming it has already been allocated in prior - * calls to CVodeMalloc and CVodeSensMalloc. - * All problem specification inputs are checked for errors. - * The number of sensitivities Ns is assumed to be unchanged since - * the previous call to CVodeSensMalloc. - * If any error occurs during initialization, it is reported to the - * file whose file pointer is errfp. - * The return value is CV_SUCCESS = 0 if no errors occurred, or - * a negative value otherwise. - */ - -int CVodeSensReInit(void *cvode_mem, int ism, - realtype *p, int *plist, N_Vector *yS0) -{ - CVodeMem cv_mem; - int is; - - /* Check cvode_mem */ - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SCVM_NO_MEM); - return(CV_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - /* Was sensitivity initialized? */ - if (cv_mem->cv_sensMallocDone == FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SREI_NO_SENSI); - return(CV_NO_SENS); - } - - /* Check if ism is legal */ - if ((ism!=CV_SIMULTANEOUS) && (ism!=CV_STAGGERED) && (ism!=CV_STAGGERED1)) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_ISM); - return(CV_ILL_INPUT); - } - cv_mem->cv_ism = ism; - - /* Check if p is non-null */ - if (p==NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_P_NULL); - return(CV_ILL_INPUT); - } - cv_mem->cv_p = p; - cv_mem->cv_plist = plist; - - /* Check if yS0 is non-null */ - if (yS0 == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_YS0_NULL); - return(CV_ILL_INPUT); - } - - /* Allocate ncfS1, ncfnS1, and nniS1 if needed */ - if ( (ism==CV_STAGGERED1) && (stgr1alloc==FALSE) ) { - stgr1alloc = TRUE; - ncfS1 = (int*)malloc(Ns*sizeof(int)); - ncfnS1 = (long int*)malloc(Ns*sizeof(long int)); - nniS1 = (long int*)malloc(Ns*sizeof(long int)); - if ( (ncfS1==NULL) || (ncfnS1==NULL) || (nniS1==NULL) ) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SCVM_MEM_FAIL); - return(CV_MEM_FAIL); - } - } - - /*---------------------------------------------- - All error checking is complete at this point - -----------------------------------------------*/ - - /* Initialize znS[0] in the history array */ - for (is=0; iscv_znS[0][is]); - - /* Initialize all sensitivity related counters */ - cv_mem->cv_nfSe = 0; - cv_mem->cv_nfeS = 0; - cv_mem->cv_ncfnS = 0; - cv_mem->cv_netfS = 0; - cv_mem->cv_nniS = 0; - cv_mem->cv_nsetupsS = 0; - if (ism==CV_STAGGERED1) - for (is=0; iscv_sensi = TRUE; - return (CV_SUCCESS); -} - -/* - * CVodeSensToggle - * - * CVodeSensToggle activates or deactivates sensitivity calculations. - * It does NOT deallocate sensitivity-related memory. - * It is allowed to set sensi=TRUE only if CVodeSensMalloc has been - * previously called. - */ - -int CVodeSensToggle(void *cvode_mem, booleantype sensi) -{ - CVodeMem cv_mem; - - /* Check cvode_mem */ - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SCVT_NO_MEM); - return(CV_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - /* Disable sensitivities */ - if (sensi == FALSE) { - cv_mem->cv_sensi = FALSE; - return (CV_SUCCESS); - } - - /* Re-enable sensitivities */ - - if (cv_mem->cv_sensMallocDone == FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SCVT_NO_SENSI); - return(CV_NO_SENS); - } - - cv_mem->cv_sensi = TRUE; - - return (CV_SUCCESS); -} - -/*=================================================================*/ -/* Readibility Constants */ -/*=================================================================*/ - -#define f (cv_mem->cv_f) -#define f_data (cv_mem->cv_f_data) -#define g_data (cv_mem->cv_g_data) -#define qmax (cv_mem->cv_qmax) -#define mxstep (cv_mem->cv_mxstep) -#define mxhnil (cv_mem->cv_mxhnil) -#define sldeton (cv_mem->cv_sldeton) -#define hin (cv_mem->cv_hin) -#define hmin (cv_mem->cv_hmin) -#define hmax_inv (cv_mem->cv_hmax_inv) -#define tstop (cv_mem->cv_tstop) -#define tstopset (cv_mem->cv_tstopset) -#define maxnef (cv_mem->cv_maxnef) -#define maxncf (cv_mem->cv_maxncf) -#define maxcor (cv_mem->cv_maxcor) -#define nlscoef (cv_mem->cv_nlscoef) -#define itol (cv_mem->cv_itol) -#define reltol (cv_mem->cv_reltol) -#define abstol (cv_mem->cv_abstol) - -#define fQ (cv_mem->cv_fQ) -#define fQ_data (cv_mem->cv_fQ_data) -#define errconQ (cv_mem->cv_errconQ) -#define itolQ (cv_mem->cv_itolQ) -#define reltolQ (cv_mem->cv_reltolQ) -#define abstolQ (cv_mem->cv_abstolQ) - -#define fS (cv_mem->cv_fS) -#define fS1 (cv_mem->cv_fS1) -#define fS_data (cv_mem->cv_fS_data) -#define rhomax (cv_mem->cv_rhomax) -#define pbar (cv_mem->cv_pbar) -#define errconS (cv_mem->cv_errconS) -#define maxcorS (cv_mem->cv_maxcorS) -#define itolS (cv_mem->cv_itolS) -#define reltolS (cv_mem->cv_reltolS) -#define abstolS (cv_mem->cv_abstolS) -#define ism (cv_mem->cv_ism) -#define p (cv_mem->cv_p) -#define plist (cv_mem->cv_plist) - -#define uround (cv_mem->cv_uround) -#define zn (cv_mem->cv_zn) -#define ewt (cv_mem->cv_ewt) -#define y (cv_mem->cv_y) -#define acor (cv_mem->cv_acor) -#define tempv (cv_mem->cv_tempv) -#define ftemp (cv_mem->cv_ftemp) -#define q (cv_mem->cv_q) -#define qprime (cv_mem->cv_qprime) -#define next_q (cv_mem->cv_next_q) -#define qwait (cv_mem->cv_qwait) -#define L (cv_mem->cv_L) -#define h (cv_mem->cv_h) -#define hprime (cv_mem->cv_hprime) -#define next_h (cv_mem->cv_next_h) -#define eta (cv_mem->cv_eta) -#define etaqm1 (cv_mem->cv_etaqm1) -#define etaq (cv_mem->cv_etaq) -#define etaqp1 (cv_mem->cv_etaqp1) -#define nscon (cv_mem->cv_nscon) -#define hscale (cv_mem->cv_hscale) -#define tn (cv_mem->cv_tn) -#define tau (cv_mem->cv_tau) -#define tq (cv_mem->cv_tq) -#define l (cv_mem->cv_l) -#define rl1 (cv_mem->cv_rl1) -#define gamma (cv_mem->cv_gamma) -#define gammap (cv_mem->cv_gammap) -#define gamrat (cv_mem->cv_gamrat) -#define crate (cv_mem->cv_crate) -#define acnrm (cv_mem->cv_acnrm) -#define mnewt (cv_mem->cv_mnewt) -#define etamax (cv_mem->cv_etamax) -#define nst (cv_mem->cv_nst) -#define nfe (cv_mem->cv_nfe) -#define ncfn (cv_mem->cv_ncfn) -#define netf (cv_mem->cv_netf) -#define nni (cv_mem->cv_nni) -#define nsetups (cv_mem->cv_nsetups) -#define nhnil (cv_mem->cv_nhnil) -#define lrw1 (cv_mem->cv_lrw1) -#define liw1 (cv_mem->cv_liw1) -#define lrw (cv_mem->cv_lrw) -#define liw (cv_mem->cv_liw) -#define linit (cv_mem->cv_linit) -#define lsetup (cv_mem->cv_lsetup) -#define lsolve (cv_mem->cv_lsolve) -#define lfree (cv_mem->cv_lfree) -#define lmem (cv_mem->cv_lmem) -#define qu (cv_mem->cv_qu) -#define nstlp (cv_mem->cv_nstlp) -#define h0u (cv_mem->cv_h0u) -#define hu (cv_mem->cv_hu) -#define saved_tq5 (cv_mem->cv_saved_tq5) -#define jcur (cv_mem->cv_jcur) -#define tolsf (cv_mem->cv_tolsf) -#define setupNonNull (cv_mem->cv_setupNonNull) -#define forceSetup (cv_mem->cv_forceSetup) -#define nor (cv_mem->cv_nor) -#define ssdat (cv_mem->cv_ssdat) - -#define nrtfn (cv_mem->cv_nrtfn) -#define tlo (cv_mem->cv_tlo) -#define thi (cv_mem->cv_thi) -#define tretlast (cv_mem->cv_tretlast) -#define toutc (cv_mem->cv_toutc) -#define troot (cv_mem->cv_troot) -#define ttol (cv_mem->cv_ttol) -#define taskc (cv_mem->cv_taskc) -#define irfnd (cv_mem->cv_irfnd) -#define nge (cv_mem->cv_nge) - -#define sensi (cv_mem->cv_sensi) -#define znS (cv_mem->cv_znS) -#define ewtS (cv_mem->cv_ewtS) -#define acorS (cv_mem->cv_acorS) -#define yS (cv_mem->cv_yS) -#define tempvS (cv_mem->cv_tempvS) -#define ftempS (cv_mem->cv_ftempS) -#define crateS (cv_mem->cv_crateS) -#define acnrmS (cv_mem->cv_acnrmS) -#define nfSe (cv_mem->cv_nfSe) -#define nfeS (cv_mem->cv_nfeS) -#define nniS (cv_mem->cv_nniS) -#define ncfnS (cv_mem->cv_ncfnS) -#define netfS (cv_mem->cv_netfS) -#define nsetupsS (cv_mem->cv_nsetupsS) -#define stgr1alloc (cv_mem->cv_stgr1alloc) -#define setSensTol (cv_mem->cv_setSensTol) -#define testSensTol (cv_mem->cv_testSensTol) -#define atolSallocated (cv_mem->cv_atolSallocated) -#define sensMallocDone (cv_mem->cv_sensMallocDone) - -#define quadr (cv_mem->cv_quadr) -#define znQ (cv_mem->cv_znQ) -#define ewtQ (cv_mem->cv_ewtQ) -#define acorQ (cv_mem->cv_acorQ) -#define yQ (cv_mem->cv_yQ) -#define tempvQ (cv_mem->cv_tempvQ) -#define acnrmQ (cv_mem->cv_acnrmQ) -#define nfQe (cv_mem->cv_nfQe) -#define netfQ (cv_mem->cv_netfQ) -#define lrw1Q (cv_mem->cv_lrw1Q) -#define liw1Q (cv_mem->cv_liw1Q) -#define quadMallocDone (cv_mem->cv_quadMallocDone) - -/*-----------------------------------------------------------------*/ - -/* - * CVode - * - * This routine is the main driver of the CVODE package. - * - * It integrates over a time interval defined by the user, by calling - * CVStep to do internal time steps. - * - * The first time that CVode is called for a successfully initialized - * problem, it computes a tentative initial step size h. - * - * CVode supports four modes, specified by itask: CV_NORMAL, CV_ONE_STEP, - * CV_NORMAL_TSTOP, and CV_ONE_STEP_TSTOP. - * In the CV_NORMAL mode, the solver steps until it reaches or passes tout - * and then interpolates to obtain y(tout). - * In the CV_ONE_STEP mode, it takes one internal step and returns. - * CV_NORMAL_TSTOP and CV_ONE_STEP_TSTOP are similar to CV_NORMAL and CV_ONE_STEP, - * respectively, but the integration never proceeds past tstop (which - * must have been defined through a call to CVodeSetStopTime). - */ - -int CVode(void *cvode_mem, realtype tout, N_Vector yout, - realtype *tret, int itask) -{ - CVodeMem cv_mem; - N_Vector wrk1, wrk2; - long int nstloc; - int kflag, istate, ier, task, irfndp; - booleantype istop, hOK, ewtsetOK, ewtSsetOK, ewtQsetOK; - int is; - realtype troundoff, rh, nrm; - - /* Check if cvode_mem exists */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGCVS_CVODE_NO_MEM); - return (CV_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - /* Check if cvode_mem was allocated */ - if (cv_mem->cv_MallocDone == FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_CVODE_NO_MALLOC); - return(CV_NO_MALLOC); - } - - /* Check for yout != NULL */ - if ((y = yout) == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_YOUT_NULL); - return (CV_ILL_INPUT); - } - - /* Check for tret != NULL */ - if (tret == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_TRET_NULL); - return (CV_ILL_INPUT); - } - tretlast = *tret = tn; - - /* Check for valid itask */ - if ((itask != CV_NORMAL) && - (itask != CV_ONE_STEP) && - (itask != CV_NORMAL_TSTOP) && - (itask != CV_ONE_STEP_TSTOP) ) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_ITASK); - return (CV_ILL_INPUT); - } - - /* Split itask into task and istop */ - if ((itask == CV_NORMAL_TSTOP) || (itask == CV_ONE_STEP_TSTOP)) { - if ( tstopset == FALSE ) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_NO_TSTOP); - return(CV_ILL_INPUT); - } - istop = TRUE; - } else { - istop = FALSE; - } - if ((itask == CV_NORMAL) || (itask == CV_NORMAL_TSTOP)) { - task = CV_NORMAL; toutc = tout; - } else { - task = CV_ONE_STEP; - } - taskc = task; - - /* If doing FSA, deal with the sensitivity tolerances */ - - if (sensi) { - - if (testSensTol) { - ier = CVSensTestTolerances(cv_mem); - if (ier != CV_SUCCESS) return (ier); - testSensTol = FALSE; - } - - if (setSensTol) { - ier = CVSensSetTolerances(cv_mem); - if (ier != CV_SUCCESS) return (ier); - setSensTol = FALSE; - } - - } - - /* Begin first call block */ - - if (nst == 0) { - - /* Check inputs for corectness */ - - ier = CVInitialSetup(cv_mem); - if (ier!= CV_SUCCESS) return (ier); - - /* - Call f at (t0,y0), set zn[1] = y'(t0), - set initial h (from H0 or CVHin), and scale zn[1] by h. - - Also check for zeros of root function g at and near t0. - - If computing sensitivities, call fS at (t0,y0,yS0), set - znS[1][is] = yS'(t0), is=1,...,Ns, and scale znS[1][is] by h. - If computing any quadratures, call fQ at (t0,znQ[0]), set - znQ[1] = fQ, and scale znQ[1] by h. - */ - - f(tn, zn[0], zn[1], f_data); - nfe++; - - if (sensi) { - wrk1 = tempv; - wrk2 = ftemp; - CVSensRhs(cv_mem, tn, zn[0], zn[1], znS[0], znS[1], tempv, ftemp); - } - - if (quadr) { - fQ(tn, zn[0], znQ[1], fQ_data); - nfQe++; - } - - h = hin; - if ( (h != ZERO) && ((tout-tn)*h < ZERO) ) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_H0); - return (CV_ILL_INPUT); - } - if (h == ZERO) { - hOK = CVHin(cv_mem, tout); - if (!hOK) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_TOO_CLOSE); - return (CV_ILL_INPUT); - } - } - rh = ABS(h)*hmax_inv; - if (rh > ONE) h /= rh; - if (ABS(h) < hmin) h *= hmin/ABS(h); - - /* Check for approach to tstop */ - - if (istop) { - if ( (tstop - tn)*h < ZERO ) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_TSTOP, tn); - return(CV_ILL_INPUT); - } - if ( (tn + h - tstop)*h > ZERO ) - h = tstop - tn; - } - - hscale = h; - h0u = h; - hprime = h; - - N_VScale(h, zn[1], zn[1]); - - if (sensi) - for (is=0; is 0) { - ier = CVRcheck1(cv_mem); - if (ier != CV_SUCCESS) { - fprintf(errfp, MSGCVS_BAD_INIT_ROOT); - return(CV_ILL_INPUT); - } - } - - } /* end first call block */ - - /* At following steps, perform stop tests */ - - if (nst > 0) { - - /* First check for a root in the last step taken, other than the - last root found, if any. If task = CV_ONE_STEP and y(tn) was not - returned because of an intervening root, return y(tn) now. */ - - if (nrtfn > 0) { - - irfndp = irfnd; - - ier = CVRcheck2(cv_mem); - - if (ier == CLOSERT) { - tretlast = *tret = tlo; - fprintf(errfp, MSGCVS_CLOSE_ROOTS, tlo); - return(CV_ILL_INPUT); - } - - if (ier == RTFOUND) { - tretlast = *tret = tlo; - return(CV_ROOT_RETURN); - } - - if (tn != tretlast) { /* Check remaining interval for roots */ - ier = CVRcheck3(cv_mem); - if (ier == CV_SUCCESS) { /* no root found */ - irfnd = 0; - if (irfndp == 1 && task == CV_ONE_STEP) { - tretlast = *tret = tn; - N_VScale(ONE, zn[0], yout); - return(CV_SUCCESS); - } - } - if (ier == RTFOUND) { /* a new root was found */ - irfnd = 1; - tretlast = *tret = tlo; - return(CV_ROOT_RETURN); - } - } - - } /* end of root stop check */ - - /* Test for tn past tstop */ - if ( istop && ((tstop - tn)*h < ZERO) ) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_TSTOP, tn); - return (CV_ILL_INPUT); - } - - /* In CV_NORMAL mode, test if tout was reached */ - if ( (task == CV_NORMAL) && ((tn-tout)*h >= ZERO) ) { - tretlast = *tret = tout; - ier = CVodeGetDky(cv_mem, tout, 0, yout); - if (ier != CV_SUCCESS) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_TOUT, tout); - return (CV_ILL_INPUT); - } - return (CV_SUCCESS); - } - - /* In CV_ONE_STEP mode, test if tn was returned */ - if (task == CV_ONE_STEP && tretlast != tn) { - tretlast = *tret = tn; - N_VScale(ONE, zn[0], yout); - return(CV_SUCCESS); - } - - /* Test for tn at tstop or near tstop */ - if ( istop ) { - - troundoff = FUZZ_FACTOR*uround*(ABS(tn) + ABS(h)); - if ( ABS(tn - tstop) <= troundoff) { - ier = CVodeGetDky(cv_mem, tstop, 0, yout); - if (ier != CV_SUCCESS) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_TSTOP, tn); - return (CV_ILL_INPUT); - } - tretlast = *tret = tstop; - tn = tstop; - return (CV_TSTOP_RETURN); - } - - if ( (tn + hprime - tstop)*h > ZERO ) { - hprime = tstop - tn; - eta = hprime/h; - } - - } /* end of istop tests block */ - - } /* end stopping tests block at nst>0 */ - - /* Start looping for internal steps */ - - nstloc = 0; - loop { - - next_h = h; - next_q = q; - - /* Reset and check ewt */ - - if (nst > 0) { - - ewtsetOK = CVEwtSet(cv_mem, zn[0]); - - if (sensi) - ewtSsetOK = CVSensEwtSet(cv_mem, znS[0]); - else - ewtSsetOK = TRUE; - - if (quadr && errconQ) - ewtQsetOK = CVQuadEwtSet(cv_mem, znQ[0]); - else - ewtQsetOK = TRUE; - - if ( (!ewtsetOK) || (!ewtSsetOK) || (!ewtQsetOK) ) { - - if(!ewtsetOK) if(errfp!=NULL) fprintf(errfp, MSGCVS_EWT_NOW_BAD, tn); - if(!ewtSsetOK) if(errfp!=NULL) fprintf(errfp, MSGCVS_EWTS_NOW_BAD, tn); - if(!ewtQsetOK) if(errfp!=NULL) fprintf(errfp, MSGCVS_EWTQ_NOW_BAD, tn); - - istate = CV_ILL_INPUT; - tretlast = *tret = tn; - N_VScale(ONE, zn[0], yout); - break; - - } - - } - - /* Check for too many steps */ - - if (nstloc >= mxstep) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_MAX_STEPS, tn); - istate = CV_TOO_MUCH_WORK; - tretlast = *tret = tn; - N_VScale(ONE, zn[0], yout); - break; - } - - /* Check for too much accuracy requested */ - - nrm = N_VWrmsNorm(zn[0], ewt); - if (quadr && errconQ) { - nrm = CVQuadUpdateNorm(cv_mem, nrm, znQ[0], ewtQ); - } - if (sensi && errconS) { - nrm = CVSensUpdateNorm(cv_mem, nrm, znS[0], ewtS); - } - tolsf = uround * nrm; - - if (tolsf > ONE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_TOO_MUCH_ACC, tn); - istate = CV_TOO_MUCH_ACC; - tretlast = *tret = tn; - N_VScale(ONE, zn[0], yout); - tolsf *= TWO; - break; - } else { - tolsf = ONE; - } - - /* Check for h below roundoff level in tn */ - - if (tn + hprime == tn) { - nhnil++; - if (nhnil <= mxhnil) if(errfp!=NULL) fprintf(errfp, MSGCVS_HNIL, tn, hprime); - if (nhnil == mxhnil) if(errfp!=NULL) fprintf(errfp, MSGCVS_HNIL_DONE); - } - - /* Call CVStep to take a step */ - - kflag = CVStep(cv_mem); - - /* Process failed step cases, and exit loop */ - - if (kflag != SUCCESS_STEP) { - istate = CVHandleFailure(cv_mem, kflag); - tretlast = *tret = tn; - N_VScale(ONE, zn[0], yout); - break; - } - - nstloc++; - - /* Check for root in last step taken. */ - - if (nrtfn > 0) { - - ier = CVRcheck3(cv_mem); - - if (ier == RTFOUND) { /* a new root was found */ - irfnd = 1; - tretlast = *tret = tlo; - return(CV_ROOT_RETURN); - } - } - - /* Check if tn is at tstop or near tstop */ - - if ( istop ) { - - troundoff = FUZZ_FACTOR*uround*(ABS(tn) + ABS(h)); - if ( ABS(tn - tstop) <= troundoff) { - (void) CVodeGetDky(cv_mem, tstop, 0, yout); - tretlast = *tret = tstop; - - tn = tstop; - - istate = CV_TSTOP_RETURN; - break; - } - - if ( (tn + hprime - tstop)*h > ZERO ) { - hprime = tstop - tn; - eta = hprime/h; - } - - } - - /* Check if in one-step mode, and if so copy y and exit loop */ - - if (task == CV_ONE_STEP) { - istate = CV_SUCCESS; - tretlast = *tret = tn; - N_VScale(ONE, zn[0], yout); - next_q = qprime; - next_h = hprime; - break; - } - - /* Check if tout reached, and if so interpolate and exit loop */ - - if ((tn-tout)*h >= ZERO) { - istate = CV_SUCCESS; - tretlast = *tret = tout; - (void) CVodeGetDky(cv_mem, tout, 0, yout); - next_q = qprime; - next_h = hprime; - break; - } - - } /* end looping for internal steps */ - - /* Load optional output */ - - if (sensi && (ism==CV_STAGGERED1)) { - nniS = 0; - ncfnS = 0; - for (is=0; is q)) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_K); - return (CV_BAD_K); - } - - /* Allow for some slack */ - tfuzz = FUZZ_FACTOR * uround * (ABS(tn) + ABS(hu)); - if (hu < ZERO) tfuzz = -tfuzz; - tp = tn - hu - tfuzz; - tn1 = tn + tfuzz; - if ((t-tp)*(t-tn1) > ZERO) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_T, t, tn-hu, tn); - return (CV_BAD_T); - } - - /* Sum the differentiated interpolating polynomial */ - - s = (t - tn) / h; - for (j=q; j >= k; j--) { - c = ONE; - for (i=j; i >= j-k+1; i--) c *= i; - if (j == q) { - N_VScale(c, zn[q], dky); - } else { - N_VLinearSum(c, zn[j], s, dky, dky); - } - } - if (k == 0) return (CV_SUCCESS); - r = RPowerI(h,-k); - N_VScale(r, dky, dky); - return (CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVodeGetQuad - * - * This routine extracts quadrature solution into yQout. - * This is just a wrapper that calls CvodeGEtQuadDky with k=0 - */ - -int CVodeGetQuad(void *cvode_mem, realtype t, N_Vector yQout) -{ - return (CVodeGetQuadDky(cvode_mem,t,0,yQout)); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVodeGetQuadDky - * - * CVodeQuadDky computes the kth derivative of the yQ function at - * time t, where tn-hu <= t <= tn, tn denotes the current - * internal time reached, and hu is the last internal step size - * successfully used by the solver. The user may request - * k=0, 1, ..., qu, where qu is the current order. - * The derivative vector is returned in dky. This vector - * must be allocated by the caller. It is only legal to call this - * function after a successful return from CVode with quadrature - * computation enabled. - */ - -int CVodeGetQuadDky(void *cvode_mem, realtype t, int k, N_Vector dkyQ) -{ - realtype s, c, r; - realtype tfuzz, tp, tn1; - int i, j; - CVodeMem cv_mem; - - /* Check all inputs for legality */ - - if (cvode_mem == NULL) { - fprintf(stderr, MSGCVS_QDKY_NO_MEM); - return (CV_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if(quadr != TRUE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_QDKY_NO_QUAD); - return (CV_NO_QUAD); - } - - if (dkyQ == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_QBAD_DKY); - return (CV_BAD_DKY); - } - - if ((k < 0) || (k > q)) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_QBAD_K); - return (CV_BAD_K); - } - - /* Allow for some slack */ - tfuzz = FUZZ_FACTOR * uround * (ABS(tn) + ABS(hu)); - if (hu < ZERO) tfuzz = -tfuzz; - tp = tn - hu - tfuzz; - tn1 = tn + tfuzz; - if ((t-tp)*(t-tn1) > ZERO) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_QBAD_T, t, tn-hu, tn); - return (CV_BAD_T); - } - - /* Sum the differentiated interpolating polynomial */ - - s = (t - tn) / h; - for (j=q; j >= k; j--) { - c = ONE; - for (i=j; i >= j-k+1; i--) c *= i; - if (j == q) { - N_VScale(c, znQ[q], dkyQ); - } else { - N_VLinearSum(c, znQ[j], s, dkyQ, dkyQ); - } - } - if (k == 0) return (CV_SUCCESS); - r = RPowerI(h,-k); - N_VScale(r, dkyQ, dkyQ); - return (CV_SUCCESS); - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVodeGetSens - * - * This routine extracts sensitivity solution into ySout. - * This is just a wrapper that calls CvodeSensDky with k=0 - */ - -int CVodeGetSens(void *cvode_mem, realtype t, N_Vector *ySout) -{ - return (CVodeGetSensDky(cvode_mem,t,0,ySout)); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVodeGetSens1 - * - * This routine extracts the is-th sensitivity solution into ySout. - * This is just a wrapper that calls CvodeSensDky1 with k=0 - */ - -int CVodeGetSens1(void *cvode_mem, realtype t, int is, N_Vector ySout) -{ - return (CVodeGetSensDky1(cvode_mem,t,0,is,ySout)); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVodeGetSensDky - * - * If the user calls directly CVodeSensDky then s must be allocated - * prior to this call. When CVodeSensDky is called by - * CVodeGetSens, only ier=CV_SUCCESS, ier=CV_NO_SENS, or - * ier=CV_BAD_T are possible. - */ - -int CVodeGetSensDky(void *cvode_mem, realtype t, int k, N_Vector *dkyS) -{ - int ier=CV_SUCCESS; - int is; - CVodeMem cv_mem; - - if (cvode_mem == NULL) { - fprintf(stderr, MSGCVS_SDKY_NO_MEM); - return (CV_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (dkyS == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SBAD_DKYA); - return (CV_BAD_DKY); - } - - for (is=0; is q)) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SBAD_K); - return (CV_BAD_K); - } - - if ((is < 1) || (is > Ns)) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SBAD_IS); - return (CV_BAD_IS); - } - - is--; - - /* Allow for some slack */ - tfuzz = FUZZ_FACTOR * uround * (ABS(tn) + ABS(hu)); - if (hu < ZERO) tfuzz = -tfuzz; - tp = tn - hu - tfuzz; - tn1 = tn + tfuzz; - if ((t-tp)*(t-tn1) > ZERO) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SBAD_T); - return (CV_BAD_T); - } - - /* Sum the differentiated interpolating polynomial */ - - s = (t - tn) / h; - for (j=q; j >= k; j--) { - c = ONE; - for (i=j; i >= j-k+1; i--) c *= i; - if (j == q) { - N_VScale(c, znS[q][is], dkyS); - } else { - N_VLinearSum(c, znS[j][is], s, dkyS, dkyS); - } - } - if (k == 0) return (CV_SUCCESS); - r = RPowerI(h,-k); - N_VScale(r, dkyS, dkyS); - return (CV_SUCCESS); - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVodeFree - * - * This routine frees the problem memory allocated by CVodeMalloc. - * Such memory includes all the vectors allocated by CVAllocVectors, - * and the memory lmem for the linear solver (deallocated by a call - * to lfree), as well as (if Ns!=0) all memory allocated for - * sensitivity computations by CVodeSensMalloc. - */ - -void CVodeFree(void *cvode_mem) -{ - CVodeMem cv_mem; - - cv_mem = (CVodeMem) cvode_mem; - - if (cvode_mem == NULL) return; - - CVFreeVectors(cv_mem); - - CVodeQuadFree(cv_mem); - - CVodeSensFree(cv_mem); - - if (iter == CV_NEWTON && lfree != NULL) lfree(cv_mem); - - if (nrtfn > 0) { - free(glo); - free(ghi); - free(groot); - free(iroots); - } - - free(cv_mem); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVodeQuadFree - * - * CVodeQuadFree frees the problem memory in cvode_mem allocated - * for quadrature integration. Its only argument is the pointer - * cvode_mem returned by CVodeCreate. - */ - -void CVodeQuadFree(void *cvode_mem) -{ - CVodeMem cv_mem; - - if (cvode_mem == NULL) return; - cv_mem = (CVodeMem) cvode_mem; - - if(quadMallocDone) { - CVQuadFreeVectors(cv_mem); - quadMallocDone = FALSE; - quadr = FALSE; - } -} - -/*-----------------------------------------------------------------*/ - -/* - * CVodeSensFree - * - * CVodeSensFree frees the problem memory in cvode_mem allocated - * for sensitivity analysis. Its only argument is the pointer - * cvode_mem returned by CVodeCreate. - */ - -void CVodeSensFree(void *cvode_mem) -{ - CVodeMem cv_mem; - - if (cvode_mem == NULL) return; - cv_mem = (CVodeMem) cvode_mem; - - if(sensMallocDone) { - if (atolSallocated) { - CVSensFreeAtol(cv_mem, abstolS); - atolSallocated = FALSE; - } - if (stgr1alloc) { - free(ncfS1); - free(ncfnS1); - free(nniS1); - stgr1alloc = FALSE; - } - CVSensFreeVectors(cv_mem); - sensMallocDone = FALSE; - sensi = FALSE; - } -} - -/*=================================================================*/ -/* PRIVATE FUNCTIONS IMPLEMENTATION */ -/*=================================================================*/ - -/* - * CVCheckNvector - * This routine checks if all required vector operations are present. - * If any of them is missing it returns FALSE. - */ - -static booleantype CVCheckNvector(N_Vector tmpl) -{ - if((tmpl->ops->nvclone == NULL) || - (tmpl->ops->nvdestroy == NULL) || - (tmpl->ops->nvlinearsum == NULL) || - (tmpl->ops->nvconst == NULL) || - (tmpl->ops->nvprod == NULL) || - (tmpl->ops->nvdiv == NULL) || - (tmpl->ops->nvscale == NULL) || - (tmpl->ops->nvabs == NULL) || - (tmpl->ops->nvinv == NULL) || - (tmpl->ops->nvaddconst == NULL) || - (tmpl->ops->nvmaxnorm == NULL) || - (tmpl->ops->nvwrmsnorm == NULL) || - (tmpl->ops->nvmin == NULL)) - return(FALSE); - else - return(TRUE); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVAllocVectors - * - * This routine allocates the CVODE vectors ewt, acor, tempv, ftemp, and - * zn[0], ..., zn[maxord]. The length of the vectors is the input - * parameter neq and the maximum order (needed to allocate zn) is the - * input parameter maxord. If all memory allocations are successful, - * CVAllocVectors returns TRUE. Otherwise all allocated memory is freed - * and CVAllocVectors returns FALSE. - * This routine also sets the optional outputs lrw and liw, which are - * (respectively) the lengths of the real and integer work spaces - * allocated here. - */ - -static booleantype CVAllocVectors(CVodeMem cv_mem, N_Vector tmpl) -{ - int i, j; - - /* Allocate ewt, acor, tempv, ftemp */ - - ewt = N_VClone(tmpl); - if (ewt == NULL) return (FALSE); - acor = N_VClone(tmpl); - if (acor == NULL) { - N_VDestroy(ewt); - return (FALSE); - } - tempv = N_VClone(tmpl); - if (tempv == NULL) { - N_VDestroy(ewt); - N_VDestroy(acor); - return (FALSE); - } - ftemp = N_VClone(tmpl); - if (ftemp == NULL) { - N_VDestroy(tempv); - N_VDestroy(ewt); - N_VDestroy(acor); - return (FALSE); - } - - /* Allocate zn[0] ... zn[maxord] */ - - for (j=0; j <= qmax; j++) { - zn[j] = N_VClone(tmpl); - if (zn[j] == NULL) { - N_VDestroy(ewt); - N_VDestroy(acor); - N_VDestroy(tempv); - N_VDestroy(ftemp); - for (i=0; i < j; i++) N_VDestroy(zn[i]); - return (FALSE); - } - } - - /* Set solver workspace lengths */ - - lrw = (qmax + 5)*lrw1; - liw = (qmax + 5)*liw1; - - return (TRUE); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVFreeVectors - * - * This routine frees the CVODE vectors allocated in CVAllocVectors. - */ - -static void CVFreeVectors(CVodeMem cv_mem) -{ - int j; - - N_VDestroy(ewt); - N_VDestroy(acor); - N_VDestroy(tempv); - N_VDestroy(ftemp); - for (j=0; j <= qmax; j++) N_VDestroy(zn[j]); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVInitialSetup - * - * This routine performs input consistency checks at the first step. - * If needed, it also checks the linear solver module and calls the - * linear solver initialization routine. - */ - -static int CVInitialSetup(CVodeMem cv_mem) -{ - int ier; - booleantype ewtsetOK; - - /* Solver initial setup */ - - ewtsetOK = CVEwtSet(cv_mem, zn[0]); - if (!ewtsetOK) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_EWT); - return(CV_ILL_INPUT); - } - - /* Quadrature initial setup */ - - if (quadr && errconQ) { - - if ( (reltolQ == NULL) || (abstolQ == NULL) ) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_NO_QUADTOL); - return(CV_ILL_INPUT); - } - - /* Load ewtQ */ - ewtsetOK = CVQuadEwtSet(cv_mem, znQ[0]); - if (!ewtsetOK) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_EWTQ); - return (CV_ILL_INPUT); - } - - } - - if (!quadr) errconQ = FALSE; - - /* Forward sensitivity initial setup */ - - if (sensi) { - - /* Check if ism and ifS agree */ - if ((ism==CV_STAGGERED1) && (ifS==CV_ALLSENS)) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_ISM_IFS); - return (CV_ILL_INPUT); - } - - /* Load ewtS */ - ewtsetOK = CVSensEwtSet(cv_mem, znS[0]); - if (!ewtsetOK) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_EWTS); - return (CV_ILL_INPUT); - } - - } - - if (!sensi) errconS = FALSE; - - /* Check if lsolve function exists (if needed) - and call linit function (if it exists) */ - - if (iter == CV_NEWTON) { - if (lsolve == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_LSOLVE_NULL); - return (CV_ILL_INPUT); - } - if (linit != NULL) { - ier = linit(cv_mem); - if (ier != 0) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_LINIT_FAIL); - return (CV_ILL_INPUT); - } - } - } - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVEwtSet - * - * This routine is responsible for setting the error weight vector ewt, - * according to tol_type, as follows: - * - * (1) ewt[i] = 1 / (*rtol * ABS(ycur[i]) + *atol), i=0,...,neq-1 - * if tol_type = CV_SS - * (2) ewt[i] = 1 / (*rtol * ABS(ycur[i]) + atol[i]), i=0,...,neq-1 - * if tol_type = CV_SV - * - * CVEwtSet returns TRUE if ewt is successfully set as above to a - * positive vector and FALSE otherwise. In the latter case, ewt is - * considered undefined after the FALSE return from CVEwtSet. - * - * All the real work is done in the routines CVEwtSetSS, CVEwtSetSV. - */ - -static booleantype CVEwtSet(CVodeMem cv_mem, N_Vector ycur) -{ - booleantype flag=TRUE; - - switch (itol) { - case CV_SS: - flag = CVEwtSetSS(cv_mem, ycur); - break; - case CV_SV: - flag = CVEwtSetSV(cv_mem, ycur); - break; - } - - return(flag); - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVEwtSetSS - * - * This routine sets ewt as decribed above in the case tol_type = CV_SS. - * It tests for non-positive components before inverting. CVEwtSetSS - * returns TRUE if ewt is successfully set to a positive vector - * and FALSE otherwise. In the latter case, ewt is considered - * undefined after the FALSE return from CVEwtSetSS. - */ - -static booleantype CVEwtSetSS(CVodeMem cv_mem, N_Vector ycur) -{ - realtype rtoli, atoli; - - rtoli = *reltol; - atoli = *((realtype *)abstol); - N_VAbs(ycur, tempv); - N_VScale(rtoli, tempv, tempv); - N_VAddConst(tempv, atoli, tempv); - if (N_VMin(tempv) <= ZERO) return (FALSE); - N_VInv(tempv, ewt); - return (TRUE); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVEwtSetSV - * - * This routine sets ewt as decribed above in the case tol_type = CV_SV. - * It tests for non-positive components before inverting. CVEwtSetSV - * returns TRUE if ewt is successfully set to a positive vector - * and FALSE otherwise. In the latter case, ewt is considered - * undefined after the FALSE return from CVEwtSetSV. - */ - -static booleantype CVEwtSetSV(CVodeMem cv_mem, N_Vector ycur) -{ - realtype rtoli; - - rtoli = *reltol; - N_VAbs(ycur, tempv); - N_VLinearSum(rtoli, tempv, ONE, (N_Vector)abstol, tempv); - if (N_VMin(tempv) <= ZERO) return (FALSE); - N_VInv(tempv, ewt); - return (TRUE); -} - -/* - * ----------------------------------------------------------------- - * PRIVATE FUNCTIONS FOR QUADRATURES - * ----------------------------------------------------------------- - */ - -/* - * CVodeQuadAllocVectors - * - * NOTE: Space for ewtQ is allocated even when errconQ=FALSE, - * although in this case, ewtQ is never used. The reason for this - * decision is to allow the user to re-initialize the quadrature - * computation with errconQ=TRUE, after an initialization with - * errconQ=FALSE, without new memory allocation within - * CVodeQuadReInit. -*/ - -static booleantype CVQuadAllocVectors(CVodeMem cv_mem, N_Vector tmpl) -{ - int i, j; - - /* Allocate ewtQ */ - ewtQ = N_VClone(tmpl); - if (ewtQ == NULL) { - return (FALSE); - } - - /* Allocate acorQ */ - acorQ = N_VClone(tmpl); - if (acorQ == NULL) { - N_VDestroy(ewtQ); - return (FALSE); - } - - /* Allocate yQ */ - yQ = N_VClone(tmpl); - if (yQ == NULL) { - N_VDestroy(ewtQ); - N_VDestroy(acorQ); - return (FALSE); - } - - /* Allocate tempvQ */ - tempvQ = N_VClone(tmpl); - if (tempvQ == NULL) { - N_VDestroy(ewtQ); - N_VDestroy(acorQ); - N_VDestroy(yQ); - return (FALSE); - } - - /* Allocate zQn[0] ... zQn[maxord] */ - - for (j=0; j <= qmax; j++) { - znQ[j] = N_VClone(tmpl); - if (znQ[j] == NULL) { - N_VDestroy(ewtQ); - N_VDestroy(acorQ); - N_VDestroy(yQ); - N_VDestroy(tempvQ); - for (i=0; i < j; i++) N_VDestroy(znQ[i]); - return (FALSE); - } - } - - /* Update solver workspace lengths */ - lrw += (qmax + 5)*lrw1Q; - liw += (qmax + 5)*liw1Q; - - return(TRUE); -} - -/*-----------------------------------------------------------------*/ - -static booleantype CVQuadEwtSet(CVodeMem cv_mem, N_Vector qcur) -{ - booleantype flag=TRUE; - - switch (itolQ) { - case CV_SS: - flag = CVQuadEwtSetSS(cv_mem, qcur); - break; - case CV_SV: - flag = CVQuadEwtSetSV(cv_mem, qcur); - break; - } - - return(flag); - -} - -/*-----------------------------------------------------------------*/ - -static booleantype CVQuadEwtSetSS(CVodeMem cv_mem, N_Vector qcur) -{ - realtype rtoli, atoli; - - rtoli = *reltolQ; - atoli = *((realtype *)abstolQ); - - N_VAbs(qcur, tempvQ); - N_VScale(rtoli, tempvQ, tempvQ); - N_VAddConst(tempvQ, atoli, tempvQ); - if (N_VMin(tempvQ) <= ZERO) return (FALSE); - N_VInv(tempvQ, ewtQ); - - return (TRUE); -} - -/*-----------------------------------------------------------------*/ - -static booleantype CVQuadEwtSetSV(CVodeMem cv_mem, N_Vector qcur) -{ - realtype rtoli; - - rtoli = *reltolQ; - - N_VAbs(qcur, tempvQ); - N_VLinearSum(rtoli, tempvQ, ONE, (N_Vector)abstolQ, tempvQ); - if (N_VMin(tempvQ) <= ZERO) return (FALSE); - N_VInv(tempvQ, ewtQ); - - return (TRUE); -} - -/*-----------------------------------------------------------------*/ - -static void CVQuadFreeVectors(CVodeMem cv_mem) -{ - int j; - - N_VDestroy(ewtQ); - N_VDestroy(acorQ); - N_VDestroy(yQ); - N_VDestroy(tempvQ); - - for (j=0; j<=qmax; j++) N_VDestroy(znQ[j]); - -} - -/* - * ----------------------------------------------------------------- - * PRIVATE FUNCTIONS FOR SENSITIVITY ANALYSIS - * ----------------------------------------------------------------- - */ - -static int CVSensTestTolerances(CVodeMem cv_mem) -{ - int is; - booleantype neg_abstol; - realtype *atolSS; - N_Vector *atolSV; - - neg_abstol = FALSE; - - if (*reltolS ZERO) ? 1 : -1; - tdist = ABS(tdiff); - tround = uround * MAX(ABS(tn), ABS(tout)); - if (tdist < TWO*tround) return (FALSE); - - /* Set lower and upper bounds on h0, and take geometric mean - Exit with this value if the bounds cross each other */ - - hlb = HLB_FACTOR * tround; - hub = CVUpperBoundH0(cv_mem, tdist); - hg = RSqrt(hlb*hub); - if (hub < hlb) { - if (sign == -1) hg = -hg; - h = hg; - return (TRUE); - } - - /* Loop up to MAX_ITERS times to find h0. - Stop if new and previous values differ by a factor < 2. - Stop if hnew/hg > 2 after one iteration, as this probably means - that the ydd value is bad because of cancellation error. */ - - count = 0; - loop { - hgs = hg*sign; - yddnrm = CVYddNorm(cv_mem, hgs); - hnew = (yddnrm*hub*hub > TWO) ? RSqrt(TWO/yddnrm) : RSqrt(hg*hub); - count++; - if (count >= MAX_ITERS) break; - hrat = hnew/hg; - if ((hrat > HALF) && (hrat < TWO)) break; - if ((count >= 2) && (hrat > TWO)) { - hnew = hg; - break; - } - hg = hnew; - } - - /* Apply bounds, bias factor, and attach sign */ - - h0 = H_BIAS*hnew; - if (h0 < hlb) h0 = hlb; - if (h0 > hub) h0 = hub; - if (sign == -1) h0 = -h0; - h = h0; - - return (TRUE); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVUpperBoundH0 - * - * This routine sets an upper bound on abs(h0) based on - * tdist = tn - t0 and the values of y[i]/y'[i]. - */ - -static realtype CVUpperBoundH0(CVodeMem cv_mem, realtype tdist) -{ - booleantype vectorAtol, vectorAtolQ, vectorAtolS; - - realtype atoli, hub_inv, hub; - N_Vector temp1, temp2; - - realtype hubQ_inv; - N_Vector tempQ1, tempQ2; - - realtype *atolSS=NULL, hubS_inv; - N_Vector *atolSV=NULL; - int is; - - vectorAtol = (itol == CV_SV); - temp1 = tempv; - temp2 = acor; - N_VAbs(zn[0], temp1); - N_VAbs(zn[1], temp2); - if (vectorAtol) { - N_VLinearSum(HUB_FACTOR, temp1, ONE, (N_Vector)abstol, temp1); - } else { - atoli = *((realtype *) abstol); - N_VScale(HUB_FACTOR, temp1, temp1); - N_VAddConst(temp1, atoli, temp1); - } - N_VDiv(temp2, temp1, temp1); - hub_inv = N_VMaxNorm(temp1); - - if (quadr && errconQ) { - vectorAtolQ = (itolQ == CV_SV); - tempQ1 = tempvQ; - tempQ2 = acorQ; - N_VAbs(znQ[0], tempQ1); - N_VAbs(znQ[1], tempQ2); - if (vectorAtolQ) { - N_VLinearSum(HUB_FACTOR, tempQ1, ONE, (N_Vector)abstolQ, tempQ1); - } else { - atoli = *((realtype *) abstolQ); - N_VScale(HUB_FACTOR, tempQ1, tempQ1); - N_VAddConst(tempQ1, atoli, tempQ1); - } - N_VDiv(tempQ2, tempQ1, tempQ1); - hubQ_inv = N_VMaxNorm(tempQ1); - if (hubQ_inv > hub_inv) hub_inv = hubQ_inv; - } - - if (sensi && errconS) { - vectorAtolS = (itolS == CV_SV); - if (vectorAtolS) atolSV = (N_Vector *)abstolS; - else atolSS = (realtype *)abstolS; - for (is=0; is hub_inv) hub_inv = hubS_inv; - } - } - - hub = HUB_FACTOR*tdist; - if (hub*hub_inv > ONE) hub = ONE/hub_inv; - - return (hub); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVYddNorm - * - * This routine computes an estimate of the second derivative of y - * using a difference quotient, and returns its WRMS norm. - */ - -static realtype CVYddNorm(CVodeMem cv_mem, realtype hg) -{ - realtype yddnrm; - int is; - N_Vector wrk1, wrk2; - - /* y <- h*y'(t) + y(t) */ - - N_VLinearSum(hg, zn[1], ONE, zn[0], y); - - if (sensi && errconS) - for (is=0; is 0) && (hprime != h)) CVAdjustParams(cv_mem); - - /* Looping point for attempts to take a step */ - loop { - CVPredict(cv_mem); - CVSet(cv_mem); - - nflag = CVNls(cv_mem, nflag); - kflag = CVHandleNFlag(cv_mem, &nflag, saved_t, &ncf, &ncfn); - - /* Go back in loop if we need to predict again */ - if (kflag == PREDICT_AGAIN) continue; - - /* Return if nonlinear solve failed and recovery not possible. */ - if (kflag != DO_ERROR_TEST) return (kflag); - - passed = CVDoErrorTest(cv_mem, &nflag, &kflag, saved_t, &nef, &dsm); - - /* Return if error test failed and recovery not possible. */ - if ((!passed) && (kflag == REP_ERR_FAIL)) return (kflag); - - /* Retry step if error test failed, nflag == PREV_ERR_FAIL */ - if (!passed) continue; - - /* passed = TRUE, kflag = DO_ERROR_TEST, nflag = SOLVED */ - - /* Correct the quadrature variables */ - if (quadr) { - /* Save quadrature correction in acorQ */ - fQ(tn, y, acorQ, fQ_data); - N_VLinearSum(h, acorQ, -ONE, znQ[1], acorQ); - N_VScale(rl1, acorQ, acorQ); - /* Apply correction to quadrature variables */ - N_VLinearSum(ONE, znQ[0], ONE, acorQ, yQ); - /* Error test on quadratures */ - if (errconQ) { - acnrmQ = N_VWrmsNorm(acorQ, ewtQ); - passed = CVQuadDoErrorTest(cv_mem, &nflag, &kflag, saved_t, &nefQ, &dsmQ); - if ((!passed) && (kflag == REP_ERR_FAIL)) return (kflag); - if (!passed) continue; - /* update 'dsm' with 'dsmQ' (to be used in CVPrepareNextStep) */ - dsm = CVQuadUpdateDsm(cv_mem, dsm, dsmQ); - } - } - - /* CV_STAGGERED approach for sensitivities */ - if (do_sensi_stg) { - /* Reset counters for states */ - ncf = nef = 0; - /* Evaluate f at converged y */ - f(tn, y, ftemp, f_data); - nfe++; - /* Nonlinear solve for sensitivities (all-at-once) */ - nflag = CVStgrNls(cv_mem); - kflag = CVHandleNFlag(cv_mem, &nflag, saved_t, &ncfS, &ncfnS); - if (kflag == PREDICT_AGAIN) continue; - if (kflag != DO_ERROR_TEST) return (kflag); - /* Error test on sensitivities */ - if (errconS) { - passed = CVStgrDoErrorTest(cv_mem,&nflag,&kflag,saved_t,&nefS,&dsmS); - if ((!passed) && (kflag == REP_ERR_FAIL)) return (kflag); - if (!passed) continue; - /* update 'dsm' with 'dsmS' (to be used in CVPrepareNextStep) */ - dsm = CVStgrUpdateDsm(cv_mem, dsm, dsmS); - } - } - - /* CV_STAGGERED1 approach for sensitivities */ - // LCOV_EXCL_START - if (do_sensi_stg1) { - /* Reset counters for states */ - ncf = nef = 0; - /* Evaluate f at converged y */ - f(tn, y, ftemp, f_data); - nfe++; - /* Nonlinear solve for sensitivities (one-by-one) */ - for (is=0; is xi_0 = 0 - - */ - - for (i=0; i <= qmax; i++) l[i] = ZERO; - l[1] = ONE; - hsum = ZERO; - for (j=1; j <= q-2; j++) { - hsum += tau[j]; - xi = hsum / hscale; - for (i=j+1; i >= 1; i--) l[i] = l[i]*xi + l[i-1]; - } - - for (j=1; j <= q-2; j++) l[j+1] = q * (l[j] / (j+1)); - - for (j=2; j < q; j++) - N_VLinearSum(-l[j], zn[q], ONE, zn[j], zn[j]); - - if (quadr) - for (j=2; j < q; j++) - N_VLinearSum(-l[j], znQ[q], ONE, znQ[j], znQ[j]); - - if (sensi) - for (is=0; is 1) { - for (j=1; j < q; j++) { - hsum += tau[j+1]; - xi = hsum / hscale; - prod *= xi; - alpha0 -= ONE / (j+1); - alpha1 += ONE / xi; - for (i=j+2; i >= 2; i--) l[i] = l[i]*xiold + l[i-1]; - xiold = xi; - } - } - A1 = (-alpha0 - alpha1) / prod; - - /* - zn[qmax] contains the value Delta_n = y_n - y_n(0) - This value was stored there at the previous successful - step (in CVCompleteStep) - - A1 contains dbar = (1/xi* - 1/xi_q)/prod(xi_j) - */ - - N_VScale(A1, zn[qmax], zn[L]); - for (j=2; j <= q; j++) - N_VLinearSum(l[j], zn[L], ONE, zn[j], zn[j]); - - if (quadr) { - N_VScale(A1, znQ[qmax], znQ[L]); - for (j=2; j <= q; j++) - N_VLinearSum(l[j], znQ[L], ONE, znQ[j], znQ[j]); - } - - if (sensi) { - for (is=0; is= 2; i--) l[i] = l[i]*xi + l[i-1]; - } - - for (j=2; j < q; j++) - N_VLinearSum(-l[j], zn[q], ONE, zn[j], zn[j]); - - if (quadr) { - for (j=2; j < q; j++) - N_VLinearSum(-l[j], znQ[q], ONE, znQ[j], znQ[j]); - } - - if (sensi) { - for (is=0; is= k; j--) - N_VLinearSum(ONE, zn[j-1], ONE, zn[j], zn[j-1]); - - if (quadr) { - for (k = 1; k <= q; k++) - for (j = q; j >= k; j--) - N_VLinearSum(ONE, znQ[j-1], ONE, znQ[j], znQ[j-1]); - } - - if (sensi) { - for (is=0; is= k; j--) - N_VLinearSum(ONE, znS[j-1][is], ONE, znS[j][is], znS[j-1][is]); - } - } -} - -/*-----------------------------------------------------------------*/ - -/* - * CVSet - * - * This routine is a high level routine which calls CVSetAdams or - * CVSetBDF to set the polynomial l, the test quantity array tq, - * and the related variables rl1, gamma, and gamrat. - */ - -static void CVSet(CVodeMem cv_mem) -{ - switch(lmm) { - case CV_ADAMS: - CVSetAdams(cv_mem); - break; - case CV_BDF: - CVSetBDF(cv_mem); - break; - } - rl1 = ONE / l[1]; - gamma = h * rl1; - if (nst == 0) gammap = gamma; - gamrat = (nst > 0) ? gamma / gammap : ONE; /* protect x / x != 1.0 */ -} - -/*-----------------------------------------------------------------*/ - -/* - * CVSetAdams - * - * This routine handles the computation of l and tq for the - * case lmm == CV_ADAMS. - * - * The components of the array l are the coefficients of a - * polynomial Lambda(x) = l_0 + l_1 x + ... + l_q x^q, given by - * q-1 - * (d/dx) Lambda(x) = c * PRODUCT (1 + x / xi_i) , where - * i=1 - * Lambda(-1) = 0, Lambda(0) = 1, and c is a normalization factor. - * Here xi_i = [t_n - t_(n-i)] / h. - * - * The array tq is set to test quantities used in the convergence - * test, the error test, and the selection of h at a new order. - */ - -static void CVSetAdams(CVodeMem cv_mem) -{ - realtype m[L_MAX], M[3], hsum; - - if (q == 1) { - l[0] = l[1] = tq[1] = tq[5] = ONE; - tq[2] = TWO; - tq[3] = TWELVE; - tq[4] = nlscoef * tq[2]; /* = 0.1 * tq[2] */ - return; - } - - hsum = CVAdamsStart(cv_mem, m); - - M[0] = CVAltSum(q-1, m, 1); - M[1] = CVAltSum(q-1, m, 2); - - CVAdamsFinish(cv_mem, m, M, hsum); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVAdamsStart - * - * This routine generates in m[] the coefficients of the product - * polynomial needed for the Adams l and tq coefficients for q > 1. - */ - -static realtype CVAdamsStart(CVodeMem cv_mem, realtype m[]) -{ - realtype hsum, xi_inv, sum; - int i, j; - - hsum = h; - m[0] = ONE; - for (i=1; i <= q; i++) m[i] = ZERO; - for (j=1; j < q; j++) { - if ((j==q-1) && (qwait == 1)) { - sum = CVAltSum(q-2, m, 2); - tq[1] = m[q-2] / (q * sum); - } - xi_inv = h / hsum; - for (i=j; i >= 1; i--) m[i] += m[i-1] * xi_inv; - hsum += tau[j]; - /* The m[i] are coefficients of product(1 to j) (1 + x/xi_i) */ - } - return (hsum); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVAdamsFinish - * - * This routine completes the calculation of the Adams l and tq. - */ - -static void CVAdamsFinish(CVodeMem cv_mem, realtype m[], realtype M[], realtype hsum) -{ - int i; - realtype M0_inv, xi, xi_inv; - - M0_inv = ONE / M[0]; - - l[0] = ONE; - for (i=1; i <= q; i++) l[i] = M0_inv * (m[i-1] / i); - xi = hsum / h; - xi_inv = ONE / xi; - - tq[2] = xi * M[0] / M[1]; - tq[5] = xi / l[q]; - - if (qwait == 1) { - for (i=q; i >= 1; i--) m[i] += m[i-1] * xi_inv; - M[2] = CVAltSum(q, m, 2); - tq[3] = L * M[0] / M[2]; - } - - tq[4] = nlscoef * tq[2]; -} - -/*-----------------------------------------------------------------*/ - -/* - * CVAltSum - * - * CVAltSum returns the value of the alternating sum - * sum (i= 0 ... iend) [ (-1)^i * (a[i] / (i + k)) ]. - * If iend < 0 then CVAltSum returns 0. - * This operation is needed to compute the integral, from -1 to 0, - * of a polynomial x^(k-1) M(x) given the coefficients of M(x). - */ - -static realtype CVAltSum(int iend, realtype a[], int k) -{ - int i, sign; - realtype sum; - - if (iend < 0) return (ZERO); - - sum = ZERO; - sign = 1; - for (i=0; i <= iend; i++) { - sum += sign * (a[i] / (i+k)); - sign = -sign; - } - return (sum); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVSetBDF - * - * This routine computes the coefficients l and tq in the case - * lmm == CV_BDF. CVSetBDF calls CVSetTqBDF to set the test - * quantity array tq. - * - * The components of the array l are the coefficients of a - * polynomial Lambda(x) = l_0 + l_1 x + ... + l_q x^q, given by - * q-1 - * Lambda(x) = (1 + x / xi*_q) * PRODUCT (1 + x / xi_i) , where - * i=1 - * xi_i = [t_n - t_(n-i)] / h. - * - * The array tq is set to test quantities used in the convergence - * test, the error test, and the selection of h at a new order. - */ - -static void CVSetBDF(CVodeMem cv_mem) -{ - realtype alpha0, alpha0_hat, xi_inv, xistar_inv, hsum; - int i,j; - - l[0] = l[1] = xi_inv = xistar_inv = ONE; - for (i=2; i <= q; i++) l[i] = ZERO; - alpha0 = alpha0_hat = -ONE; - hsum = h; - if (q > 1) { - for (j=2; j < q; j++) { - hsum += tau[j-1]; - xi_inv = h / hsum; - alpha0 -= ONE / j; - for (i=j; i >= 1; i--) l[i] += l[i-1]*xi_inv; - /* The l[i] are coefficients of product(1 to j) (1 + x/xi_i) */ - } - - /* j = q */ - alpha0 -= ONE / q; - xistar_inv = -l[1] - alpha0; - hsum += tau[q-1]; - xi_inv = h / hsum; - alpha0_hat = -l[1] - xi_inv; - for (i=q; i >= 1; i--) l[i] += l[i-1]*xistar_inv; - } - - CVSetTqBDF(cv_mem, hsum, alpha0, alpha0_hat, xi_inv, xistar_inv); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVSetTqBDF - * - * This routine sets the test quantity array tq in the case - * lmm == CV_BDF. -*/ - -static void CVSetTqBDF(CVodeMem cv_mem, realtype hsum, realtype alpha0, - realtype alpha0_hat, realtype xi_inv, realtype xistar_inv) -{ - realtype A1, A2, A3, A4, A5, A6; - realtype C, CPrime, CPrimePrime; - - A1 = ONE - alpha0_hat + alpha0; - A2 = ONE + q * A1; - tq[2] = ABS(alpha0 * (A2 / A1)); - tq[5] = ABS((A2) / (l[q] * xi_inv/xistar_inv)); - if (qwait == 1) { - C = xistar_inv / l[q]; - A3 = alpha0 + ONE / q; - A4 = alpha0_hat + xi_inv; - CPrime = A3 / (ONE - A4 + A3); - tq[1] = ABS(CPrime / C); - hsum += tau[q]; - xi_inv = h / hsum; - A5 = alpha0 - (ONE / (q+1)); - A6 = alpha0_hat - xi_inv; - CPrimePrime = A2 / (ONE - A6 + A5); - tq[3] = ABS(CPrimePrime * xi_inv * (q+2) * A5); - } - tq[4] = nlscoef * tq[2]; -} - -/*-----------------------------------------------------------------*/ - -/* - * CVnls - * - * This routine attempts to solve the nonlinear system associated - * with a single implicit step of the linear multistep method. - * Depending on iter, it calls CVNlsFunctional or CVNlsNewton - * to do the work. - */ - -static int CVNls(CVodeMem cv_mem, int nflag) -{ - int flag=SOLVED; - - switch(iter) { - case CV_FUNCTIONAL: - flag = CVNlsFunctional(cv_mem); - break; - case CV_NEWTON: - flag = CVNlsNewton(cv_mem, nflag); - break; - } - - return(flag); - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVNlsFunctional - * - * This routine attempts to solve the nonlinear system using - * functional iteration (no matrices involved). - * - * This routine also handles the functional iteration of the - * combined system (states + sensitivities) when sensitivities are - * computed using the CV_SIMULTANEOUS approach. - */ - -static int CVNlsFunctional(CVodeMem cv_mem) -{ - int m; - realtype del, delS=0.0, Del, Delp=0.0, dcon; - int is; - booleantype do_sensi_sim; - N_Vector wrk1, wrk2; - - /* Are we computing sensitivities with the CV_SIMULTANEOUS approach? */ - do_sensi_sim = (sensi && (ism==CV_SIMULTANEOUS)); - - /* Initialize counter and evaluate f at predicted y */ - crate = ONE; - m = 0; - - f(tn, zn[0], tempv, f_data); - nfe++; - - if (do_sensi_sim) { - wrk1 = ftemp; - wrk2 = ftempS[0]; - CVSensRhs(cv_mem, tn, zn[0], tempv, znS[0], tempvS, wrk1, wrk2); - } - - /* Initialize correction to zero */ - - N_VConst(ZERO, acor); - if (do_sensi_sim) { - for (is=0; is 0, an estimate of the convergence - rate constant is stored in crate, and used in the test. - - Recall that, even when errconS=FALSE, all variables are used in the - convergence test. Hence, we use Del (and not del). However, acnrm - is used in the error test and thus it has different forms - depending on errconS (and this explains why we have to carry around - del and delS) - */ - - Del = (do_sensi_sim) ? delS : del; - if (m > 0) crate = MAX(CRDOWN * crate, Del / Delp); - dcon = Del * MIN(ONE, crate) / tq[4]; - - if (dcon <= ONE) { - if (m == 0) - if (do_sensi_sim && errconS) acnrm = delS; - else acnrm = del; - else { - acnrm = N_VWrmsNorm(acor, ewt); - if (do_sensi_sim && errconS) - acnrm = CVSensUpdateNorm(cv_mem, acnrm, acorS, ewtS); - } - return (SOLVED); /* Convergence achieved */ - } - - /* Stop at maxcor iterations or if iter. seems to be diverging */ - - m++; - if ((m==maxcor) || ((m >= 2) && (Del > RDIV * Delp))) - return (CONV_FAIL); - - /* Save norm of correction, evaluate f, and loop again */ - - Delp = Del; - - f(tn, y, tempv, f_data); - nfe++; - - if (do_sensi_sim) { - wrk1 = ftemp; - wrk2 = ftempS[0]; - CVSensRhs(cv_mem, tn, y, tempv, yS, tempvS, wrk1, wrk2); - } - - } /* end loop */ - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVNlsNewton - * - * This routine handles the Newton iteration. It calls lsetup if - * indicated, calls CVNewtonIteration to perform the iteration, and - * retries a failed attempt at Newton iteration if that is indicated. - * See return values at top of this file. - * - * This routine also handles the Newton iteration of the combined - * system when sensitivities are computed using the CV_SIMULTANEOUS - * approach. Since in that case we use a quasi-Newton on the - * combined system (by approximating the Jacobian matrix by its - * block diagonal) and thus only solve linear systems with - * multiple right hand sides (all sharing the same coefficient - * matrix - whatever iteration matrix we decide on) we set-up - * the linear solver to handle N equations at a time. - */ - -static int CVNlsNewton(CVodeMem cv_mem, int nflag) -{ - N_Vector vtemp1, vtemp2, vtemp3, wrk1, wrk2; - int convfail, ier; - booleantype callSetup, do_sensi_sim; - int is; - - /* Are we computing sensitivities with the CV_SIMULTANEOUS approach? */ - do_sensi_sim = (sensi && (ism==CV_SIMULTANEOUS)); - - vtemp1 = acor; /* rename acor as vtemp1 for readability */ - vtemp2 = y; /* rename y as vtemp2 for readability */ - vtemp3 = tempv; /* rename tempv as vtemp3 for readability */ - - /* Set flag convfail, input to lsetup for its evaluation decision */ - convfail = ((nflag == FIRST_CALL) || (nflag == PREV_ERR_FAIL)) ? - CV_NO_FAILURES : CV_FAIL_OTHER; - - /* Decide whether or not to call setup routine (if one exists) */ - if (setupNonNull) { - callSetup = (nflag == PREV_CONV_FAIL) || (nflag == PREV_ERR_FAIL) || - (nst == 0) || (nst >= nstlp + MSBP) || (ABS(gamrat-ONE) > DGMAX); - - /* Decide whether to force a call to setup */ - if (forceSetup) { - callSetup = TRUE; - convfail = CV_FAIL_OTHER; - } - - } else { - crate = ONE; - crateS = ONE; /* if NO lsetup all conv. rates are set to ONE */ - callSetup = FALSE; - } - - /* Looping point for the solution of the nonlinear system. - Evaluate f at the predicted y, call lsetup if indicated, and - call CVNewtonIteration for the Newton iteration itself. */ - - loop { - - f(tn, zn[0], ftemp, f_data); - nfe++; - - if (do_sensi_sim) { - wrk1 = tempv; - wrk2 = tempvS[0]; - CVSensRhs(cv_mem, tn, zn[0], ftemp, znS[0], ftempS, wrk1, wrk2); - } - - if (callSetup) { - ier = lsetup(cv_mem, convfail, zn[0], ftemp, &jcur, - vtemp1, vtemp2, vtemp3); - nsetups++; - callSetup = FALSE; - forceSetup = FALSE; - gamrat = ONE; - gammap = gamma; - crate = ONE; - crateS = ONE; /* after lsetup all conv. rates are reset to ONE */ - nstlp = nst; - /* Return if lsetup failed */ - if (ier < 0) return (SETUP_FAIL_UNREC); - if (ier > 0) return (CONV_FAIL); - } - - /* Set acor to zero and load prediction into y vector */ - N_VConst(ZERO, acor); - N_VScale(ONE, zn[0], y); - - if (do_sensi_sim) - for (is=0; is 0) { - if ((!jcur) && (setupNonNull)) return (TRY_AGAIN); - return (CONV_FAIL); - } - - /* Solve the sensitivity linear systems and do the same - tests on the return value of lsolve. */ - - if (do_sensi_sim) { - - for (is=0; is 0) { - if ((!jcur) && (setupNonNull)) return (TRY_AGAIN); - return (CONV_FAIL); - } - } - } - - /* Get WRMS norm of correction; add correction to acor and y */ - - del = N_VWrmsNorm(b, ewt); - N_VLinearSum(ONE, acor, ONE, b, acor); - N_VLinearSum(ONE, zn[0], ONE, acor, y); - - if (do_sensi_sim) { - delS = CVSensUpdateNorm(cv_mem, del, bS, ewtS); - for (is=0; is 0, an estimate of the convergence - rate constant is stored in crate, and used in the test. */ - - Del = (do_sensi_sim) ? delS : del; - if (m > 0) crate = MAX(CRDOWN * crate, Del/Delp); - dcon = Del * MIN(ONE, crate) / tq[4]; - - if (dcon <= ONE) { - if (m == 0) - if (do_sensi_sim && errconS) acnrm = delS; - else acnrm = del; - else { - acnrm = N_VWrmsNorm(acor, ewt); - if (do_sensi_sim && errconS) - acnrm = CVSensUpdateNorm(cv_mem, acnrm, acorS, ewtS); - } - jcur = FALSE; - return (SOLVED); /* Convergence achieved */ - } - - mnewt = ++m; - - /* Stop at maxcor iterations or if iter. seems to be diverging. - If still not converged and Jacobian data is not current, - signal to try the solution again */ - if ((m == maxcor) || ((m >= 2) && (Del > RDIV * Delp))) { - if ((!jcur) && (setupNonNull)) return (TRY_AGAIN); - return (CONV_FAIL); - } - - /* Save norm of correction, evaluate f, and loop again */ - Delp = Del; - f(tn, y, ftemp, f_data); - nfe++; - - if (do_sensi_sim) { - wrk1 = tempv; - wrk2 = tempvS[0]; - CVSensRhs(cv_mem, tn, y, ftemp, yS, ftempS, wrk1, wrk2); - } - - } /* end loop */ - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVHandleFlag - * - * This routine takes action on the return value nflag = *nflagPtr - * returned by CVNls, as follows: - * - * If CVNls succeeded in solving the nonlinear system, then - * CVHandleNFlag returns the constant DO_ERROR_TEST, which tells CVStep - * to perform the error test. - * - * If the nonlinear system was not solved successfully, then ncfn and - * ncf = *ncfPtr are incremented and Nordsieck array zn is restored. - * - * If the solution of the nonlinear system failed due to an - * unrecoverable failure by setup, we return the value SETUP_FAILED. - * - * If it failed due to an unrecoverable failure in solve, then we return - * the value SOLVE_FAILED. - * - * Otherwise, a recoverable failure occurred when solving the - * nonlinear system (CVNls returned nflag == CONV_FAIL). - * In this case, we return the value REP_CONV_FAIL if ncf is now - * equal to maxncf or |h| = hmin. - * If not, we set *nflagPtr = PREV_CONV_FAIL and return the value - * PREDICT_AGAIN, telling CVStep to reattempt the step. - */ - -static int CVHandleNFlag(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, - int *ncfPtr, long int *ncfnPtr) -{ - int nflag; - - nflag = *nflagPtr; - - if (nflag == SOLVED) return (DO_ERROR_TEST); - - /* The nonlinear soln. failed; increment ncfn and restore zn */ - (*ncfnPtr)++; - CVRestore(cv_mem, saved_t); - - /* Return if lsetup or lsolve failed unrecoverably */ - if (nflag == SETUP_FAIL_UNREC) return (SETUP_FAILED); - if (nflag == SOLVE_FAIL_UNREC) return (SOLVE_FAILED); - - /* At this point, nflag == CONV_FAIL; increment ncf */ - - (*ncfPtr)++; - etamax = ONE; - /* If we had maxncf failures or |h| = hmin, return REP_CONV_FAIL */ - if ((ABS(h) <= hmin*ONEPSM) || (*ncfPtr == maxncf)) - return (REP_CONV_FAIL); - - /* Reduce step size; return to reattempt the step */ - eta = MAX(ETACF, hmin / ABS(h)); - *nflagPtr = PREV_CONV_FAIL; - CVRescale(cv_mem); - return (PREDICT_AGAIN); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVRestore - * - * This routine restores the value of tn to saved_t and undoes the - * prediction. After execution of CVRestore, the Nordsieck array zn has - * the same values as before the call to CVPredict. - */ - -static void CVRestore(CVodeMem cv_mem, realtype saved_t) -{ - int j, k; - int is; - - tn = saved_t; - for (k = 1; k <= q; k++) - for (j = q; j >= k; j--) - N_VLinearSum(ONE, zn[j-1], -ONE, zn[j], zn[j-1]); - - if (quadr) { - for (k = 1; k <= q; k++) - for (j = q; j >= k; j--) - N_VLinearSum(ONE, znQ[j-1], -ONE, znQ[j], znQ[j-1]); - } - - if (sensi) { - for (is=0; is= k; j--) - N_VLinearSum(ONE, znS[j-1][is], -ONE, znS[j][is], znS[j-1][is]); - } - } -} - -/*-----------------------------------------------------------------*/ - -/* - * CVDoErrorTest - * - * This routine performs the local error test. - * The weighted local error norm dsm is loaded into *dsmPtr, and - * the test dsm ?<= 1 is made. - * - * If the test passes, CVDoErrorTest returns TRUE. - * - * If the test fails, we undo the step just taken (call CVRestore), - * set *nflagPtr to PREV_ERR_FAIL, and return FALSE. - * - * If maxnef error test failures have occurred or if ABS(h) = hmin, - * we set *kflagPtr = REP_ERR_FAIL. (Otherwise *kflagPtr has the - * value last returned by CVHandleNFlag.) - * - * If more than MXNEF1 error test failures have occurred, an order - * reduction is forced. If already at order 1 restart by reloading - * zn from scratch. Note that if sensitivities are computed, znS is - * also reloaded, no matter what 'ism' or 'errconS' are. Same for - * quadratures. - */ - -static booleantype CVDoErrorTest(CVodeMem cv_mem, int *nflagPtr, - int *kflagPtr, realtype saved_t, - int *nefPtr, realtype *dsmPtr) -{ - realtype dsm; - int is; - N_Vector wrk1, wrk2; - - dsm = acnrm / tq[2]; - - /* If est. local error norm dsm passes test, return TRUE */ - *dsmPtr = dsm; - if (dsm <= ONE) return (TRUE); - - /* Test failed; increment counters, set nflag, and restore zn array */ - (*nefPtr)++; - netf++; - *nflagPtr = PREV_ERR_FAIL; - CVRestore(cv_mem, saved_t); - - /* At maxnef failures or |h| = hmin, return with kflag = REP_ERR_FAIL */ - if ((ABS(h) <= hmin*ONEPSM) || (*nefPtr == maxnef)) { - *kflagPtr = REP_ERR_FAIL; - return (FALSE); - } - - /* Set etamax = 1 to prevent step size increase at end of this step */ - etamax = ONE; - - /* Set h ratio eta from dsm, rescale, and return for retry of step */ - if (*nefPtr <= MXNEF1) { - eta = ONE / (RPowerR(BIAS2*dsm,ONE/L) + ADDON); - eta = MAX(ETAMIN, MAX(eta, hmin / ABS(h))); - if (*nefPtr >= SMALL_NEF) eta = MIN(eta, ETAMXF); - CVRescale(cv_mem); - return (FALSE); - } - - /* After MXNEF1 failures, force an order reduction and retry step */ - if (q > 1) { - eta = MAX(ETAMIN, hmin / ABS(h)); - CVAdjustOrder(cv_mem,-1); - L = q; - q--; - qwait = L; - CVRescale(cv_mem); - return (FALSE); - } - - /* If already at order 1, restart: reload zn from scratch */ - eta = MAX(ETAMIN, hmin / ABS(h)); - h *= eta; - hscale = h; - qwait = LONG_WAIT; - nscon = 0; - - f(tn, zn[0], tempv, f_data); - nfe++; - N_VScale(h, tempv, zn[1]); - - if (quadr) { - fQ(tn, zn[0], tempvQ, fQ_data); - nfQe++; - N_VScale(h, tempvQ, znQ[1]); - } - - if (sensi) { - wrk1 = ftemp; - wrk2 = ftempS[0]; - CVSensRhs(cv_mem, tn, zn[0], tempv, znS[0], tempvS, wrk1, wrk2); - for (is=0; is= SMALL_NEF) eta = MIN(eta, ETAMXF); - CVRescale(cv_mem); - return (FALSE); - } - - /* After MXNEF1 failures, force an order reduction and retry step */ - if (q > 1) { - eta = MAX(ETAMIN, hmin / ABS(h)); - CVAdjustOrder(cv_mem,-1); - L = q; - q--; - qwait = L; - CVRescale(cv_mem); - return (FALSE); - } - - /* If already at order 1, restart: reload zn and znQ from scratch */ - eta = MAX(ETAMIN, hmin / ABS(h)); - h *= eta; - hscale = h; - qwait = LONG_WAIT; - nscon = 0; - - f(tn, zn[0], tempv, f_data); - nfe++; - N_VScale(h, tempv, zn[1]); - - fQ(tn, zn[0], tempvQ, fQ_data); - nfQe++; - N_VScale(h, tempvQ, znQ[1]); - - if (sensi) { - wrk1 = ftemp; - wrk2 = ftempS[0]; - CVSensRhs(cv_mem, tn, zn[0], tempv, znS[0], tempvS, wrk1, wrk2); - for (is=0; is 0, an estimate of the convergence - rate constant is stored in crateS, and used in the test. - acnrmS contains the norm of the corrections (yS_n-yS_n(0)) and - will be used in the error test (if errconS==TRUE) */ - if (m > 0) crateS = MAX(CRDOWN * crateS, Del / Delp); - dcon = Del * MIN(ONE, crateS) / tq[4]; - - if (dcon <= ONE) { - if (errconS) - acnrmS = (m==0)? Del : CVSensNorm(cv_mem, acorS, ewtS); - return (SOLVED); /* Convergence achieved */ - } - - /* Stop at maxcor iterations or if iter. seems to be diverging */ - m++; - if ((m==maxcorS) || ((m >= 2) && (Del > RDIV * Delp))) - return (CONV_FAIL); - - /* Save norm of correction, evaluate f, and loop again */ - Delp = Del; - - wrk1 = tempv; - wrk2 = ftempS[0]; - CVSensRhs(cv_mem, tn, y, ftemp, yS, tempvS, wrk1, wrk2); - - } /* end loop */ - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVStgrNlsNewton - * - * This routine attempts to solve the sensitivity linear systems using - * Newton iteration. It calls CVStgrNlsNewton to perform the actual - * iteration. If the Newton iteration fails with out-of-date Jacobian - * data (ier=TRY_AGAIN), it calls lsetup and retries the Newton iteration. - * This second try is unlikely to happen when using a Krylov linear solver. - * - * Possible return values: - * SOLVED - * CONV_FAIL - * SOLVE_FAIL_UNREC - * SETUP_FAIL_UNREC - */ - -static int CVStgrNlsNewton(CVodeMem cv_mem) -{ - int is; - int convfail, ier; - booleantype callSetup; - N_Vector vtemp1, vtemp2, vtemp3, wrk1, wrk2; - - callSetup = FALSE; - - loop { - - /* Set acorS to zero and load prediction into yS vector */ - for (is=0; is 0) return (CONV_FAIL); - - } /* end loop */ - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVstgrNewtonIteration - * - * This routine performs the Newton iteration for all sensitivities. - * If the iteration succeeds, it returns the value SOLVED. - * If not, it may signal the CVStgrNlsNewton routine to call lsetup and - * reattempt the iteration, by returning the value TRY_AGAIN. (In this case, - * CVStgrNlsNewton must set convfail to CV_FAIL_BAD_J before calling setup again). - * Otherwise, this routine returns one of the appropriate values - * SOLVE_FAIL_UNREC or CONV_FAIL back to CVStgrNlsNewton. - */ - -static int CVStgrNewtonIteration(CVodeMem cv_mem) -{ - int m, ret; - realtype Del, Delp=0.0, dcon; - N_Vector *bS, wrk1, wrk2; - int is; - - m = 0; - - /* ftemp <- f(t_n, y_n) - y <- y_n - ftempS <- fS(t_n, y_n(0), s_n(0)) - acorS <- 0 - yS <- yS_n(0) */ - - loop { - - /* Evaluate the residual of the nonlinear systems */ - for (is=0; is 0) { - if ((!jcur) && (setupNonNull)) return (TRY_AGAIN); - return (CONV_FAIL); - } - - } - - /* Get norm of correction; add correction to acorS and yS */ - Del = CVSensNorm(cv_mem, bS, ewtS); - for (is=0; is 0, an estimate of the convergence - rate constant is stored in crateS, and used in the test. */ - if (m > 0) crateS = MAX(CRDOWN * crateS, Del/Delp); - dcon = Del * MIN(ONE, crateS) / tq[4]; - if (dcon <= ONE) { - if (errconS) - acnrmS = (m==0) ? Del : CVSensNorm(cv_mem, acorS, ewtS); - jcur = FALSE; - return (SOLVED); /* Convergence achieved */ - } - - m++; - - /* Stop at maxcor iterations or if iter. seems to be diverging. - If still not converged and Jacobian data is not current, - signal to try the solution again */ - if ((m == maxcorS) || ((m >= 2) && (Del > RDIV * Delp))) { - if ((!jcur) && (setupNonNull)) return (TRY_AGAIN); - return (CONV_FAIL); - } - - /* Save norm of correction, evaluate fS, and loop again */ - Delp = Del; - - wrk1 = tempv; - wrk2 = tempvS[0]; - CVSensRhs(cv_mem, tn, y, ftemp, yS, ftempS, wrk1, wrk2); - - } /* end loop */ - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVStgr1Nls - * - * This is a high-level routine that attempts to solve the i-th - * sensitivity linear system using nonlinear iterations (CV_FUNCTIONAL - * or CV_NEWTON - depending on the value of iter) once the states y_n - * were obtained and passed the error test. - */ - -static int CVStgr1Nls(CVodeMem cv_mem, int is) -{ - int flag=SOLVED; - - switch(iter) { - case CV_FUNCTIONAL: - flag = CVStgr1NlsFunctional(cv_mem,is); - break; - case CV_NEWTON: - flag = CVStgr1NlsNewton(cv_mem,is); - break; - } - - return(flag); - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVStgr1NlsFunctional - * - * This routine attempts to solve the i-th sensitivity linear system - * using functional iteration (no matrices involved). - * - * Possible return values: - * SOLVED - * CONV_FAIL - */ - -static int CVStgr1NlsFunctional(CVodeMem cv_mem, int is) -{ - int m; - realtype Del, Delp=0.0, dcon; - N_Vector wrk1, wrk2; - - /* Initialize estimated conv. rate and counter */ - crateS = ONE; - m = 0; - - /* Evaluate fS at predicted yS but with converged y (and corresponding f) */ - wrk1 = tempv; - wrk2 = ftempS[0]; - CVSensRhs1(cv_mem, tn, y, ftemp, is, znS[0][is], tempvS[is], wrk1, wrk2); - - /* Initialize correction to zero */ - N_VConst(ZERO,acorS[is]); - - /* Loop until convergence; accumulate corrections in acorS */ - - loop { - - nniS1[is]++; - - /* Correct yS from last fS value */ - N_VLinearSum(h, tempvS[is], -ONE, znS[1][is], tempvS[is]); - N_VScale(rl1, tempvS[is], tempvS[is]); - N_VLinearSum(ONE, znS[0][is], ONE, tempvS[is], yS[is]); - - /* Get WRMS norm of current correction to use in convergence test */ - N_VLinearSum(ONE, tempvS[is], -ONE, acorS[is], acorS[is]); - Del = N_VWrmsNorm(acorS[is], ewtS[is]); - N_VScale(ONE, tempvS[is], acorS[is]); - - /* Test for convergence. If m > 0, an estimate of the convergence - rate constant is stored in crateS, and used in the test. */ - - if (m > 0) crateS = MAX(CRDOWN * crateS, Del / Delp); - dcon = Del * MIN(ONE, crateS) / tq[4]; - - if (dcon <= ONE) { - return (SOLVED); /* Convergence achieved */ - } - - /* Stop at maxcor iterations or if iter. seems to be diverging */ - m++; - if ((m==maxcorS) || ((m >= 2) && (Del > RDIV * Delp))) - return (CONV_FAIL); - - /* Save norm of correction, evaluate f, and loop again */ - Delp = Del; - - wrk1 = tempv; - wrk2 = ftempS[0]; - CVSensRhs1(cv_mem, tn, y, ftemp, is, yS[is], tempvS[is], wrk1, wrk2); - - } /* end loop */ - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVStgr1NlsNewton - * - * This routine attempts to solve the i-th sensitivity linear system - * using Newton iteration. It calls CVStgr1NlsNewton to perform the - * actual iteration. If the Newton iteration fails with out-of-date - * Jacobian data (ier=TRY_AGAIN), it calls lsetup and retries the - * Newton iteration. This second try is unlikely to happen when - * using a Krylov linear solver. - * - * Possible return values: - * SOLVED - * CONV_FAIL - * SOLVE_FAIL_UNREC - * SETUP_FAIL_UNREC - */ - -static int CVStgr1NlsNewton(CVodeMem cv_mem, int is) -{ - int convfail, ier; - booleantype callSetup; - N_Vector vtemp1, vtemp2, vtemp3, wrk1, wrk2; - - callSetup = FALSE; - - loop { - - /* Set acorS to zero and load prediction into yS vector */ - N_VConst(ZERO, acorS[is]); - N_VScale(ONE, znS[0][is], yS[is]); - - /* Evaluate fS at predicted yS but with converged y (and corresponding f) */ - wrk1 = tempv; - wrk2 = tempvS[0]; - CVSensRhs1(cv_mem, tn, y, ftemp, is, yS[is], ftempS[is], wrk1, wrk2); - - /* Do the Newton iteration */ - ier = CVStgr1NewtonIteration(cv_mem, is); - - /* If the solve was successful (ier=SOLVED) or if an error - that cannot be fixed by a call to lsetup occured - (ier = SOLVE_FAIL_UNREC or CONV_FAIL) return */ - if (ier != TRY_AGAIN) return (ier); - - /* There was a convergence failure and the Jacobian-related data - appears not to be current. Call lsetup with convfail=CV_FAIL_BAD_J - and then loop again */ - callSetup = TRUE; - convfail = CV_FAIL_BAD_J; - - /* Rename some vectors for readibility */ - vtemp1 = tempv; - vtemp2 = yS[0]; - vtemp3 = ftempS[0]; - - /* Call linear solver setup at converged y */ - ier = lsetup(cv_mem, convfail, y, ftemp, &jcur, - vtemp1, vtemp2, vtemp3); - nsetups++; - nsetupsS++; - gamrat = ONE; - crate = ONE; - crateS = ONE; /* after lsetup all conv. rates are reset to ONE */ - gammap = gamma; - nstlp = nst; - - /* Return if lsetup failed */ - if (ier < 0) return (SETUP_FAIL_UNREC); - if (ier > 0) return (CONV_FAIL); - - } /* end loop */ - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVStgr1Newtoniteration - * - * This routine performs the Newton iteration for the i-th sensitivity. - * If the iteration succeeds, it returns the value SOLVED. - * If not, it may signal the CVStgr1NlsNewton routine to call lsetup - * and reattempt the iteration, by returning the value TRY_AGAIN. - * (In this case, CVStgr1NlsNewton must set convfail to CV_FAIL_BAD_J - * before calling setup again). Otherwise, this routine returns one - * of the appropriate values SOLVE_FAIL_UNREC or CONV_FAIL back to - * CVStgr1NlsNewton. - */ - -static int CVStgr1NewtonIteration(CVodeMem cv_mem, int is) -{ - int m, ret; - realtype Del, Delp=0.0, dcon; - N_Vector *bS, wrk1, wrk2; - - m = 0; - - /* ftemp <- f(t_n, y_n) - y <- y_n - ftempS[is] <- fS(is, t_n, y_n(0), s_n(0)) - acorS[is] <- 0 - yS[is] <- yS_n(0)[is] */ - - loop { - - /* Evaluate the residual of the nonlinear systems */ - N_VLinearSum(rl1, znS[1][is], ONE, acorS[is], tempvS[is]); - N_VLinearSum(gamma, ftempS[is], -ONE, tempvS[is], tempvS[is]); - - /* Call the lsolve function */ - bS = tempvS; - - nniS1[is]++; - - ret = lsolve(cv_mem, bS[is], ewtS[is], y, ftemp); - - /* Unrecoverable error in lsolve */ - if (ret < 0) return (SOLVE_FAIL_UNREC); - - /* Recoverable error in lsolve and Jacobian data not current */ - if (ret > 0) { - if ((!jcur) && (setupNonNull)) return (TRY_AGAIN); - return (CONV_FAIL); - } - - /* Get norm of correction; add correction to acorS and yS */ - Del = N_VWrmsNorm(bS[is], ewtS[is]); - N_VLinearSum(ONE, acorS[is], ONE, bS[is], acorS[is]); - N_VLinearSum(ONE, znS[0][is], ONE, acorS[is], yS[is]); - - /* Test for convergence. If m > 0, an estimate of the convergence - rate constant is stored in crateS, and used in the test. */ - if (m > 0) crateS = MAX(CRDOWN * crateS, Del/Delp); - dcon = Del * MIN(ONE, crateS) / tq[4]; - if (dcon <= ONE) { - jcur = FALSE; - return (SOLVED); /* Convergence achieved */ - } - - m++; - - /* Stop at maxcor iterations or if iter. seems to be diverging. - If still not converged and Jacobian data is not current, - signal to try the solution again */ - if ((m == maxcorS) || ((m >= 2) && (Del > RDIV * Delp))) { - if ((!jcur) && (setupNonNull)) return (TRY_AGAIN); - return (CONV_FAIL); - } - - /* Save norm of correction, evaluate fS, and loop again */ - Delp = Del; - - wrk1 = tempv; - wrk2 = tempvS[0]; - CVSensRhs1(cv_mem, tn, y, ftemp, is, yS[is], ftempS[is], wrk1, wrk2); - - } /* end loop */ - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVStgrDoErrorTest (CV_STAGGERED or CV_STAGGERED1 approach) - * - * This routine performs the local error test on the sensitivity vars. - * The local error norm is loaded into dsmS, and the test dsmS ?<= 1 - * is made. - * - * If the test passes for all sensitivities, CVStgrDoErrorTest returns - * TRUE. - * - * If the test fails, we proceed like in CVDoErrorTest. - */ - -static booleantype CVStgrDoErrorTest(CVodeMem cv_mem, int *nflagPtr, - int *kflagPtr, realtype saved_t, - int *nefSPtr, realtype *dsmSPtr) -{ - int is; - realtype dsmS; - N_Vector wrk1, wrk2; - - dsmS = acnrmS / tq[2]; - - /* If dsmS passes test, return TRUE */ - *dsmSPtr = dsmS; - if (dsmS <= ONE) return (TRUE); - - /* Test failed; increment counters, set nflag, and restore zn, znS arrays */ - (*nefSPtr)++; - netfS++; - *nflagPtr = PREV_ERR_FAIL; - CVRestore(cv_mem, saved_t); - - /* At maxnef failures or |h| = hmin, return with nflag = REP_ERR_FAIL */ - if ((ABS(h) <= hmin*ONEPSM) || ( (*nefSPtr) == maxnef)) { - *kflagPtr = REP_ERR_FAIL; - return (FALSE); - } - - /* Set etamax = 1 to prevent step size increase at end of this step */ - etamax = ONE; - - /* Set h ratio eta from dsmS, rescale, and return for retry of step */ - if ((*nefSPtr) <= MXNEF1) { - eta = ONE / (RPowerR(BIAS2*dsmS,ONE/L) + ADDON); - eta = MAX(ETAMIN, MAX(eta, hmin / ABS(h))); - if ( (*nefSPtr) >= SMALL_NEF) eta = MIN(eta, ETAMXF); - CVRescale(cv_mem); - return (FALSE); - } - - /* After MXNEF1 failures, force an order reduction and retry step */ - if (q > 1) { - eta = MAX(ETAMIN, hmin / ABS(h)); - CVAdjustOrder(cv_mem,-1); - L = q; - q--; - qwait = L; - CVRescale(cv_mem); - return (FALSE); - } - - /* If already at order 1, restart: reload zn from scratch */ - eta = MAX(ETAMIN, hmin / ABS(h)); - h *= eta; - hscale = h; - qwait = LONG_WAIT; - nscon = 0; - - f(tn, zn[0], tempv, f_data); - nfe++; - N_VScale(h, tempv, zn[1]); - - if (quadr) { - fQ(tn, zn[0], tempvQ, fQ_data); - nfQe++; - N_VScale(h, tempvQ, znQ[1]); - } - - wrk1 = ftemp; - wrk2 = ftempS[0]; - CVSensRhs(cv_mem, tn, zn[0], tempv, znS[0], tempvS, wrk1, wrk2); - for (is=0; is= 2; i--) tau[i] = tau[i-1]; - if ((q==1) && (nst > 1)) tau[2] = tau[1]; - tau[1] = h; - - /* Apply correction to column j of zn: l_j * Delta_n */ - - for (j=0; j <= q; j++) - N_VLinearSum(l[j], acor, ONE, zn[j], zn[j]); - - if (quadr) { - for (j=0; j <= q; j++) - N_VLinearSum(l[j], acorQ, ONE, znQ[j], znQ[j]); - } - - if (sensi) { - for (is=0; is 1) { - - ddn = N_VWrmsNorm(zn[q], ewt); - - if ( quadr && errconQ) { - ddn = CVQuadUpdateNorm(cv_mem, ddn, znQ[q], ewtQ); - } - - if ( sensi && errconS ) { - ddn = CVSensUpdateNorm(cv_mem, ddn, znS[q], ewtS); - } - - ddn = ddn/tq[1]; - - etaqm1 = ONE/(RPowerR(BIAS1*ddn, ONE/q) + ADDON); - - } - - return (etaqm1); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVComputeEtaqp1 - * - * This routine computes and returns the value of etaqp1 for a - * possible increase in order by 1. - */ - -static realtype CVComputeEtaqp1(CVodeMem cv_mem) -{ - realtype dup, cquot; - int is; - - etaqp1 = ZERO; - - if (q != qmax) { - - cquot = (tq[5] / saved_tq5) * RPowerI(h/tau[2], L); - - N_VLinearSum(-cquot, zn[qmax], ONE, acor, tempv); - - dup = N_VWrmsNorm(tempv, ewt); - - if ( quadr && errconQ ) { - N_VLinearSum(-cquot, znQ[qmax], ONE, acorQ, tempvQ); - dup = CVQuadUpdateNorm(cv_mem, dup, tempvQ, ewtQ); - } - - if ( sensi && errconS ) { - for (is=0; is= 3) { - for (k = 1; k <= 3; k++) - for (i = 5; i >= 2; i--) - ssdat[i][k] = ssdat[i-1][k]; - factorial = 1; - for (i = 1; i <= q-1; i++) factorial *= i; - sq = factorial*q*(q+1)*acnrm/tq[5]; - sqm1 = factorial*q*N_VWrmsNorm(zn[q], ewt); - sqm2 = factorial*N_VWrmsNorm(zn[q-1], ewt); - ssdat[1][1] = sqm2*sqm2; - ssdat[1][2] = sqm1*sqm1; - ssdat[1][3] = sq*sq; - } - - if (qprime >= q) { - - /* If order is 3 or greater, and enough ssdat has been saved, - nscon >= q+5, then call stability limit detection routine. */ - - if ( (q >= 3) && (nscon >= q+5) ) { - ldflag = CVsldet(cv_mem); - if (ldflag > 3) { - /* A stability limit violation is indicated by - a return flag of 4, 5, or 6. - Reduce new order. */ - qprime = q-1; - eta = etaqm1; - eta = MIN(eta,etamax); - eta = eta/MAX(ONE,ABS(h)*hmax_inv*eta); - hprime = h*eta; - nor = nor + 1; - } - } - } - else { - /* Otherwise, let order increase happen, and - reset stability limit counter, nscon. */ - nscon = 0; - } -} - -/*-----------------------------------------------------------------*/ - -/* - * CVsldet - * - * This routine detects stability limitation using stored scaled - * derivatives data. CVsldet returns the magnitude of the - * dominate characteristic root, rr. The presents of a stability - * limit is indicated by rr > "something a little less then 1.0", - * and a positive kflag. This routine should only be called if - * order is greater than or equal to 3, and data has been collected - * for 5 time steps. - * - * Returned values: - * kflag = 1 -> Found stable characteristic root, normal matrix case - * kflag = 2 -> Found stable characteristic root, quartic solution - * kflag = 3 -> Found stable characteristic root, quartic solution, - * with Newton correction - * kflag = 4 -> Found stability violation, normal matrix case - * kflag = 5 -> Found stability violation, quartic solution - * kflag = 6 -> Found stability violation, quartic solution, - * with Newton correction - * - * kflag < 0 -> No stability limitation, - * or could not compute limitation. - * - * kflag = -1 -> Min/max ratio of ssdat too small. - * kflag = -2 -> For normal matrix case, vmax > vrrt2*vrrt2 - * kflag = -3 -> For normal matrix case, The three ratios - * are inconsistent. - * kflag = -4 -> Small coefficient prevents elimination of quartics. - * kflag = -5 -> R value from quartics not consistent. - * kflag = -6 -> No corrected root passes test on qk values - * kflag = -7 -> Trouble solving for sigsq. - * kflag = -8 -> Trouble solving for B, or R via B. - * kflag = -9 -> R via sigsq[k] disagrees with R from data. - */ - -static int CVsldet(CVodeMem cv_mem) -{ - int i, k, j, it, kmin=0, kflag=0; - realtype rat[5][4], rav[4], qkr[4], sigsq[4], smax[4], ssmax[4]; - realtype drr[4], rrc[4],sqmx[4], qjk[4][4], vrat[5], qc[6][4], qco[6][4]; - realtype rr, rrcut, vrrtol, vrrt2, sqtol, rrtol; - realtype smink, smaxk, sumrat, sumrsq, vmin, vmax, drrmax, adrr; - realtype small, tem, sqmax, saqk, qp, s, sqmaxk, saqj, sqmin; - realtype rsa, rsb, rsc, rsd, rse, rd1a, rd1b, rd1c, rd1d; - realtype rd2a, rd2b, rd2c, rd3a, rd3b, cest1, corr1; - realtype ratp, ratm, qfac1, qfac2, bb, rrb; - - /* The following are cutoffs and tolerances used by this routine */ - - rrcut = RCONST(0.98); - vrrtol = RCONST(1.0e-4); - vrrt2 = RCONST(5.0e-4); - sqtol = RCONST(1.0e-3); - rrtol = RCONST(1.0e-2); - - rr = ZERO; - - /* Index k corresponds to the degree of the interpolating polynomial. */ - /* k = 1 -> q-1 */ - /* k = 2 -> q */ - /* k = 3 -> q+1 */ - - /* Index i is a backward-in-time index, i = 1 -> current time, */ - /* i = 2 -> previous step, etc */ - - /* get maxima, minima, and variances, and form quartic coefficients */ - - for (k=1; k<=3; k++) { - smink = ssdat[1][k]; - smaxk = ZERO; - - for (i=1; i<=5; i++) { - smink = MIN(smink,ssdat[i][k]); - smaxk = MAX(smaxk,ssdat[i][k]); - } - - if (smink < TINY*smaxk) { - kflag = -1; - return (kflag); - } - smax[k] = smaxk; - ssmax[k] = smaxk*smaxk; - - sumrat = ZERO; - sumrsq = ZERO; - for (i=1; i<=4; i++) { - rat[i][k] = ssdat[i][k]/ssdat[i+1][k]; - sumrat = sumrat + rat[i][k]; - sumrsq = sumrsq + rat[i][k]*rat[i][k]; - } - rav[k] = FOURTH*sumrat; - vrat[k] = ABS(FOURTH*sumrsq - rav[k]*rav[k]); - - qc[5][k] = ssdat[1][k]*ssdat[3][k] - ssdat[2][k]*ssdat[2][k]; - qc[4][k] = ssdat[2][k]*ssdat[3][k] - ssdat[1][k]*ssdat[4][k]; - qc[3][k] = ZERO; - qc[2][k] = ssdat[2][k]*ssdat[5][k] - ssdat[3][k]*ssdat[4][k]; - qc[1][k] = ssdat[4][k]*ssdat[4][k] - ssdat[3][k]*ssdat[5][k]; - - for (i=1; i<=5; i++) { - qco[i][k] = qc[i][k]; - } - } /* End of k loop */ - - /* Isolate normal or nearly-normal matrix case. Three quartic will - have common or nearly-common roots in this case. - Return a kflag = 1 if this procedure works. If three root - differ more than vrrt2, return error kflag = -3. */ - - vmin = MIN(vrat[1],MIN(vrat[2],vrat[3])); - vmax = MAX(vrat[1],MAX(vrat[2],vrat[3])); - - if (vmin < vrrtol*vrrtol) { - - if (vmax > vrrt2*vrrt2) { - kflag = -2; - return (kflag); - } else { - rr = (rav[1] + rav[2] + rav[3])/THREE; - drrmax = ZERO; - for (k = 1;k<=3;k++) { - adrr = ABS(rav[k] - rr); - drrmax = MAX(drrmax, adrr); - } - if (drrmax > vrrt2) - kflag = -3; - kflag = 1; - /* can compute charactistic root, drop to next section */ - } - - } else { - - /* use the quartics to get rr. */ - - if (ABS(qco[1][1]) < TINY*ssmax[1]) { - small = qco[1][1]; - kflag = -4; - return (kflag); - } - - tem = qco[1][2]/qco[1][1]; - for (i=2; i<=5; i++) { - qco[i][2] = qco[i][2] - tem*qco[i][1]; - } - - qco[1][2] = ZERO; - tem = qco[1][3]/qco[1][1]; - for (i=2; i<=5; i++) { - qco[i][3] = qco[i][3] - tem*qco[i][1]; - } - qco[1][3] = ZERO; - - if (ABS(qco[2][2]) < TINY*ssmax[2]) { - small = qco[2][2]; - kflag = -4; - return (kflag); - } - - tem = qco[2][3]/qco[2][2]; - for (i=3; i<=5; i++) { - qco[i][3] = qco[i][3] - tem*qco[i][2]; - } - - if (ABS(qco[4][3]) < TINY*ssmax[3]) { - small = qco[4][3]; - kflag = -4; - return (kflag); - } - - rr = -qco[5][3]/qco[4][3]; - - if (rr < TINY || rr > HUN) { - kflag = -5; - return (kflag); - } - - for (k=1; k<=3; k++) { - qkr[k] = qc[5][k] + rr*(qc[4][k] + rr*rr*(qc[2][k] + rr*qc[1][k])); - } - - sqmax = ZERO; - for (k=1; k<=3; k++) { - saqk = ABS(qkr[k])/ssmax[k]; - if (saqk > sqmax) sqmax = saqk; - } - - if (sqmax < sqtol) { - kflag = 2; - - /* can compute charactistic root, drop to "given rr,etc" */ - - } else { - - /* do Newton corrections to improve rr. */ - - for (it=1; it<=3; it++) { - for (k=1; k<=3; k++) { - qp = qc[4][k] + rr*rr*(THREE*qc[2][k] + rr*FOUR*qc[1][k]); - drr[k] = ZERO; - if (ABS(qp) > TINY*ssmax[k]) drr[k] = -qkr[k]/qp; - rrc[k] = rr + drr[k]; - } - - for (k=1; k<=3; k++) { - s = rrc[k]; - sqmaxk = ZERO; - for (j=1; j<=3; j++) { - qjk[j][k] = qc[5][j] + s*(qc[4][j] + - s*s*(qc[2][j] + s*qc[1][j])); - saqj = ABS(qjk[j][k])/ssmax[j]; - if (saqj > sqmaxk) sqmaxk = saqj; - } - sqmx[k] = sqmaxk; - } - - sqmin = sqmx[1] + ONE; - for (k=1; k<=3; k++) { - if (sqmx[k] < sqmin) { - kmin = k; - sqmin = sqmx[k]; - } - } - rr = rrc[kmin]; - - if (sqmin < sqtol) { - kflag = 3; - /* can compute charactistic root */ - /* break out of Newton correction loop and drop to "given rr,etc" */ - break; - } else { - for (j=1; j<=3; j++) { - qkr[j] = qjk[j][kmin]; - } - } - } /* end of Newton correction loop */ - - if (sqmin > sqtol) { - kflag = -6; - return (kflag); - } - } /* end of if (sqmax < sqtol) else */ - } /* end of if (vmin < vrrtol*vrrtol) else, quartics to get rr. */ - - /* given rr, find sigsq[k] and verify rr. */ - /* All positive kflag drop to this section */ - - for (k=1; k<=3; k++) { - rsa = ssdat[1][k]; - rsb = ssdat[2][k]*rr; - rsc = ssdat[3][k]*rr*rr; - rsd = ssdat[4][k]*rr*rr*rr; - rse = ssdat[5][k]*rr*rr*rr*rr; - rd1a = rsa - rsb; - rd1b = rsb - rsc; - rd1c = rsc - rsd; - rd1d = rsd - rse; - rd2a = rd1a - rd1b; - rd2b = rd1b - rd1c; - rd2c = rd1c - rd1d; - rd3a = rd2a - rd2b; - rd3b = rd2b - rd2c; - - if (ABS(rd1b) < TINY*smax[k]) { - kflag = -7; - return (kflag); - } - - cest1 = -rd3a/rd1b; - if (cest1 < TINY || cest1 > FOUR) { - kflag = -7; - return (kflag); - } - corr1 = (rd2b/cest1)/(rr*rr); - sigsq[k] = ssdat[3][k] + corr1; - } - - if (sigsq[2] < TINY) { - kflag = -8; - return (kflag); - } - - ratp = sigsq[3]/sigsq[2]; - ratm = sigsq[1]/sigsq[2]; - qfac1 = FOURTH*(q*q - ONE); - qfac2 = TWO/(q - ONE); - bb = ratp*ratm - ONE - qfac1*ratp; - tem = ONE - qfac2*bb; - - if (ABS(tem) < TINY) { - kflag = -8; - return (kflag); - } - - rrb = ONE/tem; - - if (ABS(rrb - rr) > rrtol) { - kflag = -9; - return (kflag); - } - - /* Check to see if rr is above cutoff rrcut */ - if (rr > rrcut) { - if (kflag == 1) kflag = 4; - if (kflag == 2) kflag = 5; - if (kflag == 3) kflag = 6; - } - - /* All positive kflag returned at this point */ - - return (kflag); - -} - -/*=================================================================*/ -/* Root finding */ -/*=================================================================*/ - - -/*-----------------------------------------------------------------*/ - -/* - * CVRcheck1 - * - * This routine completes the initialization of rootfinding memory - * information, and checks whether g has a zero both at and very near - * the initial point of the IVP. - * - * This routine returns an int equal to: - * INITROOT = -1 if a close pair of zeros was found, and - * CV_SUCCESS = 0 otherwise. - */ - -static int CVRcheck1(CVodeMem cv_mem) -{ - int i; - realtype smallh, hratio; - booleantype zroot; - - for (i = 0; i < nrtfn; i++) iroots[i] = 0; - tlo = tn; - ttol = (ABS(tn) + ABS(h))*uround*HUN; - - /* Evaluate g at initial t and check for zero values. */ - gfun (tlo, zn[0], glo, g_data); - nge = 1; - zroot = FALSE; - for (i = 0; i < nrtfn; i++) { - if (ABS(glo[i]) == ZERO) zroot = TRUE; - } - if (!zroot) return(CV_SUCCESS); - - /* Some g_i is zero at t0; look at g at t0+(small increment). */ - smallh = (h > ZERO) ? ttol : -ttol; - tlo += smallh; - hratio = smallh/h; - N_VLinearSum(ONE, zn[0], hratio, zn[1], y); - gfun (tlo, y, glo, g_data); nge++; - zroot = FALSE; - for (i = 0; i < nrtfn; i++) { - if (ABS(glo[i]) == ZERO) { - zroot = TRUE; - iroots[i] = 1; - } - } - if (zroot) return(INITROOT); - return(CV_SUCCESS); - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVRcheck2 - * - * This routine checks for exact zeros of g at the last root found, - * if the last return was a root. It then checks for a close - * pair of zeros (an error condition), and for a new root at a - * nearby point. The left endpoint (tlo) of the search interval - * is adjusted if necessary to assure that all g_i are nonzero - * there, before returning to do a root search in the interval. - * - * On entry, tlo = tretlast is the last value of tret returned by - * CVode. This may be the previous tn, the previous tout value, or - * the last root location. - * - * This routine returns an int equal to: - * CLOSERT = -2 if a close pair of zeros was found, - * RTFOUND = 1 if a new zero of g was found near tlo, or - * CV_SUCCESS = 0 otherwise. - */ - -static int CVRcheck2(CVodeMem cv_mem) -{ - int i; - realtype smallh, hratio; - booleantype zroot; - - if (irfnd == 0) return (CV_SUCCESS); - - (void) CVodeGetDky(cv_mem, tlo, 0, y); - gfun (tlo, y, glo, g_data); nge++; - zroot = FALSE; - for (i = 0; i < nrtfn; i++) iroots[i] = 0; - for (i = 0; i < nrtfn; i++) { - if (ABS(glo[i]) == ZERO) { - zroot = TRUE; - iroots[i] = 1; - } - } - if (!zroot) return(CV_SUCCESS); - - /* One or more g_i has a zero at tlo. Check g at tlo+smallh. */ - ttol = (ABS(tn) + ABS(h))*uround*HUN; - smallh = (h > ZERO) ? ttol : -ttol; - tlo += smallh; - if ( (tlo - tn)*h >= ZERO) { - hratio = smallh/h; - N_VLinearSum(ONE, y, hratio, zn[1], y); - } else { - (void) CVodeGetDky(cv_mem, tlo, 0, y); - } - gfun (tlo, y, glo, g_data); nge++; - zroot = FALSE; - for (i = 0; i < nrtfn; i++) { - if (ABS(glo[i]) == ZERO) { - if (iroots[i] == 1) return(CLOSERT); - zroot = TRUE; - iroots[i] = 1; - } - } - if (zroot) return(RTFOUND); - return(CV_SUCCESS); - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVRcheck3 - * - * This routine interfaces to CVRootfind to look for a root of g - * between tlo and either tn or tout, whichever comes first. - * Only roots beyond tlo in the direction of integration are sought. - * - * This routine returns an int equal to: - * RTFOUND = 1 if a root of g was found, or - * CV_SUCCESS = 0 otherwise. - */ - -static int CVRcheck3(CVodeMem cv_mem) -{ - int i, ier; - - /* Set thi = tn or tout, whichever comes first; set y = y(thi). */ - if (taskc == CV_ONE_STEP) { - thi = tn; - N_VScale(ONE, zn[0], y); - } - if (taskc == CV_NORMAL) { - if ( (toutc - tn)*h >= ZERO) { - thi = tn; - N_VScale(ONE, zn[0], y); - } else { - thi = toutc; - (void) CVodeGetDky(cv_mem, thi, 0, y); - } - } - - /* Set ghi = g(thi) and call CVRootfind to search (tlo,thi) for roots. */ - gfun (thi, y, ghi, g_data); nge++; - ttol = (ABS(tn) + ABS(h))*uround*HUN; - ier = CVRootfind(cv_mem); - tlo = troot; - for (i = 0; i < nrtfn; i++) glo[i] = groot[i]; - - /* If no root found, return CV_SUCCESS. */ - if (ier == CV_SUCCESS) return(CV_SUCCESS); - - /* If a root was found, interpolate to get y(troot) and return. */ - (void) CVodeGetDky(cv_mem, troot, 0, y); - return (RTFOUND); - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVRootFind - * - * This routine solves for a root of g(t) between tlo and thi, if - * one exists. Only roots of odd multiplicity (i.e. with a change - * of sign in one of the g_i), or exact zeros, are found. - * Here the sign of tlo - thi is arbitrary, but if multiple roots - * are found, the one closest to tlo is returned. - * - * The method used is the Illinois algorithm, a modified secant method. - * Reference: Kathie L. Hiebert and Lawrence F. Shampine, Implicitly - * Defined Output Points for Solutions of ODEs, Sandia National - * Laboratory Report SAND80-0180, February 1980. - * - * This routine uses the following parameters for communication: - * - * nrtfn = number of functions g_i, or number of components of - * the vector-valued function g(t). Input only. - * - * gfun = user-defined function for g(t). Its form is - * (void) gfun(t, y, gt, g_data) - * - * nge = cumulative counter for gfun calls. - * - * ttol = a convergence tolerance for troot. Input only. - * When a root at troot is found, it is located only to - * within a tolerance of ttol. Typically, ttol should - * be set to a value on the order of - * 100 * UROUND * max (ABS(tlo), ABS(thi)) - * where UROUND is the unit roundoff of the machine. - * - * tlo, thi = endpoints of the interval in which roots are sought. - * On input, and must be distinct, but tlo - thi may - * be of either sign. The direction of integration is - * assumed to be from tlo to thi. On return, tlo and thi - * are the endpoints of the final relevant interval. - * - * glo, ghi = arrays of length nrtfn containing the vectors g(tlo) - * and g(thi) respectively. Input and output. On input, - * none of the glo[i] should be zero. - * - * troot = root location, if a root was found, or thi if not. - * Output only. If a root was found other than an exact - * zero of g, troot is the endpoint thi of the final - * interval bracketing the root, with size at most ttol. - * - * groot = array of length nrtfn containing g(troot) on return. - * - * iroots = int array of length nrtfn with root information. - * Output only. If a root was found, iroots indicates - * which components g_i have a root at troot. For - * i = 0, ..., nrtfn-1, iroots[i] = 1 if g_i has a root - * and iroots[i] = 0 otherwise. - * - * This routine returns an int equal to: - * RTFOUND = 1 if a root of g was found, or - * CV_SUCCESS = 0 otherwise. - */ - -static int CVRootfind(CVodeMem cv_mem) -{ - realtype alpha, tmid, gfrac, maxfrac, fracint, fracsub; - int i, imax, side, sideprev; - booleantype zroot, sgnchg; - - imax = 0; - - /* First check for change in sign in ghi or for a zero in ghi. */ - maxfrac = ZERO; - zroot = FALSE; - sgnchg = FALSE; - for (i = 0; i < nrtfn; i++) { - if (ABS(ghi[i]) == ZERO) { - zroot = TRUE; - } else { - if (glo[i]*ghi[i] < ZERO) { - gfrac = ABS(ghi[i]/(ghi[i] - glo[i])); - if (gfrac > maxfrac) { - sgnchg = TRUE; - maxfrac = gfrac; - imax = i; - } - } - } - } - - /* If no sign change was found, reset troot and groot. Then return - CV_SUCCESS if no zero was found, or set iroots and return RTFOUND. */ - if (!sgnchg) { - troot = thi; - for (i = 0; i < nrtfn; i++) groot[i] = ghi[i]; - if (!zroot) return (CV_SUCCESS); - for (i = 0; i < nrtfn; i++) { - iroots[i] = 0; - if (ABS(ghi[i]) == ZERO) iroots[i] = 1; - } - return(RTFOUND); - } - - /* A sign change was found. Loop to locate nearest root. */ - - side = 0; sideprev = -1; - loop { /* Looping point */ - - /* Set weight alpha. - On the first two passes, set alpha = 1. Thereafter, reset alpha - according to the side (low vs high) of the subinterval in which - the sign change was found in the previous two passes. - If the sides were opposite, set alpha = 1. - If the sides were the same, then double alpha (if high side), - or halve alpha (if low side). - The next guess tmid is the secant method value if alpha = 1, but - is closer to tlo if alpha < 1, and closer to thi if alpha > 1. */ - - if (sideprev == side) { - alpha = (side == 2) ? alpha*TWO : alpha*HALF; - } else { - alpha = ONE; - } - - /* Set next root approximation tmid and get g(tmid). - If tmid is too close to tlo or thi, adjust it inward, - by a fractional distance that is between 0.1 and 0.5. */ - tmid = thi - (thi - tlo)*ghi[imax]/(ghi[imax] - alpha*glo[imax]); - if (ABS(tmid - tlo) < HALF*ttol) { - fracint = ABS(thi - tlo)/ttol; - fracsub = (fracint > FIVE) ? TENTH : HALF/fracint; - tmid = tlo + fracsub*(thi - tlo); - } - if (ABS(thi - tmid) < HALF*ttol) { - fracint = ABS(thi - tlo)/ttol; - fracsub = (fracint > FIVE) ? TENTH : HALF/fracint; - tmid = thi - fracsub*(thi - tlo); - } - - (void) CVodeGetDky(cv_mem, tmid, 0, y); - gfun (tmid, y, groot, g_data); nge++; - - /* Check to see in which subinterval g changes sign, and reset imax. - Set side = 1 if sign change is on low side, or 2 if on high side. */ - maxfrac = ZERO; - zroot = FALSE; - sgnchg = FALSE; - sideprev = side; - for (i = 0; i < nrtfn; i++) { - if (ABS(groot[i]) == ZERO) { - zroot = TRUE; - } else { - if (glo[i]*groot[i] < ZERO) { - gfrac = ABS(groot[i]/(groot[i] - glo[i])); - if (gfrac > maxfrac) { - sgnchg = TRUE; - maxfrac = gfrac; - imax = i; - } - } - } - } - if (sgnchg) { - /* Sign change found in (tlo,tmid); replace thi with tmid. */ - thi = tmid; - for (i = 0; i < nrtfn; i++) ghi[i] = groot[i]; - side = 1; - /* Stop at root thi if converged; otherwise loop. */ - if (ABS(thi - tlo) <= ttol) break; - continue; /* Return to looping point. */ - } - - if (zroot) { - /* No sign change in (tlo,tmid), but g = 0 at tmid; return root tmid. */ - thi = tmid; - for (i = 0; i < nrtfn; i++) ghi[i] = groot[i]; - break; - } - - /* No sign change in (tlo,tmid), and no zero at tmid. - Sign change must be in (tmid,thi). Replace tlo with tmid. */ - tlo = tmid; - for (i = 0; i < nrtfn; i++) glo[i] = groot[i]; - side = 2; - /* Stop at root thi if converged; otherwise loop back. */ - if (ABS(thi - tlo) <= ttol) break; - - } /* End of root-search loop */ - - /* Reset troot and groot, set iroots, and return RTFOUND. */ - troot = thi; - for (i = 0; i < nrtfn; i++) { - groot[i] = ghi[i]; - iroots[i] = 0; - if (ABS(ghi[i]) == ZERO) iroots[i] = 1; - if (glo[i]*ghi[i] < ZERO) iroots[i] = 1; - } - return(RTFOUND); -} - -/*=================================================================*/ -/* Combined norms */ -/*=================================================================*/ - -/* - * CVQuadUpdateNorm - * - * Updates the norm old_nrm to account for all quadratures. - */ - -static realtype CVQuadUpdateNorm(CVodeMem cv_mem, realtype old_nrm, - N_Vector xQ, N_Vector wQ) -{ - realtype qnrm; - - qnrm = N_VWrmsNorm(xQ, wQ); - if (old_nrm > qnrm) return(old_nrm); - else return(qnrm); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVQuadUpdateDsm - * - * Usage : dms = CVQuadUpdateDsm(cv_mem, dsm, dsmQ); - * - * This routine updates the local error norm dsm with quadrature - * related information. Used only if quadratures are computed - * with FULL error control. - * - * Returns the maximum over the wheighted local error norms. - */ - -static realtype CVQuadUpdateDsm(CVodeMem cv_mem, realtype old_dsm, - realtype dsmQ) -{ - if ( old_dsm > dsmQ ) return (old_dsm); - else return (dsmQ); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVSensNorm - * - * This routine returns the maximum over the weighted root mean - * square norm of xS with weight vectors wS: - * - * max { wrms(xS[0],wS[0]) ... wrms(xS[Ns-1],wS[Ns-1]) } - * - * Called by CVSensUpdateNorm or directly in the CV_STAGGERED approach - * during the NLS solution and before the error test. - */ - -static realtype CVSensNorm(CVodeMem cv_mem, N_Vector *xS, N_Vector *wS) -{ - int is; - realtype nrm, snrm; - - nrm = N_VWrmsNorm(xS[0],wS[0]); - for (is=1; is nrm ) nrm = snrm; - } - - return (nrm); - -} - -/*-----------------------------------------------------------------*/ - -/* - * CVSensUpdateNorm - * - * Updates the norm old_nrm to account for all sensitivities. - */ - -static realtype CVSensUpdateNorm(CVodeMem cv_mem, realtype old_nrm, - N_Vector *xS, N_Vector *wS) -{ - realtype snrm; - - snrm = CVSensNorm(cv_mem, xS, wS); - if (old_nrm > snrm) return(old_nrm); - else return(snrm); -} - -/*-----------------------------------------------------------------*/ - -/* - * CVStgrUpdateNorm - * - * Usage : dms = CVStgrUpdateDsm(cv_mem, old_dsm, dsmS); - * - * This routine updates the local error norm old_dsm with sensitivity - * related information. Used only in the CV_STAGGERED or CV_STAGGERED1 - * approach with FULL error control.This value is consistent with - * the one computed in CVDoErrorTest when ism=CV_SIMULTANEOUS and - * errconS=TRUE. - * - * Returns the maximum over the wheighted local error norms. - */ - -static realtype CVStgrUpdateDsm(CVodeMem cv_mem, realtype old_dsm, - realtype dsmS) -{ - if ( old_dsm > dsmS ) return (old_dsm); - else return (dsmS); -} - -/*=================================================================*/ -/* Sensitivity RHS Routines */ -/*=================================================================*/ - -/* - * CVSensRhs - * - * CVSensRhs is a high level routine that returns right hand side - * of sensitivity equations. Depending on the 'ifS' flag, it either - * calls directly the fS routine (ifS=CV_ALLSENS) or (if ifS=CV_ONESENS) - * calls the fS1 routine in a loop over all sensitivities. - * - * CVSensRhs is called: - * (*) by Cvode at the first step - * (*) by CVYddNorm if errcon=TRUE - * (*) by CVnlsFunctional, CVnlsNewton, and CVNewtonIteration - * if ism=CV_SIMULTANEOUS - * (*) by CVDoErrorTest when restarting from scratch - * (*) in the corrector loop if ism=CV_STAGGERED - * (*) by CVStgrDoErrorTest when restarting from scratch - */ - -static void CVSensRhs(CVodeMem cv_mem, realtype time, - N_Vector ycur, N_Vector fcur, - N_Vector *yScur, N_Vector *fScur, - N_Vector temp1, N_Vector temp2) -{ - int is; - - if (ifS==CV_ALLSENS) { - fS(Ns, time, ycur, fcur, yScur, fScur, - fS_data, temp1, temp2); - nfSe++; - } else { - for (is=0; is= ZERO) ? CENTERED1 : FORWARD1; - else - method = (rhomax > ZERO) ? CENTERED2 : FORWARD2; - - switch(method) { - - case CENTERED1: - - Delta = MIN(Deltay, Deltap); - r2Delta = HALF/Delta; - - N_VLinearSum(ONE,y,Delta,yS,ytemp); - p[which] = psave + Delta; - f(t, ytemp, ySdot, f_data); - nfel++; - - N_VLinearSum(ONE,y,-Delta,yS,ytemp); - p[which] = psave - Delta; - f(t, ytemp, ftemp, f_data); - nfel++; - - N_VLinearSum(r2Delta,ySdot,-r2Delta,ftemp,ySdot); - - break; - - case CENTERED2: - - r2Deltap = HALF/Deltap; - r2Deltay = HALF/Deltay; - - N_VLinearSum(ONE,y,Deltay,yS,ytemp); - f(t, ytemp, ySdot, f_data); - nfel++; - N_VLinearSum(ONE,y,-Deltay,yS,ytemp); - f(t, ytemp, ftemp, f_data); - nfel++; - N_VLinearSum(r2Deltay, ySdot, -r2Deltay, ftemp, ySdot); - - if (!skipFP) { - p[which] = psave + Deltap; - f(t, y, ytemp, f_data); - nfel++; - p[which] = psave - Deltap; - f(t, y, ftemp, f_data); - nfel++; - N_VLinearSum(r2Deltap,ytemp,-r2Deltap,ftemp,ftemp); - - N_VLinearSum(ONE,ySdot,ONE,ftemp,ySdot); - } - - break; - - case FORWARD1: - - Delta = MIN(Deltay, Deltap); - rDelta = ONE/Delta; - - N_VLinearSum(ONE,y,Delta,yS,ytemp); - p[which] = psave + Delta; - f(t, ytemp, ySdot, f_data); - nfel++; - - N_VLinearSum(rDelta,ySdot,-rDelta,ydot,ySdot); - - break; - - case FORWARD2: - - N_VLinearSum(ONE,y,Deltay,yS,ytemp); - f(t, ytemp, ySdot, f_data); - nfel++; - N_VLinearSum(rDeltay, ySdot, -rDeltay, ydot, ySdot); - - if (!skipFP) { - p[which] = psave + Deltap; - f(t, y, ytemp, f_data); - nfel++; - N_VLinearSum(rDeltap,ytemp,-rDeltap,ydot,ftemp); - - N_VLinearSum(ONE,ySdot,ONE,ftemp,ySdot); - } - - break; - - } - - p[which] = psave; - - /* Increment counter nfeS */ - nfeS += nfel; - -} - diff --git a/src/sundials/cvodes/cvodes.h b/src/sundials/cvodes/cvodes.h deleted file mode 100644 index c344e693fa..0000000000 --- a/src/sundials/cvodes/cvodes.h +++ /dev/null @@ -1,1391 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban - * and Dan Shumaker @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This is the interface file for the main CVODES integrator. - * ----------------------------------------------------------------- - */ - -#ifndef _CVODES_H -#define _CVODES_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include - -#include "sundialstypes.h" -#include "nvector.h" - -/* - * ----------------------------------------------------------------- - * CVODES is used to solve numerically the ordinary initial value - * problem: - * - * y' = f(t,y), - * y(t0) = y0, - * - * where t0, y0 in R^N, and f: R x R^N -> R^N are given. - * - * Optionally, CVODES can perform forward sensitivity analysis - * to find sensitivities of the solution y with respect to - * parameters in the right hand side f and/or in the initial - * conditions y0. - * ----------------------------------------------------------------- - */ - -/* - * ----------------------------------------------------------------- - * Enumerations for inputs to CVodeCreate, CVodeMalloc, - * CVodeReInit, CVodeSensMalloc, CVodeSensReInit, CvodeQuadMalloc, - * CVodeQuadReInit, CVodeSet*, and CVode. - * ----------------------------------------------------------------- - * Symbolic constants for the lmm, iter, and itol input - * parameters to CVodeMalloc and CVodeReInit, as well as the - * input parameter itask to CVode, are given below. - * - * lmm: The user of the CVODES package specifies whether to use - * the CV_ADAMS or CV_BDF (backward differentiation formula) - * linear multistep method. The BDF method is recommended - * for stiff problems, and the CV_ADAMS method is recommended - * for nonstiff problems. - * - * iter: At each internal time step, a nonlinear equation must - * be solved. The user can specify either CV_FUNCTIONAL - * iteration, which does not require linear algebra, or a - * CV_NEWTON iteration, which requires the solution of linear - * systems. In the CV_NEWTON case, the user also specifies a - * CVODE linear solver. CV_NEWTON is recommended in case of - * stiff problems. - * - * itol: This parameter specifies the relative and absolute - * tolerance types to be used. The CV_SS tolerance type means - * a scalar relative and absolute tolerance, while the CV_SV - * tolerance type means a scalar relative tolerance and a - * vector absolute tolerance (a potentially different - * absolute tolerance for each vector component). - * - * itolQ: Same as itol for quadrature variables. - * - * ism: This parameter specifies the sensitivity corrector type - * to be used. In the CV_SIMULTANEOUS case, the nonlinear - * systems for states and all sensitivities are solved - * simultaneously. In the CV_STAGGERED case, the nonlinear - * system for states is solved first and then, the - * nonlinear systems for all sensitivities are solved - * at the same time. Finally, in the CV_STAGGERED1 approach - * all nonlinear systems are solved in a sequence. - * - * itask: The itask input parameter to CVode indicates the job - * of the solver for the next user step. The CV_NORMAL - * itask is to have the solver take internal steps until - * it has reached or just passed the user specified tout - * parameter. The solver then interpolates in order to - * return an approximate value of y(tout). The CV_ONE_STEP - * option tells the solver to just take one internal step - * and return the solution at the point reached by that - * step. The CV_NORMAL_TSTOP and CV_ONE_STEP_TSTOP modes are - * similar to CV_NORMAL and CV_ONE_STEP, respectively, except - * that the integration never proceeds past the value - * tstop (specified through the routine CVodeSetStopTime). - * ----------------------------------------------------------------- - */ - -/* lmm */ -#define CV_ADAMS 1 -#define CV_BDF 2 - -/* iter */ -#define CV_FUNCTIONAL 1 -#define CV_NEWTON 2 - -/* itol */ -#define CV_SS 1 -#define CV_SV 2 -#define CV_EE 3 - -/* itask */ -#define CV_NORMAL 1 -#define CV_ONE_STEP 2 -#define CV_NORMAL_TSTOP 3 -#define CV_ONE_STEP_TSTOP 4 - -/* ism */ -#define CV_SIMULTANEOUS 1 -#define CV_STAGGERED 2 -#define CV_STAGGERED1 3 - -/* - * ================================================================= - * F U N C T I O N T Y P E S - * ================================================================= - */ - -/* - * ----------------------------------------------------------------- - * Type : CVRhsFn - * ----------------------------------------------------------------- - * The f function which defines the right hand side of the ODE - * system y' = f(t,y) must have type CVRhsFn. - * f takes as input the independent variable value t, and the - * dependent variable vector y. It stores the result of f(t,y) - * in the vector ydot. The y and ydot arguments are of type - * N_Vector. - * (Allocation of memory for ydot is handled within CVODES) - * The f_data parameter is the same as the f_data - * parameter set by the user through the CVodeSetFdata routine. - * This user-supplied pointer is passed to the user's f function - * every time it is called. - * A CVRhsFn f does not have a return value. - * ----------------------------------------------------------------- - */ - -typedef void (*CVRhsFn)(realtype t, N_Vector y, - N_Vector ydot, void *f_data); - -/* - * ----------------------------------------------------------------- - * Type : CVRootFn - * ----------------------------------------------------------------- - * A function g, which defines a set of functions g_i(t,y) whose - * roots are sought during the integration, must have type CVRootFn. - * The function g takes as input the independent variable value - * t, and the dependent variable vector y. It stores the nrtfn - * values g_i(t,y) in the realtype array gout. - * (Allocation of memory for gout is handled within CVODE.) - * The g_data parameter is the same as that passed by the user - * to the CVodeSetGdata routine. This user-supplied pointer is - * passed to the user's g function every time it is called. - * A CVRootFn g does not have a return value. - * ----------------------------------------------------------------- - */ - -typedef void (*CVRootFn)(realtype t, N_Vector y, realtype *gout, - void *g_data); - -/* - * ----------------------------------------------------------------- - * Type : CVSensRhsFn - * ----------------------------------------------------------------- - * The fS function which defines the right hand side of the - * sensitivity ODE systems s' = f_y * s + f_p must have type - * CVSensRhsFn. - * fS takes as input the number of sensitivities Ns, the - * independent variable value t, the states y and the - * corresponding value of f(t,y) in ydot, and the dependent - * sensitivity vectors yS. It stores the result of fS in ySdot. - * (Allocation of memory for ySdot is handled within CVODES) - * The fS_data parameter is the same as the fS_data parameter - * set by the user through the CVodeSetSensFdata routine and is - * passed to the fS function every time it is called. - * A CVSensRhsFn function does not have a return value. - * ----------------------------------------------------------------- - */ - -typedef void (*CVSensRhsFn)(int Ns, realtype t, - N_Vector y, N_Vector ydot, - N_Vector *yS, N_Vector *ySdot, - void *fS_data, - N_Vector tmp1, N_Vector tmp2); - -/* - * ----------------------------------------------------------------- - * Type : CVSensRhs1Fn - * ----------------------------------------------------------------- - * The fS1 function which defines the right hand side of the i-th - * sensitivity ODE system s_i' = f_y * s_i + f_p must have type - * CVSensRhs1Fn. - * fS1 takes as input the number of sensitivities Ns, the current - * sensitivity iS, the independent variable value t, the states y - * and the corresponding value of f(t,y) in ydot, and the - * dependent sensitivity vector yS. It stores the result of fS in - * ySdot. - * (Allocation of memory for ySdot is handled within CVODES) - * The fS_data parameter is the same as the fS_data parameter - * set by the user through the CVodeSetSensFdata routine and is - * passed to the fS1 function every time it is called. - * A CVSensRhs1Fn function does not have a return value. - * ----------------------------------------------------------------- - */ - -typedef void (*CVSensRhs1Fn)(int Ns, realtype t, - N_Vector y, N_Vector ydot, - int iS, N_Vector yS, N_Vector ySdot, - void *fS_data, - N_Vector tmp1, N_Vector tmp2); - -/* - * ----------------------------------------------------------------- - * Type : CVQuadRhsFn - * ----------------------------------------------------------------- - * The fQ function which defines the right hand side of the - * quadrature equations yQ' = fQ(t,y) must have type CVQuadRhsFn. - * fQ takes as input the value of the independent variable t, - * the vector of states y and must store the result of fQ in - * yQdot. (Allocation of memory for yQdot is handled by CVODES). - * The fQ_data parameter is the same as the fQ_data parameter - * set by the user through the CVodeSetQuadFdata routine and is - * passed to the fQ function every time it is called. - * A CVQuadRhsFn function does not have a return value. - * ----------------------------------------------------------------- - */ - -typedef void (*CVQuadRhsFn)(realtype t, N_Vector y, N_Vector yQdot, - void *fQ_data); - -/* - * ================================================================= - * U S E R - C A L L A B L E R O U T I N E S - * ================================================================= - */ - -/* - * ----------------------------------------------------------------- - * Function : CVodeCreate - * ----------------------------------------------------------------- - * CVodeCreate creates an internal memory block for a problem to - * be solved by CVODES. - * - * lmm is the type of linear multistep method to be used. - * The legal values are CV_ADAMS and CV_BDF (see previous - * description). - * - * iter is the type of iteration used to solve the nonlinear - * system that arises during each internal time step. - * The legal values are CV_FUNCTIONAL and CV_NEWTON. - * - * If successful, CVodeCreate returns a pointer to initialized - * problem memory. This pointer should be passed to CVodeMalloc. - * If an initialization error occurs, CVodeCreate prints an error - * message to standard err and returns NULL. - * ----------------------------------------------------------------- - */ - -void *CVodeCreate(int lmm, int iter); - -/* - * ----------------------------------------------------------------- - * Integrator optional input specification functions - * ----------------------------------------------------------------- - * The following functions can be called to set optional inputs - * to values other than the defaults given below: - * - * Function | Optional input / [ default value ] - * ----------------------------------------------------------------- - * | - * CVodeSetErrFile | the file pointer for an error file - * | where all CVODES warning and error - * | messages will be written. This parameter - * | can be stdout (standard output), stderr - * | (standard error), a file pointer - * | (corresponding to a user error file - * | opened for writing) returned by fopen. - * | If not called, then all messages will - * | be written to standard output. - * | [stderr] - * | - * CVodeSetFdata | a pointer to user data that will be - * | passed to the user's f function every - * | time f is called. - * | [NULL] - * | - * CVodeSetGdata | a pointer to user data that will be - * | passed to the user's g function every - * | time g is called. - * | [NULL] - * | - * CVodeSetMaxOrd | maximum lmm order to be used by the - * | solver. - * | [12 for Adams , 5 for BDF] - * | - * CVodeSetMaxNumSteps | maximum number of internal steps to be - * | taken by the solver in its attempt to - * | reach tout. - * | [500] - * | - * CVodeSetMaxHnilWarns | maximum number of warning messages - * | issued by the solver that t+h==t on the - * | next internal step. A value of -1 means - * | no such messages are issued. - * | [10] - * | - * CVodeSetStabLimDet | flag to turn on/off stability limit - * | detection (TRUE = on, FALSE = off). - * | When BDF is used and order is 3 or - * | greater, CVsldet is called to detect - * | stability limit. If limit is detected, - * | the order is reduced. - * | [FALSE] - * | - * CVodeSetInitStep | initial step size. - * | [estimated by CVODES] - * | - * CVodeSetMinStep | minimum absolute value of step size - * | allowed. - * | [0.0] - * | - * CVodeSetMaxStep | maximum absolute value of step size - * | allowed. - * | [infinity] - * | - * CVodeSetStopTime | the independent variable value past - * | which the solution is not to proceed. - * | [infinity] - * | - * CVodeSetMaxErrTestFails | Maximum number of error test failures - * | in attempting one step. - * | [7] - * | - * CVodeSetMaxNonlinIters | Maximum number of nonlinear solver - * | iterations at one solution. - * | [3] - * | - * CVodeSetMaxConvFails | Maximum number of allowable conv. - * | failures in attempting one step. - * | [10] - * | - * CVodeSetNonlinConvCoef | Coeficient in the nonlinear conv. - * | test. - * | [0.1] - * | - * ----------------------------------------------------------------- - * | - * CVodeSetIterType | Changes the current nonlinear iteration - * | type. - * | [set by CVodecreate] - * | - * CVodeSetTolerances | Changes the integration tolerances - * | between calls to CVode(). - * | [set by CVodeMalloc/CVodeReInit] - * | - * ----------------------------------------------------------------- - * Return flag: - * CV_SUCCESS if successful - * CV_MEM_NULL if the cvode memory is NULL - * CV_ILL_INPUT if an argument has an illegal value - * ----------------------------------------------------------------- - */ - -int CVodeSetErrFile(void *cvode_mem, FILE *errfp); -int CVodeSetFdata(void *cvode_mem, void *f_data); -int CVodeSetGdata(void *cvode_mem, void *g_data); -int CVodeSetMaxOrd(void *cvode_mem, int maxord); -int CVodeSetMaxNumSteps(void *cvode_mem, long int mxsteps); -int CVodeSetMaxHnilWarns(void *cvode_mem, int mxhnil); -int CVodeSetStabLimDet(void *cvode_mem, booleantype stldet); -int CVodeSetInitStep(void *cvode_mem, realtype hin); -int CVodeSetMinStep(void *cvode_mem, realtype hmin); -int CVodeSetMaxStep(void *cvode_mem, realtype hmax); -int CVodeSetStopTime(void *cvode_mem, realtype tstop); -int CVodeSetMaxErrTestFails(void *cvode_mem, int maxnef); -int CVodeSetMaxNonlinIters(void *cvode_mem, int maxcor); -int CVodeSetMaxConvFails(void *cvode_mem, int maxncf); -int CVodeSetNonlinConvCoef(void *cvode_mem, realtype nlscoef); - -int CVodeSetIterType(void *cvode_mem, int iter); -int CVodeSetTolerances(void *cvode_mem, - int itol, realtype *reltol, void *abstol); - -/* - * ----------------------------------------------------------------- - * Function : CVodeMalloc - * ----------------------------------------------------------------- - * CVodeMalloc allocates and initializes memory for a problem to - * to be solved by CVODES. - * - * cvode_mem is pointer to CVODES memory returned by CVodeCreate. - * - * f is the right hand side function in y' = f(t,y). - * - * t0 is the initial value of t. - * - * y0 is the initial condition vector y(t0). - * - * itol is the type of tolerances to be used. - * The legal values are: - * CV_SS (scalar relative and absolute tolerances), - * CV_SV (scalar relative tolerance and vector - * absolute tolerance). - * - * reltol is a pointer to the relative tolerance scalar. - * - * abstol is a pointer to the absolute tolerance scalar or - * an N_Vector of absolute tolerances. - * - * The parameters itol, reltol, and abstol define a vector of - * error weights, ewt, with components - * ewt[i] = 1/(reltol*abs(y[i]) + abstol) (if itol = CV_SS), or - * ewt[i] = 1/(reltol*abs(y[i]) + abstol[i]) (if itol = CV_SV). - * This vector is used in all error and convergence tests, which - * use a weighted RMS norm on all error-like vectors v: - * WRMSnorm(v) = sqrt( (1/N) sum(i=1..N) (v[i]*ewt[i])^2 ), - * where N is the problem dimension. - * - * Note: The tolerance values may be changed in between calls to - * CVode for the same problem. These values refer to - * (*reltol) and either (*abstol), for a scalar absolute - * tolerance, or the components of abstol, for a vector - * absolute tolerance. - * - * If successful, CVodeMalloc returns SUCCESS. If an argument has - * an illegal value, CVodeMalloc prints an error message to the - * file specified by errfp and returns one of the error flags - * defined below. - * ----------------------------------------------------------------- - */ - -int CVodeMalloc(void *cvode_mem, CVRhsFn f, - realtype t0, N_Vector y0, - int itol, realtype *reltol, void *abstol); - -/* - * ----------------------------------------------------------------- - * Function : CVodeReInit - * ----------------------------------------------------------------- - * CVodeReInit re-initializes CVode for the solution of a problem, - * where a prior call to CVodeMalloc has been made with the same - * problem size N. CVodeReInit performs the same input checking - * and initializations that CVodeMalloc does. - * But it does no memory allocation, assuming that the existing - * internal memory is sufficient for the new problem. - * - * The use of CVodeReInit requires that the maximum method order, - * maxord, is no larger for the new problem than for the problem - * specified in the last call to CVodeMalloc. This condition is - * automatically fulfilled if the multistep method parameter lmm - * is unchanged (or changed from CV_ADAMS to CV_BDF) and the default - * value for maxord is specified. - * - * The first argument to CVodeReInit is: - * - * cvode_mem = pointer to CVODES memory returned by CVodeCreate. - * - * All the remaining arguments to CVodeReInit have names and - * meanings identical to those of CVodeMalloc. - * - * The return value of CVodeReInit is equal to CV_SUCCESS = 0 if - * there were no errors; otherwise it is a negative int equal to: - * CV_MEM_NULL indicating cvode_mem was NULL (i.e., - * CVodeCreate has not been called). - * CV_NO_MALLOC indicating that cvode_mem has not been - * allocated (i.e., CVodeMalloc has not been - * called). - * CV_ILL_INPUT indicating an input argument was illegal - * (including an attempt to increase maxord). - * In case of an error return, an error message is also printed. - * ----------------------------------------------------------------- - */ - -int CVodeReInit(void *cvode_mem, CVRhsFn f, - realtype t0, N_Vector y0, - int itol, realtype *reltol, void *abstol); - -/* - * ----------------------------------------------------------------- - * Function : CVodeRootInit - * ----------------------------------------------------------------- - * CVodeRootInit initializes a rootfinding problem to be solved - * during the integration of the ODE system. It must be called - * after CVodeCreate, and before CVode. The arguments are: - * - * cvode_mem = pointer to CVODE memory returned by CVodeCreate. - * - * g = name of user-supplied function, of type CVRootFn, - * defining the functions g_i whose roots are sought. - * - * nrtfn = number of functions g_i, an int >= 0. - * - * If a new problem is to be solved with a call to CVodeReInit, - * where the new problem has no root functions but the prior one - * did, then call CVodeRootInit with nrtfn = 0. - * - * The return value of CVodeRootInit is CV_SUCCESS = 0 if there were - * no errors; otherwise it is a negative int equal to: - * CV_MEM_NULL indicating cvode_mem was NULL, or - * CV_MEM_FAIL indicating a memory allocation failed. - * (including an attempt to increase maxord). - * CV_RTFUNC_NULL indicating nrtfn > 0 but g = NULL. - * In case of an error return, an error message is also printed. - * ----------------------------------------------------------------- - */ - -int CVodeRootInit(void *cvode_mem, CVRootFn g, int nrtfn); - -/* - * ----------------------------------------------------------------- - * Quadrature optional input specification functions - * ----------------------------------------------------------------- - * The following functions can be called to set optional inputs - * to values other than the defaults given below: - * - * Function | Optional input / [ default value ] - * -------------------------------------------------------------- - * | - * CVodeSetQuadErrCon | are quadrature variables considered in - * | the error control? - * | [FALSE] - * | - * CVodeSetQuadFdata | a pointer to user data that will be - * | passed to the user's fQ function every - * | time fQ is called. - * | [NULL] - * | - *CVodeSetQuadTolerances| set tolerances for quadrature - * | integration. Only needed if errconQ=TRUE - * | [no default] - * ----------------------------------------------------------------- - * If successful, these functions return CV_SUCCESS. If an argument - * has an illegal value, they print an error message to the - * file specified by errfp and return one of the error flags - * defined for the CVodeSet* routines. - * ----------------------------------------------------------------- - */ - -int CVodeSetQuadFdata(void *cvode_mem, void *fQ_data); -int CVodeSetQuadErrCon(void *cvode_mem, booleantype errconQ); -int CVodeSetQuadTolerances(void *cvode_mem, int itolQ, - realtype *reltolQ, void *abstolQ); - -/* - * ----------------------------------------------------------------- - * Function : CVodeQuadMalloc - * ----------------------------------------------------------------- - * CVodeQuadMalloc allocates and initializes memory related to - * quadrature integration. - * - * cvode_mem is a pointer to CVODES memory returned by CVodeCreate - * - * fQ is the user-provided integrand routine. - * - * yQ0 is an N_Vector with initial values for quadratures - * (typically yQ0 has all zero components). - * - * Return values: - * CV_SUCCESS if successful - * CV_MEM_NULL if the cvode memory was NULL - * CV_MEM_FAIL if a memory allocation failed - * ----------------------------------------------------------------- - */ - -int CVodeQuadMalloc(void *cvode_mem, CVQuadRhsFn fQ, N_Vector yQ0); - -/* - * ----------------------------------------------------------------- - * Function : CVodeQuadReInit - * ----------------------------------------------------------------- - * CVodeQuadReInit re-initializes CVODES's quadrature related - * memory for a problem, assuming it has already been allocated - * in prior calls to CVodeMalloc and CvodeQuadMalloc. - * - * All problem specification inputs are checked for errors. - * The number of quadratures Nq is assumed to be unchanged - * since the previous call to CVodeQuadMalloc. - * - * Return values: - * CV_SUCCESS if successful - * CV_MEM_NULL if the cvode memory was NULL - * CV_NO_QUAD if quadratures were not initialized - * ----------------------------------------------------------------- - */ - -int CVodeQuadReInit(void *cvode_mem, CVQuadRhsFn fQ, N_Vector yQ0); - -/* - * ----------------------------------------------------------------- - * Forward sensitivity optional input specification functions - * ----------------------------------------------------------------- - * The following functions can be called to set optional inputs - * to other values than the defaults given below: - * - * Function | Optional input / [ default value ] - * ----------------------------------------------------------------- - * | - * CVodeSetSensRhsFn | sensitivity right hand side function. - * | This function must compute right hand - * | sides for all sensitivity equations. - * | [CVODES difference quotient approx.] - * | - * CVodeSetSensRhs1Fn | the sensitivity right hand side. - * | This function must compute right hand - * | sides for one sensitivity equation at a - * | time. - * | [CVODES difference quotient approx.] - * | - * CVodeSetSensRho | controls the selection of finite - * | difference schemes used in evaluating - * | the sensitivity right hand sides. - * | [0.0] - * | - * CVodeSetSensPbar | a pointer to scaling factors used in - * | computing sensitivity absolute - * | tolerances as well as by the CVODES - * | difference quotient routines for - * | sensitivty right hand sides. pbar[i] - * | must give the order of magnitude of - * | parameter p[i]. Typically, if p[i] is - * | nonzero, pbar[i]=p[i]. - * | [p_i = 1.0, for all i] - * | - * CVodeSetSensFdata | a pointer to user data that will be - * | passed to the user's fS function every - * | time fS is called. - * | [NULL] - * | - * CVodeSetSensErrCon | are sensitivity variables considered in - * | the error control? - * | [FALSE] - * | - * CVodeSetSensTolerances | type of sensi absolute tolernaces. - * | - * | pointer to the sensiti relative - * | tolerance scalar. - * | - * | pointer to the array of sensi - * | abs tol scalars or a pointer - * | to the array of N_Vector sensi - * | absolute tolerances. - * | [itolS = itol] - * | [reltolS = reltol] - * | [abstolS estimated by CVODES] - * | - * CVodeSetSensMaxNonlinIters | Maximum number of nonlinear solver - * | iterations at one solution. - * | [3] - * | - * ----------------------------------------------------------------- - * The return values are the same as for CVodeSet* - * ----------------------------------------------------------------- - */ - -int CVodeSetSensRhsFn(void *cvode_mem, CVSensRhsFn fS); -int CVodeSetSensRhs1Fn(void *cvode_mem, CVSensRhs1Fn fS); -int CVodeSetSensRho(void *cvode_mem, realtype rho); -int CVodeSetSensPbar(void *cvode_mem, realtype *pbar); -int CVodeSetSensFdata(void *cvode_mem, void *fS_data); -int CVodeSetSensErrCon(void *cvode_mem, booleantype errconS); -int CVodeSetSensTolerances(void *cvode_mem, int itolS, - realtype *reltolS, void *abstolS); -int CVodeSetSensMaxNonlinIters(void *cvode_mem, int maxcorS); - -/* - * ----------------------------------------------------------------- - * Function : CVodeSensMalloc - * ----------------------------------------------------------------- - * CVodeSensMalloc allocates and initializes memory related to - * sensitivity computations. - * - * cvode_mem is pointer to CVODES memory returned by CVodeCreate - * - * Ns is the number of sensitivities to be computed. - * - * ism is the type of corrector used in sensitivity - * analysis. The legal values are: CV_SIMULTANEOUS, - * CV_STAGGERED, and CV_STAGGERED1 (see previous description) - * - * p is a pointer to problem parameters with respect to - * which sensitivities may be computed (see description - * of plist below). If the right hand sides of the - * sensitivity equations are to be evaluated by the - * difference quotient routines provided with CVODES, - * then p must also be a field in the user data - * structure pointed to by f_data. - * - * plist is a pointer to a list of parameters with respect to - * which sensitivities are to be computed. - * If plist[j]=i, then sensitivities with respect to - * the i-th parameter (i.e. p[i-1]) will be computed. - * A negative plist entry also indicates that the - * corresponding parameter affects only the initial - * conditions of the ODE and not its right hand side. - * - * yS0 is the array of initial condition vectors for - * sensitivity variables. - * - * Return values: - * CV_SUCCESS - * CV_MEM_NULL - * CV_ILL_INPUT - * CV_MEM_FAIL - * ----------------------------------------------------------------- - */ - -int CVodeSensMalloc(void *cvode_mem, int Ns, int ism, - realtype *p, int *plist, N_Vector *yS0); - -/* - * ----------------------------------------------------------------- - * Function : CVodeSensReInit - * ----------------------------------------------------------------- - * CVodeSensReInit re-initializes CVODES's sensitivity related - * memory for a problem, assuming it has already been allocated - * in prior calls to CVodeMalloc and CvodeSensMalloc. - * - * All problem specification inputs are checked for errors. - * The number of sensitivities Ns is assumed to be unchanged - * since the previous call to CVodeSensMalloc. - * If any error occurs during initialization, it is reported to - * the file whose file pointer is errfp. - * - * CVodeSensReInit potentially does some minimal memory allocation - * (for the sensitivity absolute tolerance and for arrays of - * counters used by the CV_STAGGERED1 method). - * - * The return value is equal to CV_SUCCESS = 0 if there were no - * errors; otherwise it is a negative int equal to: - * CV_MEM_NULL indicating cvode_mem was NULL, or - * CV_NO_SENS indicating there was not a prior call to - * CVodeSensMalloc. - * CV_ILL_INPUT indicating an input argument was illegal - * (including an attempt to increase maxord). - * CV_MEM_FAIL indicating a memory request failed. - * In case of an error return, an error message is also printed. - * ----------------------------------------------------------------- - */ - -int CVodeSensReInit(void *cvode_mem, int ism, - realtype *p, int *plist, N_Vector *yS0); - -/* - * ----------------------------------------------------------------- - * Function : CVodeSensToggle - * ----------------------------------------------------------------- - * CVodeSensToggle activates or deactivates sensitivity calculations. - * It does NOT deallocate sensitivity-related memory. - * It is allowed to set sensi=TRUE only if CVodeSensMalloc has been - * previously called. - * - * The return value is equal to CV_SUCCESS = 0 if there were no - * errors; otherwise it is a negative int equal to: - * CV_MEM_NULL indicating cvode_mem was NULL - * CV_NO_SENS indicating there was not a prior call to - * CVodeSensMalloc. - * ----------------------------------------------------------------- -*/ - -int CVodeSensToggle(void *cvode_mem, booleantype sensi); - -/* - * ----------------------------------------------------------------- - * Function : CVode - * ----------------------------------------------------------------- - * CVode integrates the ODE over an interval in t. - * If itask is CV_NORMAL, then the solver integrates from its - * current internal t value to a point at or beyond tout, then - * interpolates to t = tout and returns y(tout) in the user- - * allocated vector yout. If itask is CV_ONE_STEP, then the solver - * takes one internal time step and returns in yout the value of - * y at the new internal time. In this case, tout is used only - * during the first call to CVode to determine the direction of - * integration and the rough scale of the problem. In either - * case, the time reached by the solver is placed in (*t). The - * user is responsible for allocating the memory for this value. - * - * cvode_mem is the pointer to CVODES memory returned by - * CVodeCreate. - * - * tout is the next time at which a computed solution is desired. - * - * yout is the computed solution vector. In CV_NORMAL mode with no - * errors and no roots found, yout=y(tout). - * - * tret is a pointer to a real location. CVode sets (*tret) to - * the time reached by the solver and returns yout=y(*tret). - * - * itask is CV_NORMAL, CV_ONE_STEP, CV_NORMAL_TSTOP, or CV_ONE_STEP_TSTOP. - * These four modes are described above. - * - * Here is a brief description of each return value: - * - * CV_SUCCESS: CVode succeeded and no roots were found. - * - * CV_ROOT_RETURN: CVode succeeded, and found one or more roots. - * If nrtfn > 1, call CVodeGetRootInfo to see - * which g_i were found to have a root at (*tret). - * - * CV_TSTOP_RETURN: CVode succeded and returned at tstop. - * - * CV_MEM_NULL: The cvode_mem argument was NULL. - * - * CV_NO_MALLOC: cvode_mem was not allocated. - * - * CV_ILL_INPUT: One of the inputs to CVode is illegal. This - * includes the situation when a component of the - * error weight vectors becomes < 0 during - * internal time-stepping. The ILL_INPUT flag - * will also be returned if the linear solver - * routine CV--- (called by the user after - * calling CVodeCreate) failed to set one of the - * linear solver-related fields in cvode_mem or - * if the linear solver's init routine failed. In - * any case, the user should see the printed - * error message for more details. - * - * CV_TOO_MUCH_WORK: The solver took mxstep internal steps but - * could not reach tout. The default value for - * mxstep is MXSTEP_DEFAULT = 500. - * - * CV_TOO_MUCH_ACC: The solver could not satisfy the accuracy - * demanded by the user for some internal step. - * - * CV_ERR_FAILURE: Error test failures occurred too many times - * (= MXNEF = 7) during one internal time step or - * occurred with |h| = hmin. - * - * CV_CONV_FAILURE: Convergence test failures occurred too many - * times (= MXNCF = 10) during one internal time - * step or occurred with |h| = hmin. - * - * CV_LSETUP_FAIL: The linear solver's setup routine failed in an - * unrecoverable manner. - * - * CV_LSOLVE_FAIL: The linear solver's solve routine failed in an - * unrecoverable manner. - * ----------------------------------------------------------------- - */ - -int CVode(void *cvode_mem, realtype tout, N_Vector yout, - realtype *tret, int itask); - -/* - * ----------------------------------------------------------------- - * Function : CVodeGetDky - * ----------------------------------------------------------------- - * CVodeGetDky computes the kth derivative of the y function at - * time t, where tn-hu <= t <= tn, tn denotes the current - * internal time reached, and hu is the last internal step size - * successfully used by the solver. The user may request - * k=0, 1, ..., qu, where qu is the current order. The - * derivative vector is returned in dky. This vector must be - * allocated by the caller. It is only legal to call this - * function after a successful return from CVode. - * - * cvode_mem is the pointer to CVODES memory returned by - * CVodeCreate. - * - * t is the time at which the kth derivative of y is evaluated. - * The legal range for t is [tn-hu,tn] as described above. - * - * k is the order of the derivative of y to be computed. The - * legal range for k is [0,qu] as described above. - * - * dky is the output derivative vector [(D_k)y](t). - * - * The return values for CVodeGetDky are defined below. - * Here is a brief description of each return value: - * - * CV_SUCCESS: CVodeGetDky succeeded. - * - * CV_BAD_K : k is not in the range 0, 1, ..., qu. - * - * CV_BAD_T : t is not in the interval [tn-hu,tn]. - * - * CV_BAD_DKY : The dky argument was NULL. - * - * CV_MEM_NULL : The cvode_mem argument was NULL. - * ----------------------------------------------------------------- - */ - -int CVodeGetDky(void *cvode_mem, realtype t, int k, N_Vector dky); - -/* - * ----------------------------------------------------------------- - * Integrator optional output extraction functions - * ----------------------------------------------------------------- - * The following functions can be called to get optional outputs - * and statistics related to the main integrator. - * ----------------------------------------------------------------- - * CVodeGetWorkSpace returns the CVODES real and integer workspaces - * CVodeGetNumSteps returns the cumulative number of internal - * steps taken by the solver - * CVodeGetNumRhsEvals returns the number of calls to the user's - * f function - * CVodeGetNumLinSolvSetups returns the number of calls made to - * the linear solver's setup routine - * CVodeGetNumErrTestFails returns the number of local error test - * failures that have occured - * CVodeGetLastOrder returns the order used during the last - * internal step - * CVodeGetCurrentOrder returns the order to be used on the next - * internal step - * CVodeGetNumStabLimOrderReds returns the number of order - * reductions due to stability limit - * detection - * CVodeGetActualInitStep returns the actual initial step size - * used by CVODES - * CVodeGetLastStep returns the step size for the last internal - * step - * CVodeGetCurrentStep returns the step size to be attempted on - * the next internal step - * CVodeGetCurrentTime returns the current internal time reached - * by the solver - * CVodeGetTolScaleFactor returns a suggested factor by which the - * user's tolerances should be scaled when - * too much accuracy has been requested for - * some internal step - * CVodeGetErrWeights returns the state error weight vector. - * The user need not allocate space for ewt. - * CVodeGetEstLocalErrors returns the vector of estimated local - * errors. The user need not allocate space - * for ele. - * CVodeGetNumGEvals returns the number of calls to the user's - * g function (for rootfinding) - * CVodeGetRootInfo returns an array of int's showing the indices - * for which g_i was found to have a root. - * For i = 0 ... nrtfn-1, rootsfound[i] = 1 if g_i - * has a root, and = 0 if not. - * - * CVodeGet* return values: - * CV_SUCCESS if succesful - * CV_MEM_NULL if the cvode memory was NULL - * CV_NO_SLDET if stability limit was not turned on - * ----------------------------------------------------------------- - */ - -int CVodeGetWorkSpace(void *cvode_mem, long int *lenrw, long int *leniw); -int CVodeGetNumSteps(void *cvode_mem, long int *nsteps); -int CVodeGetNumRhsEvals(void *cvode_mem, long int *nfevals); -int CVodeGetNumLinSolvSetups(void *cvode_mem, long int *nlinsetups); -int CVodeGetNumErrTestFails(void *cvode_mem, long int *netfails); -int CVodeGetLastOrder(void *cvode_mem, int *qlast); -int CVodeGetCurrentOrder(void *cvode_mem, int *qcur); -int CVodeGetNumStabLimOrderReds(void *cvode_mem, long int *nslred); -int CVodeGetActualInitStep(void *cvode_mem, realtype *hinused); -int CVodeGetLastStep(void *cvode_mem, realtype *hlast); -int CVodeGetCurrentStep(void *cvode_mem, realtype *hcur); -int CVodeGetCurrentTime(void *cvode_mem, realtype *tcur); -int CVodeGetTolScaleFactor(void *cvode_mem, realtype *tolsfac); -int CVodeGetErrWeights(void *cvode_mem, N_Vector *eweight); -int CVodeGetEstLocalErrors(void *cvode_mem, N_Vector *ele); -int CVodeGetNumGEvals(void *cvode_mem, long int *ngevals); -int CVodeGetRootInfo(void *cvode_mem, int **rootsfound); - -/* - * ----------------------------------------------------------------- - * As a convenience, the following functions provides the - * optional outputs in one group. - * ----------------------------------------------------------------- - */ - -int CVodeGetIntegratorStats(void *cvode_mem, long int *nsteps, - long int *nfevals, long int *nlinsetups, - long int *netfails, int *qlast, - int *qcur, realtype *hinused, realtype *hlast, - realtype *hcur, realtype *tcur); - -/* - * ----------------------------------------------------------------- - * Nonlinear solver optional output extraction functions - * ----------------------------------------------------------------- - * The following functions can be called to get optional outputs - * and statistics related to the nonlinear solver. - * ----------------------------------------------------------------- - * CVodeGetNumNonlinSolvIters returns the number of nonlinear - * solver iterations performed. - * CVodeGetNumNonlinSolvConvFails returns the number of nonlinear - * convergence failures. - * ----------------------------------------------------------------- - */ - -int CVodeGetNumNonlinSolvIters(void *cvode_mem, long int *nniters); -int CVodeGetNumNonlinSolvConvFails(void *cvode_mem, long int *nncfails); - -/* - * ----------------------------------------------------------------- - * As a convenience, the following function provides the - * optional outputs in a group. - * ----------------------------------------------------------------- - */ - -int CVodeGetNonlinSolvStats(void *cvode_mem, long int *nniters, - long int *nncfails); - -/* - * ----------------------------------------------------------------- - * Quadrature integration solution extraction routines - * ----------------------------------------------------------------- - * The following functions can be called to obtain the quadrature - * variables after a successful integration step. - * If quadratures were not computed, they return CV_NO_QUAD. - * ----------------------------------------------------------------- - */ - -int CVodeGetQuad(void *cvode_mem, realtype t, N_Vector yQout); -int CVodeGetQuadDky(void *cvode_mem, realtype t, int k, N_Vector dky); - -/* - * ----------------------------------------------------------------- - * Quadrature integration optional output extraction routines - * ----------------------------------------------------------------- - * The following functions can be called to get optional outputs - * and statistics related to the integration of quadratures. - * ----------------------------------------------------------------- - * CVodeGetQuadNumRhsEvals returns the number of calls to the - * user function fQ defining the right hand - * side of the quadrature variables. - * CVodeGetQuadNumErrTestFails returns the number of local error - * test failures for quadrature variables. - * CVodeGetQuadErrWeights returns the vector of error weights for - * the quadrature variables. The user need not - * allocate space for ewtQ. - * ----------------------------------------------------------------- - */ - -int CVodeGetQuadNumRhsEvals(void *cvode_mem, long int *nfQevals); -int CVodeGetQuadNumErrTestFails(void *cvode_mem, long int *nQetfails); -int CVodeGetQuadErrWeights(void *cvode_mem, N_Vector *eQweight); - -/* - * ----------------------------------------------------------------- - * As a convenience, the following function provides the - * optional outputs in a group. - * ----------------------------------------------------------------- - */ - -int CVodeGetQuadStats(void *cvode_mem, long int *nfQevals, - long int *nQetfails); - -/* - * ----------------------------------------------------------------- - * Forward sensitivity solution extraction routines - * ----------------------------------------------------------------- - * CVodeGetSensDky1 computes the kth derivative of the is-th - * sensitivity (is=1, 2, ..., Ns) of the y function at time t, - * where tn-hu <= t <= tn, tn denotes the current internal time - * reached, and hu is the last internal step size successfully - * used by the solver. The user may request k=0, 1, ..., qu, - * where qu is the current order. - * The is-th sensitivity derivative vector is returned in dky. - * This vector must be allocated by the caller. It is only legal - * to call this function after a successful return from CVode - * with sensitivty computations enabled. - * Arguments have the same meaning as in CVodeDky. - * - * CVodeGetSensDky computes the k-th derivative of all - * sensitivities of the y function at time t. It repeatedly calls - * CVodeGetSensDky. The argument dkyA must be a pointer to - * N_Vector and must be allocated by the user to hold at least Ns - * vectors. - * - * CVodeGetSens1 returns the is-th sensitivity of the y function - * at the time t. The argument ySout must be an N_Vector and must - * be allocated by the user. - * - * CVodeGetSens returns sensitivities of the y function at - * the time t. The argument ySout must be a pointer to N_Vector - * and must be allocated by the user to hold at least Ns vectors. - * - * Return values are similar to those of CVodeDky. Additionally, - * CVodeSensDky can return CV_NO_SENS if sensitivities were - * not computed and CV_BAD_IS if is < 0 or is >= Ns. - * ----------------------------------------------------------------- - */ - -int CVodeGetSens(void *cvode_mem, realtype t, N_Vector *ySout); -int CVodeGetSens1(void *cvode_mem, realtype t, int is, N_Vector ySout); -int CVodeGetSensDky(void *cvode_mem, realtype t, int k, - N_Vector *dkyA); -int CVodeGetSensDky1(void *cvode_mem, realtype t, int k, - int is, N_Vector dky); - -/* - * ----------------------------------------------------------------- - * Forward sensitivity optional output extraction routines - * ----------------------------------------------------------------- - * The following functions can be called to get optional outputs - * and statistics related to the integration of sensitivities. - * ----------------------------------------------------------------- - * CVodeGetNumSensRhsEvals returns the number of calls to the - * sensitivity right hand side routine. - * CVodeGetNumRhsEvalsSens returns the number of calls to the - * user f routine due to finite difference - * evaluations of the sensitivity equations. - * CVodeGetNumSensErrTestFails returns the number of local error - * test failures for sensitivity variables. - * CVodeGetNumSensLinSolvSetups returns the number of calls made - * to the linear solver's setup routine - * due to sensitivity computations. - * CVodeGetSensErrWeights returns the sensitivity error weight - * vectors. The user need not allocate space - * for ewtS. - * ----------------------------------------------------------------- - */ - -int CVodeGetNumSensRhsEvals(void *cvode_mem, long int *nfSevals); -int CVodeGetNumRhsEvalsSens(void *cvode_mem, long int *nfevalsS); -int CVodeGetNumSensErrTestFails(void *cvode_mem, long int *nSetfails); -int CVodeGetNumSensLinSolvSetups(void *cvode_mem, long int *nlinsetupsS); -int CVodeGetSensErrWeights(void *cvode_mem, N_Vector_S *eSweight); - -/* - * ----------------------------------------------------------------- - * As a convenience, the following function provides the - * optional outputs in a group. - * ----------------------------------------------------------------- - */ - -int CVodeGetSensStats(void *cvode_mem, long int *nfSevals, long int *nfevalsS, - long int *nSetfails, long int *nlinsetupsS); - -/* - * ----------------------------------------------------------------- - * Sensitivity nonlinear solver optional output extraction - * ----------------------------------------------------------------- - * The following functions can be called to get optional outputs - * and statistics related to the sensitivity nonlinear solver. - * ----------------------------------------------------------------- - * CVodeGetNumSensNonlinSolvIters returns the total number of - * nonlinear iterations for sensitivity - * variables. - * CVodeGetNumSensNonlinSolvConvFails returns the total number of - * nonlinear convergence failures - * for sensitivity variables - * CVodeGetNumStgrSensNonlinSolvIters returns a vector of Ns - * nonlinear iteration counters - * for sensitivity variables - * in the CV_STAGGERED1 method. - * CVodeGetNumStgrSensNonlinSolvConvFails returns a vector of Ns - * nonlinear solver convergence - * failure counters for - * sensitivity variables in - * the CV_STAGGERED1 method. - * ----------------------------------------------------------------- - */ - -int CVodeGetNumSensNonlinSolvIters(void *cvode_mem, long int *nSniters); -int CVodeGetNumSensNonlinSolvConvFails(void *cvode_mem, long int *nSncfails); -int CVodeGetNumStgrSensNonlinSolvIters(void *cvode_mem, long int *nSTGR1niters); -int CVodeGetNumStgrSensNonlinSolvConvFails(void *cvode_mem, - long int *nSTGR1ncfails); - -/* - * ----------------------------------------------------------------- - * As a convenience, the following two functions provide the - * optional outputs in groups. - * ----------------------------------------------------------------- - */ - -int CVodeGetSensNonlinSolvStats(void *cvode_mem, long int *nSniters, - long int *nSncfails); -int CVodeGetStgrSensNonlinSolvStats(void *cvode_mem, long int *nSTGR1niters, - long int *nSTGR1ncfails); - -/* - * ----------------------------------------------------------------- - * Function : CVodeFree - * ----------------------------------------------------------------- - * CVodeFree frees the problem memory cvode_mem allocated by - * CVodeMalloc. Its only argument is the pointer cvode_mem - * returned by CVodeCreate. - * ----------------------------------------------------------------- - */ - -void CVodeFree(void *cvode_mem); - -/* - * ----------------------------------------------------------------- - * Function : CVodeQuadFree - * ----------------------------------------------------------------- - * CVodeQuadFree frees the problem memory in cvode_mem allocated - * for quadrature integration. Its only argument is the pointer - * cvode_mem returned by CVodeCreate. - * ----------------------------------------------------------------- - */ - -void CVodeQuadFree(void *cvode_mem); - -/* - * ----------------------------------------------------------------- - * Function : CVodeSensFree - * ----------------------------------------------------------------- - * CVodeSensFree frees the problem memory in cvode_mem allocated - * for sensitivity analysis. Its only argument is the pointer - * cvode_mem returned by CVodeCreate. - * ----------------------------------------------------------------- - */ - -void CVodeSensFree(void *cvode_mem); - -/* - * ---------------------------------------- - * CVODES return flags - * ---------------------------------------- - */ - -#define CV_SUCCESS 0 -#define CV_TSTOP_RETURN 1 -#define CV_ROOT_RETURN 2 - -#define CV_MEM_NULL -1 -#define CV_ILL_INPUT -2 -#define CV_NO_MALLOC -3 -#define CV_TOO_MUCH_WORK -4 -#define CV_TOO_MUCH_ACC -5 -#define CV_ERR_FAILURE -6 -#define CV_CONV_FAILURE -7 -#define CV_LINIT_FAIL -8 -#define CV_LSETUP_FAIL -9 -#define CV_LSOLVE_FAIL -10 - -#define CV_MEM_FAIL -11 - -#define CV_RTFUNC_NULL -12 - -#define CV_NO_SLDET -13 -#define CV_BAD_K -14 -#define CV_BAD_T -15 -#define CV_BAD_DKY -16 - -#define CV_PDATA_NULL -17 - -#define CV_BAD_IS -18 - -#define CV_NO_QUAD -19 - -#define CV_NO_SENS -20 - -/* - * ================================================================= - * I N T E R F A C E T O L I N E A R S O L V E R S - * ================================================================= - */ - -/* - * ----------------------------------------------------------------- - * Communication between CVODE and a CVODE Linear Solver - * ----------------------------------------------------------------- - * convfail (input to cv_lsetup) - * - * CV_NO_FAILURES : Either this is the first cv_setup call for this - * step, or the local error test failed on the - * previous attempt at this step (but the Newton - * iteration converged). - * - * CV_FAIL_BAD_J : This value is passed to cv_lsetup if - * - * (a) The previous Newton corrector iteration - * did not converge and the linear solver's - * setup routine indicated that its Jacobian- - * related data is not current - * or - * (b) During the previous Newton corrector - * iteration, the linear solver's solve routine - * failed in a recoverable manner and the - * linear solver's setup routine indicated that - * its Jacobian-related data is not current. - * - * CV_FAIL_OTHER : During the current internal step try, the - * previous Newton iteration failed to converge - * even though the linear solver was using current - * Jacobian-related data. - * ----------------------------------------------------------------- - */ - -/* Constants for convfail (input to cv_lsetup) */ - -#define CV_NO_FAILURES 0 -#define CV_FAIL_BAD_J 1 -#define CV_FAIL_OTHER 2 - -/* - * ----------------------------------------------------------------- - * int (*cv_linit)(CVodeMem cv_mem); - * ----------------------------------------------------------------- - * The purpose of cv_linit is to complete initializations for a - * specific linear solver, such as counters and statistics. - * An LInitFn should return 0 if it has successfully initialized the - * CVODE linear solver and a negative value otherwise. - * If an error does occur, an appropriate message should be sent to - * (cv_mem->errfp) - * ----------------------------------------------------------------- - */ - -/* - * ----------------------------------------------------------------- - * int (*cv_lsetup)(CVodeMem cv_mem, int convfail, N_Vector ypred, - * N_Vector fpred, booleantype *jcurPtr, - * N_Vector vtemp1, N_Vector vtemp2, - * N_Vector vtemp3); - * ----------------------------------------------------------------- - * The job of cv_lsetup is to prepare the linear solver for - * subsequent calls to cv_lsolve. It may recompute Jacobian- - * related data is it deems necessary. Its parameters are as - * follows: - * - * cv_mem - problem memory pointer of type CVodeMem. See the big - * typedef earlier in this file. - * - * convfail - a flag to indicate any problem that occurred during - * the solution of the nonlinear equation on the - * current time step for which the linear solver is - * being used. This flag can be used to help decide - * whether the Jacobian data kept by a CVODE linear - * solver needs to be updated or not. - * Its possible values have been documented above. - * - * ypred - the predicted y vector for the current CVODE internal - * step. - * - * fpred - f(tn, ypred). - * - * jcurPtr - a pointer to a bool to be filled in by cv_lsetup. - * The function should set *jcurPtr=TRUE if its Jacobian - * data is current after the call and should set - * *jcurPtr=FALSE if its Jacobian data is not current. - * Note: If cv_lsetup calls for re-evaluation of - * Jacobian data (based on convfail and CVODE state - * data), it should return *jcurPtr=TRUE always; - * otherwise an infinite loop can result. - * - * vtemp1 - temporary N_Vector provided for use by cv_lsetup. - * - * vtemp3 - temporary N_Vector provided for use by cv_lsetup. - * - * vtemp3 - temporary N_Vector provided for use by cv_lsetup. - * - * The cv_lsetup routine should return 0 if successful, a positive - * value for a recoverable error, and a negative value for an - * unrecoverable error. - * ----------------------------------------------------------------- - */ - -/* - * ----------------------------------------------------------------- - * int (*cv_lsolve)(CVodeMem cv_mem, N_Vector b, N_Vector weight, - * N_Vector ycur, N_Vector fcur); - * ----------------------------------------------------------------- - * cv_lsolve must solve the linear equation P x = b, where - * P is some approximation to (I - gamma J), J = (df/dy)(tn,ycur) - * and the RHS vector b is input. The N-vector ycur contains - * the solver's current approximation to y(tn) and the vector - * fcur contains the N_Vector f(tn,ycur). The solution is to be - * returned in the vector b. cv_lsolve returns a positive value - * for a recoverable error and a negative value for an - * unrecoverable error. Success is indicated by a 0 return value. - * ----------------------------------------------------------------- - */ - -/* - * ----------------------------------------------------------------- - * void (*cv_lfree)(CVodeMem cv_mem); - * ----------------------------------------------------------------- - * cv_lfree should free up any memory allocated by the linear - * solver. This routine is called once a problem has been - * completed and the linear solver is no longer needed. - * ----------------------------------------------------------------- - */ - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/cvodes/cvodes_impl.h b/src/sundials/cvodes/cvodes_impl.h deleted file mode 100755 index 12b9da34b6..0000000000 --- a/src/sundials/cvodes/cvodes_impl.h +++ /dev/null @@ -1,751 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, - * and Dan Shumaker @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * Implementation header file for the main CVODES integrator. - * ----------------------------------------------------------------- - */ - -#ifndef _CVODES_IMPL_H -#define _CVODES_IMPL_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include - -#include "cvodes.h" -#include "nvector.h" -#include "sundialstypes.h" - -/* Prototypes for internal sensitivity rhs DQ functions */ - -void CVSensRhsDQ(int Ns, realtype t, - N_Vector y, N_Vector ydot, - N_Vector *yS, N_Vector *ySdot, - void *fS_data, - N_Vector tempv, N_Vector ftemp); - -void CVSensRhs1DQ(int Ns, realtype t, - N_Vector y, N_Vector ydot, - int is, N_Vector yS, N_Vector ySdot, - void *fS_data, - N_Vector tempv, N_Vector ftemp); - -/* - * ================================================================= - * M A I N I N T E G R A T O R M E M O R Y B L O C K - * ================================================================= - */ - -/* Basic CVODES constants */ - -#define ADAMS_Q_MAX 12 /* max value of q for lmm == ADAMS */ -#define BDF_Q_MAX 5 /* max value of q for lmm == BDF */ -#define Q_MAX ADAMS_Q_MAX /* max value of q for either lmm */ -#define L_MAX (Q_MAX+1) /* max value of L for either lmm */ -#define NUM_TESTS 5 /* number of error test quantities */ - -/* - * ifS is the type of the function returning the sensitivity - * right-hand side. ifS can be either CV_ALLSENS if the function - * (of type CVSensRhsFn) returns right hand sides for all - * sensitivity systems at once, or CV_ONESENS if the function - * (of type SensRhs1Fn) returns the right hand side of one - * sensitivity system at a time. - */ - -#define CV_ONESENS 1 -#define CV_ALLSENS 2 - -/* - * ----------------------------------------------------------------- - * Types: struct CVodeMemRec, CVodeMem - * ----------------------------------------------------------------- - * The type CVodeMem is type pointer to struct CVodeMemRec. - * This structure contains fields to keep track of problem state. - * ----------------------------------------------------------------- - */ - -typedef struct CVodeMemRec { - - realtype cv_uround; /* machine unit roundoff */ - - /*-------------------------- - Problem Specification Data - --------------------------*/ - - CVRhsFn cv_f; /* y' = f(t,y(t)) */ - void *cv_f_data; /* user pointer passed to f */ - int cv_lmm; /* lmm = ADAMS or BDF */ - int cv_iter; /* iter = FUNCTIONAL or NEWTON */ - int cv_itol; /* itol = SS or SV */ - realtype *cv_reltol; /* ptr to relative tolerance */ - void *cv_abstol; /* ptr to absolute tolerance */ - - /*----------------------- - Quadrature Related Data - -----------------------*/ - - booleantype cv_quadr; /* TRUE if integrating quadratures */ - CVQuadRhsFn cv_fQ; - int cv_itolQ; - realtype *cv_reltolQ; /* ptr to relative tolerance for quad */ - void *cv_abstolQ; /* ptr to absolute tolerance for quad */ - booleantype cv_errconQ; - void *cv_fQ_data; /* user pointer passed to fQ */ - - /*------------------------ - Sensitivity Related Data - ------------------------*/ - - booleantype cv_sensi; /* TRUE if computing sensitivities */ - int cv_Ns; /* Number of sensitivities */ - CVSensRhsFn cv_fS; /* fS = (df/dy)*yS + (df/dp) */ - CVSensRhs1Fn cv_fS1; /* fS1 = (df/dy)*yS_i + (df/dp) */ - booleantype cv_fSDQ; - int cv_ifS; /* ifS = ALLSENS or ONESENS */ - int cv_ism; /* ism = SIMULTANEOUS or STAGGERED */ - realtype *cv_p; /* parameters in f(t,y,p) */ - realtype *cv_pbar; /* scale factors for parameters */ - int *cv_plist; /* list of sensitivities */ - realtype cv_rhomax; /* cut-off value for centered/forward finite - differences */ - booleantype cv_errconS; /* TRUE if sensitivities are in err. control */ - void *cv_fS_data; /* user pointer passed to fS */ - - int cv_itolS; - realtype *cv_reltolS; /* ptr to relative tolerance for sensi */ - void *cv_abstolS; /* ptr to absolute tolerance for sensi */ - booleantype cv_testSensTol; /* flag to indicate if sensi. tolerances - must be checked now */ - booleantype cv_setSensTol; /* flag to indicate if sensi. tolerances - must be set now */ - booleantype cv_atolSallocated; /* TRUE if CVODES has allocated space for - sensitivity absolute tolerances */ - - /*----------------------- - Nordsieck History Array - -----------------------*/ - - N_Vector cv_zn[L_MAX]; /* Nordsieck array, of size N x (q+1). - zn[j] is a vector of length N (j=0,...,q) - zn[j] = [1/factorial(j)] * h^j * - (jth derivative of the interpolating - polynomial */ - - /*------------------- - Vectors of length N - -------------------*/ - - N_Vector cv_ewt; /* error weight vector */ - N_Vector cv_y; /* y is used as temporary storage by the solver. - The memory is provided by the user to CVode - where the vector is named yout. */ - N_Vector cv_acor; /* In the context of the solution of the - nonlinear equation, acor = y_n(m) - y_n(0). - On return, this vector is scaled to give - the estimated local error in y. */ - N_Vector cv_tempv; /* temporary storage vector */ - N_Vector cv_ftemp; /* temporary storage vector */ - - /*-------------------------- - Quadrature Related Vectors - --------------------------*/ - - N_Vector cv_znQ[L_MAX]; /* Nordsieck arrays for sensitivities */ - N_Vector cv_ewtQ; /* error weight vector for quadratures */ - N_Vector cv_yQ; /* Unlike y, yQ is not allocated by the user */ - N_Vector cv_acorQ; /* acorQ = yQ_n(m) - yQ_n(0) */ - N_Vector cv_tempvQ; /* temporary storage vector (~ tempv) */ - - /*--------------------------- - Sensitivity Related Vectors - ---------------------------*/ - - N_Vector *cv_znS[L_MAX]; /* Nordsieck arrays for sensitivities */ - N_Vector *cv_ewtS; /* error weight vectors for sensitivities */ - N_Vector *cv_yS; /* yS=yS0 (allocated by the user) */ - N_Vector *cv_acorS; /* acorS = yS_n(m) - yS_n(0) */ - N_Vector *cv_tempvS; /* temporary storage vector (~ tempv) */ - N_Vector *cv_ftempS; /* temporary storage vector (~ ftemp) */ - - /*----------------------------------------------- - Does CVodeSensMalloc allocate additional space? - -----------------------------------------------*/ - - booleantype cv_stgr1alloc; /* Are ncfS1, ncfnS1, and nniS1 allocated - by CVODES? */ - - /*----------------- - Tstop information - -----------------*/ - booleantype cv_tstopset; - realtype cv_tstop; - - /*--------- - Step Data - ---------*/ - - int cv_q; /* current order */ - int cv_qprime; /* order to be used on the next step */ - /* = q-1, q, or q+1 */ - int cv_next_q; /* order to be used on the next step */ - int cv_qwait; /* number of internal steps to wait before */ - /* considering a change in q */ - int cv_L; /* L = q + 1 */ - - realtype cv_hin; - realtype cv_h; /* current step size */ - realtype cv_hprime; /* step size to be used on the next step */ - realtype cv_next_h; /* step size to be used on the next step */ - realtype cv_eta; /* eta = hprime / h */ - realtype cv_hscale; /* value of h used in zn */ - realtype cv_tn; /* current internal value of t */ - - realtype cv_tau[L_MAX+1]; /* array of previous q+1 successful step - sizes indexed from 1 to q+1 */ - realtype cv_tq[NUM_TESTS+1]; /* array of test quantities indexed from - 1 to NUM_TESTS(=5) */ - realtype cv_l[L_MAX]; /* coefficients of l(x) (degree q poly) */ - - realtype cv_rl1; /* 1 / l[1] */ - realtype cv_gamma; /* gamma = h * rl1 */ - realtype cv_gammap; /* gamma at the last setup call */ - realtype cv_gamrat; /* gamma / gammap */ - - realtype cv_crate; /* est. corrector conv. rate in Nls */ - realtype cv_crateS; /* est. corrector conv. rate in NlsStgr */ - realtype cv_acnrm; /* | acor | */ - realtype cv_acnrmS; /* | acorS | */ - realtype cv_acnrmQ; /* | acorQ | */ - realtype cv_nlscoef; /* coeficient in nonlinear convergence test */ - int cv_mnewt; /* Newton iteration counter */ - int *cv_ncfS1; /* Array of Ns local counters for conv. - failures (used in CVStep for STAGGERED1) */ - - /*------ - Limits - ------*/ - - int cv_qmax; /* q <= qmax */ - long int cv_mxstep; /* maximum number of internal steps for one - user call */ - int cv_maxcor; /* maximum number of corrector iterations for - the solution of the nonlinear equation */ - int cv_maxcorS; - int cv_mxhnil; /* maximum number of warning messages issued to - the user that t + h == t for the next - internal step */ - int cv_maxnef; /* maximum number of error test failures */ - int cv_maxncf; /* maximum number of nonlinear conv. failures */ - - realtype cv_hmin; /* |h| >= hmin */ - realtype cv_hmax_inv; /* |h| <= 1/hmax_inv */ - realtype cv_etamax; /* eta <= etamax */ - - /*---------- - Counters - ----------*/ - - long int cv_nst; /* number of internal steps taken */ - long int cv_nfe; /* number of f calls */ - long int cv_nfSe; /* number of fS calls */ - long int cv_nfQe; /* number of fQ calls */ - long int cv_nfeS; /* number of f calls from sensi DQ */ - - long int cv_ncfn; /* number of corrector convergence failures */ - long int cv_ncfnS; /* number of total sensi. corr. conv. failures */ - long int *cv_ncfnS1; /* number of sensi. corrector conv. failures */ - - long int cv_nni; /* number of nonlinear iterations performed */ - long int cv_nniS; /* number of total sensi. nonlinear iterations */ - long int *cv_nniS1; /* number of sensi. nonlinear iterations */ - - long int cv_netf; /* number of error test failures */ - long int cv_netfS; /* number of sensi. error test failures */ - long int cv_netfQ; /* number of quadr. error test failures */ - - long int cv_nsetups; /* number of setup calls */ - long int cv_nsetupsS; /* number of setup calls due to sensitivities */ - - int cv_nhnil; /* number of messages issued to the user that - t + h == t for the next iternal step */ - - /*----------------------------- - Space requirements for CVODES - -----------------------------*/ - - long int cv_lrw1; /* no. of realtype words in 1 N_Vector y */ - long int cv_liw1; /* no. of integer words in 1 N_Vector y */ - long int cv_lrw1Q; /* no. of realtype words in 1 N_Vector yQ */ - long int cv_liw1Q; /* no. of integer words in 1 N_Vector yQ */ - long int cv_lrw; /* no. of realtype words in CVODES work vectors */ - long int cv_liw; /* no. of integer words in CVODES work vectors */ - - /*---------------- - Step size ratios - ----------------*/ - - realtype cv_etaqm1; /* ratio of new to old h for order q-1 */ - realtype cv_etaq; /* ratio of new to old h for order q */ - realtype cv_etaqp1; /* ratio of new to old h for order q+1 */ - - /*------------------ - Linear Solver Data - ------------------*/ - - /* Linear Solver functions to be called */ - - int (*cv_linit)(struct CVodeMemRec *cv_mem); - - int (*cv_lsetup)(struct CVodeMemRec *cv_mem, int convfail, - N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, - N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); - - int (*cv_lsolve)(struct CVodeMemRec *cv_mem, N_Vector b, N_Vector weight, - N_Vector ycur, N_Vector fcur); - - void (*cv_lfree)(struct CVodeMemRec *cv_mem); - - /* Linear Solver specific memory */ - - void *cv_lmem; - - /* Flag to request a call to the setup routine */ - - booleantype cv_forceSetup; - - /*------------ - Saved Values - ------------*/ - - int cv_qu; /* last successful q value used */ - long int cv_nstlp; /* step number of last setup call */ - realtype cv_h0u; /* actual initial stepsize */ - realtype cv_hu; /* last successful h value used */ - realtype cv_saved_tq5; /* saved value of tq[5] */ - booleantype cv_jcur; /* Is the Jacobian info used by - linear solver current? */ - realtype cv_tolsf; /* tolerance scale factor */ - booleantype cv_setupNonNull; /* Does setup do something? */ - - /*-------------------------------------------------------------------- - Flags turned ON by CVodeMalloc, CVodeSensMalloc, and CVodeQuadMalloc - and read by CVodeReInit, CVodeSensReInit, and CVodeQuadReInit - --------------------------------------------------------------------*/ - - booleantype cv_MallocDone; - booleantype cv_sensMallocDone; - booleantype cv_quadMallocDone; - - /*---------- - Error File - ----------*/ - - FILE *cv_errfp; /* CVODE error messages are sent to errfp */ - - /*------------------------- - Stability Limit Detection - -------------------------*/ - - booleantype cv_sldeton; /* Is Stability Limit Detection on? */ - realtype cv_ssdat[6][4]; /* scaled data array for STALD */ - int cv_nscon; /* counter for STALD method */ - long int cv_nor; /* counter for number of order reductions */ - - /*---------------- - Rootfinding Data - ----------------*/ - - CVRootFn cv_gfun; /* Function g for roots sought */ - int cv_nrtfn; /* number of components of g */ - void *cv_g_data; /* pointer to user data for g */ - int *cv_iroots; /* int array for root information */ - realtype cv_tlo; /* nearest endpoint of interval in root search */ - realtype cv_thi; /* farthest endpoint of interval in root search */ - realtype cv_troot; /* approximate root location */ - realtype *cv_glo; /* saved array of g values at t = tlo */ - realtype *cv_ghi; /* saved array of g values at t = thi */ - realtype *cv_groot; /* array of g values at t = troot */ - realtype cv_tretlast; /* last value of t returned */ - realtype cv_toutc; /* copy of tout (if NORMAL mode) */ - realtype cv_ttol; /* tolerance on root location troot */ - int cv_taskc; /* copy of parameter task */ - int cv_irfnd; /* flag showing whether last step had a root */ - int cv_nge; /* counter for g evaluations */ - - /*------------------------- - Complex step memory block - -------------------------*/ - - void *cv_csmem; - -} *CVodeMem; - -/* - * ================================================================= - * C V O D E S E R R O R M E S S A G E S - * ================================================================= - */ - -#if defined(SUNDIALS_EXTENDED_PRECISION) - -#define MSG_TIME "t = %Lg" -#define MSG_TIME_H "t = %Lg and h = %Lg" -#define MSG_TIME_INT "t = %Lg is not between tcur - hu = %Lg and tcur = %Lg.\n\n" -#define MSG_TIME_TOUT "tout = %Lg" - -#elif defined(SUNDIALS_DOUBLE_PRECISION) - -#define MSG_TIME "t = %lg" -#define MSG_TIME_H "t = %lg and h = %lg" -#define MSG_TIME_INT "t = %lg is not between tcur - hu = %lg and tcur = %lg.\n\n" -#define MSG_TIME_TOUT "tout = %lg" - -#else - -#define MSG_TIME "t = %g" -#define MSG_TIME_H "t = %g and h = %g" -#define MSG_TIME_INT "t = %g is not between tcur - hu = %g and tcur = %g.\n\n" -#define MSG_TIME_TOUT "tout = %g" - -#endif - -/* CvodeCreate Error Messages */ - -#define _CVC_ "CVodeCreate-- " - -#define MSGCVS_BAD_LMM1 _CVC_ "Illegal value for lmm.\n" -#define MSGCVS_BAD_LMM2 "The legal values are CV_ADAMS and CV_BDF.\n\n" -#define MSGCVS_BAD_LMM MSGCVS_BAD_LMM1 MSGCVS_BAD_LMM2 - -#define MSGCVS_BAD_ITER1 _CVC_ "Illegal value for iter.\n" -#define MSGCVS_BAD_ITER2 "The legal values are CV_FUNCTIONAL " -#define MSGCVS_BAD_ITER3 "and CV_NEWTON.\n\n" -#define MSGCVS_BAD_ITER MSGCVS_BAD_ITER1 MSGCVS_BAD_ITER2 MSGCVS_BAD_ITER3 - -#define MSGCVS_CVMEM_FAIL _CVC_ "Allocation of cv_mem failed.\n\n" - -/* CVodeSet* Error Messages */ - -#define MSGCVS_SET_NO_MEM "cvode_mem = NULL in a CVodeSet routine illegal.\n\n" - -#define MSGCVS_SET_BAD_ITER1 "CVodeSetIterType-- Illegal value for iter.\n" -#define MSGCVS_SET_BAD_ITER2 "The legal values are CV_FUNCTIONAL " -#define MSGCVS_SET_BAD_ITER3 "and CV_NEWTON.\n\n" -#define MSGCVS_SET_BAD_ITER MSGCVS_SET_BAD_ITER1 MSGCVS_SET_BAD_ITER2 MSGCVS_SET_BAD_ITER3 - -#define MSGCVS_SET_NEG_MAXORD "CVodeSetMaxOrd-- maxord <= 0 illegal.\n\n" - -#define MSGCVS_SET_BAD_MAXORD1 "CVodeSetMaxOrd-- Illegal attempt to increase " -#define MSGCVS_SET_BAD_MAXORD2 "maximum method order.\n\n" -#define MSGCVS_SET_BAD_MAXORD MSGCVS_SET_BAD_MAXORD1 MSGCVS_SET_BAD_MAXORD2 - -#define MSGCVS_SET_NEG_MXSTEPS "CVodeSetMaxNumSteps-- mxsteps <= 0 illegal.\n\n" - -#define MSGCVS_SET_SLDET1 "CVodeSetStabLimDet-- Attempt to use stability " -#define MSGCVS_SET_SLDET2 "limit detection with the CV_ADAMS method illegal.\n\n" -#define MSGCVS_SET_SLDET MSGCVS_SET_SLDET1 MSGCVS_SET_SLDET2 - -#define MSGCVS_SET_NEG_HMIN "CVodeSetMinStep-- hmin <= 0 illegal.\n\n" - -#define MSGCVS_SET_NEG_HMAX "CVodeSetMaxStep-- hmax <= 0 illegal.\n\n" - -#define MSGCVS_SET_BAD_HMM1 "CVodeSetMinStep/CVodeSetMaxStep-- Inconsistent\n" -#define MSGCVS_SET_BAD_HMM2 "step size limits: hmin > hmax.\n\n" -#define MSGCVS_SET_BAD_HMIN_HMAX MSGCVS_SET_BAD_HMM1 MSGCVS_SET_BAD_HMM2 - -#define _CVSET_TOL_ "CVodeSetTolerances-- " - -#define MSGCVS_SET_BAD_ITOL1 _CVSET_TOL_ "Illegal value for itol.\n" -#define MSGCVS_SET_BAD_ITOL2 "The legal values are CV_SS and CV_SV.\n\n" -#define MSGCVS_SET_BAD_ITOL MSGCVS_SET_BAD_ITOL1 MSGCVS_SET_BAD_ITOL2 - -#define MSGCVS_SET_BAD_RELTOL _CVSET_TOL_ "*reltol < 0 illegal.\n\n" - -#define MSGCVS_SET_ABSTOL_NULL _CVSET_TOL_ "abstol = NULL illegal.\n\n" - -#define MSGCVS_SET_BAD_ABSTOL _CVSET_TOL_ "abstol has negative component(s) (illegal).\n\n" - -/* CVodeMalloc/CVodeReInit Error Messages */ - -#define _CVM_ "CVodeMalloc/CVodeReInit-- " - -#define MSGCVS_CVM_NO_MEM _CVM_ "cvode_mem = NULL illegal.\n\n" - -#define MSGCVS_Y0_NULL _CVM_ "y0 = NULL illegal.\n\n" - -#define MSGCVS_BAD_ITOL1 _CVM_ "Illegal value for itol.\n" -#define MSGCVS_BAD_ITOL2 "The legal values are CV_SS and CV_SV.\n\n" -#define MSGCVS_BAD_ITOL MSGCVS_BAD_ITOL1 MSGCVS_BAD_ITOL2 - -#define MSGCVS_F_NULL _CVM_ "f = NULL illegal.\n\n" - -#define MSGCVS_RELTOL_NULL _CVM_ "reltol = NULL illegal.\n\n" - -#define MSGCVS_BAD_RELTOL _CVM_ "*reltol < 0 illegal.\n\n" - -#define MSGCVS_ABSTOL_NULL _CVM_ "abstol = NULL illegal.\n\n" - -#define MSGCVS_BAD_ABSTOL _CVM_ "abstol has negative component(s) (illegal).\n\n" - -#define MSGCVS_BAD_NVECTOR _CVM_ "A required vector operation is not implemented.\n\n" - -#define MSGCVS_MEM_FAIL _CVM_ "A memory request failed.\n\n" - -#define MSGCVS_CVREI_NO_MALLOC "CVodeReInit-- Attempt to call before CVodeMalloc.\n\n" - -/* CVodeRootInit Error Messages */ - -#define _CVRT_ "CVodeRootInit-- " - -#define MSGCVS_ROOT_NO_MEM _CVRT_ "cvode_mem = NULL illegal.\n\n" - -#define MSGCVS_ROOT_MEM_FAIL _CVRT_ "A memory request failed.\n\n" - -#define MSGCVS_ROOT_FUNC_NULL _CVRT_ "g = NULL illegal.\n\n" - -/* CVodeQuadMalloc/CVodeQuadReInit Error Messages */ - -#define MSGCVS_BAD_ITOLQ1 "CVodeSetQuadTolerances-- Illegal value for itolQ.\n" -#define MSGCVS_BAD_ITOLQ2 "The legal values are CV_SS and CV_SV.\n\n" -#define MSGCVS_BAD_ITOLQ MSGCVS_BAD_ITOLQ1 MSGCVS_BAD_ITOLQ2 - -#define MSGCVS_RELTOLQ_NULL "CVodeSetQuadTolerances-- reltolQ = NULL illegal.\n\n" - -#define MSGCVS_ABSTOLQ_NULL "CVodeSetQuadTolerances-- abstolQ = NULL illegal.\n\n" - -#define MSGCVS_BAD_RELTOLQ "CVodeSetQuadTolerances-- *reltolQ < 0 illegal.\n\n" - -#define MSGCVS_BAD_ABSTOLQ "CVodeSetQuadTolerances-- abstolQ has negative component(s) (illegal).\n\n" - -#define MSGCVS_QCVM_NO_MEM "CVodeQuadMalloc/CVodeQuadReInit-- cvode_mem = NULL illegal.\n\n" - -#define MSGCVS_QCVM_MEM_FAIL "CVodeQuadMalloc/CVodeQuadReInit-- A memory request failed.\n\n" - -#define MSGCVS_QREI_QUAD1 "CVodeQuadReInit-- Illegal attempt to call before " -#define MSGCVS_QREI_QUAD2 "calling CVodeQuadMalloc.\n\n" -#define MSGCVS_QREI_NO_QUAD MSGCVS_QREI_QUAD1 MSGCVS_QREI_QUAD2 - -/* CVodeSetSens* /CVodeSensMalloc/CVodeSensReInit Error Messages */ - -#define MSGCVS_BAD_ITOLS1 "CVodeSetSensTolerances-- Illegal value for itolS.\n" -#define MSGCVS_BAD_ITOLS2 "The legal values are CV_SS, CV_SV, and CV_EE.\n\n" -#define MSGCVS_BAD_ITOLS MSGCVS_BAD_ITOLS1 MSGCVS_BAD_ITOLS2 - -#define MSGCVS_RELTOLS_NULL "CVodeSetSensTolerances-- reltolS = NULL illegal.\n\n" - -#define MSGCVS_ABSTOLS_NULL "CVodeSetSensTolerances-- abstolS = NULL illegal.\n\n" - -#define _SCVM_ "CVodeSensMalloc/CVodeSensReInit-- " - -#define MSGCVS_SCVM_NO_MEM _SCVM_ "cvode_mem = NULL illegal.\n\n" - -#define MSGCVS_SCVM_MEM_FAIL _SCVM_ "A memory request failed.\n\n" - -#define MSGCVS_BAD_NS _SCVM_ "NS <= 0 illegal.\n\n" - -#define MSGCVS_P_NULL _SCVM_ "p = NULL illegal.\n\n" - -#define MSGCVS_YS0_NULL _SCVM_ "yS0 = NULL illegal.\n\n" - -#define MSGCVS_BAD_ISM1 _SCVM_ "Illegal value for ism.\n" -#define MSGCVS_BAD_ISM2 "The legal values are: " -#define MSGCVS_BAD_ISM3 "CV_SIMULTANEOUS, CV_STAGGERED and CV_STAGGERED1.\n\n" -#define MSGCVS_BAD_ISM MSGCVS_BAD_ISM1 MSGCVS_BAD_ISM2 MSGCVS_BAD_ISM3 - -#define MSGCVS_SREI_SENSI1 "CVodeSensReInit-- Illegal attempt to call before " -#define MSGCVS_SREI_SENSI2 "calling CVodeSensMalloc.\n\n" -#define MSGCVS_SREI_NO_SENSI MSGCVS_SREI_SENSI1 MSGCVS_SREI_SENSI2 - -#define MSGCVS_SCVT_NO_MEM "CVodeSensToggle-- cvode_mem = NULL illegal.\n\n" - -#define MSGCVS_SCVT_SENSI1 "CVodeSensToggle-- Illegal attempt to call before " -#define MSGCVS_SCVT_SENSI2 "calling CVodeSensMalloc.\n\n" -#define MSGCVS_SCVT_NO_SENSI MSGCVS_SCVT_SENSI1 MSGCVS_SCVT_SENSI2 - -/* CVode Error Messages */ - -#define _CVODE_ "CVode-- " -#define _CVIS_ "Initial Setup: " - -#define MSGCVS_CVODE_NO_MEM _CVODE_ "cvode_mem = NULL illegal.\n\n" - -#define MSGCVS_CVODE_NO_MALLOC _CVODE_ "CVodeMalloc has not been called yet.\n\n" - -#define MSGCVS_BAD_RELTOLS _CVODE_ "*reltolS < 0 illegal.\n\n" - -#define MSGCVS_BAD_ABSTOLS _CVODE_ "abstolS has negative component(s) (illegal).\n\n" - -#define MSGCVS_ATOLS_MEM_FAIL _CVODE_ "A memory request failed (abstolS).\n\n" - -#define MSGCVS_BAD_PBAR _CVODE_ "pbar has component(s) equal to zero (illegal).\n\n" - -#define MSGCVS_BAD_EWT _CVODE_ _CVIS_ "Initial ewt has component(s) equal to zero (illegal).\n\n" - -#define MSGCVS_NO_QUADTOL _CVODE_ _CVIS_ "No quad tolerances set. Illegal for errconQ = TRUE.\n\n" - -#define MSGCVS_BAD_EWTQ _CVODE_ _CVIS_ "Initial ewtQ has component(s) equal to zero (illegal).\n\n" - -#define MSGCVS_BAD_ISM_IFS _CVODE_ _CVIS_ "Illegal sens. rhs for ism = CV_STAGGERED1.\n\n" - -#define MSGCVS_BAD_EWTS _CVODE_ _CVIS_ "Initial ewtS has component(s) equal to zero (illegal).\n\n" - -#define MSGCVS_LSOLVE_NULL _CVODE_ _CVIS_ "The linear solver's solve routine is NULL.\n\n" - -#define MSGCVS_LINIT_FAIL _CVODE_ _CVIS_ "The linear solver's init routine failed.\n\n" - -#define MSGCVS_YOUT_NULL _CVODE_ "yout = NULL illegal.\n\n" - -#define MSGCVS_TRET_NULL _CVODE_ "tret = NULL illegal.\n\n" - -#define MSGCVS_BAD_ITASK _CVODE_ "Illegal value for itask.\n" - -#define MSGCVS_NO_TSTOP1 _CVODE_ "itask = CV_NORMAL_TSTOP or itask = CV_ONE_STEP_TSTOP " -#define MSGCVS_NO_TSTOP2 "but tstop was not set.\n\n" -#define MSGCVS_NO_TSTOP MSGCVS_NO_TSTOP1 MSGCVS_NO_TSTOP2 - -#define MSGCVS_BAD_H0 _CVODE_ "h0 and tout - t0 are inconsistent.\n\n" - -#define MSGCVS_HNIL_DONE_1 _CVODE_ "The above warning has been issued mxhnil times " -#define MSGCVS_HNIL_DONE_2 "and will not be\nissued again for this problem.\n\n" -#define MSGCVS_HNIL_DONE MSGCVS_HNIL_DONE_1 MSGCVS_HNIL_DONE_2 - -#define MSGCVS_TOO_CLOSE_1 _CVODE_ "tout too close to t0 to start" -#define MSGCVS_TOO_CLOSE_2 " integration.\n\n" -#define MSGCVS_TOO_CLOSE MSGCVS_TOO_CLOSE_1 MSGCVS_TOO_CLOSE_2 - -#define MSGCVS_BAD_INIT_ROOT _CVODE_ "Root found at and very near initial t.\n\n" - -#define MSGCVS_BAD_TOUT_1 _CVODE_ "Trouble interpolating at" MSG_TIME_TOUT ".\n" -#define MSGCVS_BAD_TOUT_2 "tout too far back in direction of integration.\n\n" -#define MSGCVS_BAD_TOUT MSGCVS_BAD_TOUT_1 MSGCVS_BAD_TOUT_2 - -#define MSGCVS_MAX_STEPS_1 _CVODE_ "At " MSG_TIME ", mxstep steps taken" -#define MSGCVS_MAX_STEPS_2 "before reaching tout.\n\n" -#define MSGCVS_MAX_STEPS MSGCVS_MAX_STEPS_1 MSGCVS_MAX_STEPS_2 - -#define MSGCVS_EWT_NOW_BAD_1 _CVODE_ "At " MSG_TIME ", a component of ewt has become <= 0.\n\n" -#define MSGCVS_EWT_NOW_BAD MSGCVS_EWT_NOW_BAD_1 - -#define MSGCVS_EWTS_NOW_BAD_1 _CVODE_ "At " MSG_TIME ", a component of ewtS has become <= 0.\n\n" -#define MSGCVS_EWTS_NOW_BAD MSGCVS_EWTS_NOW_BAD_1 - -#define MSGCVS_EWTQ_NOW_BAD_1 _CVODE_ "At " MSG_TIME ", a component of ewtQ has become <= 0.\n\n" -#define MSGCVS_EWTQ_NOW_BAD MSGCVS_EWTQ_NOW_BAD_1 - -#define MSGCVS_TOO_MUCH_ACC _CVODE_ "At " MSG_TIME ", too much accuracy requested.\n\n" - -#define MSGCVS_HNIL_1 _CVODE_ "Warning: Internal " MSG_TIME_H -#define MSGCVS_HNIL_2 "\nare such that t + h = t on the next step.\n" -#define MSGCVS_HNIL_3 "The solver will continue anyway.\n\n" -#define MSGCVS_HNIL MSGCVS_HNIL_1 MSGCVS_HNIL_2 MSGCVS_HNIL_3 - -#define MSGCVS_ERR_FAILS_1 _CVODE_ "At " MSG_TIME_H ", the error test\n" -#define MSGCVS_ERR_FAILS_2 "failed repeatedly or with |h| = hmin.\n\n" -#define MSGCVS_ERR_FAILS MSGCVS_ERR_FAILS_1 MSGCVS_ERR_FAILS_2 - -#define MSGCVS_CONV_FAILS_1 _CVODE_ "At " MSG_TIME_H ", the corrector\n" -#define MSGCVS_CONV_FAILS_2 "convergence failed repeatedly or " -#define MSGCVS_CONV_FAILS_3 "with |h| = hmin.\n\n" -#define MSGCVS_CONV_FAILS MSGCVS_CONV_FAILS_1 MSGCVS_CONV_FAILS_2 MSGCVS_CONV_FAILS_3 - -#define MSGCVS_SETUP_FAILED_1 _CVODE_ "At " MSG_TIME ", the setup routine failed " -#define MSGCVS_SETUP_FAILED_2 "in an unrecoverable manner.\n\n" -#define MSGCVS_SETUP_FAILED MSGCVS_SETUP_FAILED_1 MSGCVS_SETUP_FAILED_2 - -#define MSGCVS_SOLVE_FAILED_1 _CVODE_ "At " MSG_TIME ", the solve routine failed in an " -#define MSGCVS_SOLVE_FAILED_2 "unrecoverable manner.\n\n" -#define MSGCVS_SOLVE_FAILED MSGCVS_SOLVE_FAILED_1 MSGCVS_SOLVE_FAILED_2 - -#define MSGCVS_BAD_TSTOP_1 _CVODE_ "tstop is behind current " MSG_TIME -#define MSGCVS_BAD_TSTOP_2 "\nin the direction of integration.\n\n" -#define MSGCVS_BAD_TSTOP MSGCVS_BAD_TSTOP_1 MSGCVS_BAD_TSTOP_2 - -#define MSGCVS_CLOSE_ROOTS _CVODE_ "Root found at and very near current " MSG_TIME ".\n\n" - -/* CVodeGetDky Error Messages */ - -#define _DKY_ "CVodeGetDky-- " - -#define MSGCVS_DKY_NO_MEM _DKY_ "cvode_mem = NULL illegal.\n\n" - -#define MSGCVS_BAD_K _DKY_ "Illegal value for k.\n\n" - -#define MSGCVS_BAD_DKY _DKY_ "dky = NULL illegal.\n\n" - -#define MSGCVS_BAD_T1 _DKY_ "Illegal value for t.\n" -#define MSGCVS_BAD_T2 MSG_TIME_INT -#define MSGCVS_BAD_T MSGCVS_BAD_T1 MSGCVS_BAD_T2 - -/* CVodeGetSens/CVodeGetSens1/CVodeGetSensDky1/CVodeGetSensDky Error Messages */ - -#define _SDKY_ "CVodeGetSens/CVodeGetSens1/CVodeGetSensDky/CVodeGetSensDky1-- " - -#define MSGCVS_SDKY_NO_MEM _SDKY_ "cvode_mem = NULL illegal.\n\n" - -#define MSGCVS_SDKY_SENSI_1 "Illegal attempt to call before " -#define MSGCVS_SDKY_SENSI_2 "calling CVodeSensMalloc.\n\n" -#define MSGCVS_SDKY_NO_SENSI _SDKY_ MSGCVS_SDKY_SENSI_1 MSGCVS_SDKY_SENSI_2 - -#define MSGCVS_SBAD_IS _SDKY_ "Illegal value for is.\n\n" - -#define MSGCVS_SBAD_K _SDKY_ "Illegal value for k.\n\n" - -#define MSGCVS_SBAD_T_1 _SDKY_ "Illegal value for t.\n" -#define MSGCVS_SBAD_T_2 "t not in interval tcur - hu to tcur.\n\n" -#define MSGCVS_SBAD_T MSGCVS_SBAD_T_1 MSGCVS_SBAD_T_2 - -#define MSGCVS_SBAD_DKYA _SDKY_ "dkyA = NULL illegal.\n\n" -#define MSGCVS_SBAD_DKY _SDKY_ "dky = NULL illegal.\n\n" - -/* CVodeGetQuad/CVodeGetQuadDky Error Messages */ - -#define _QDKY_ "CVodeGetQuad/CVodeGetQuadDky-- " - -#define MSGCVS_QDKY_NO_MEM _QDKY_ "cvode_mem = NULL illegal.\n\n" - -#define MSGCVS_QDKY_QUAD_1 "Illegal attempt to call before " -#define MSGCVS_QDKY_QUAD_2 "calling CVodeQuadMalloc.\n\n" -#define MSGCVS_QDKY_NO_QUAD _QDKY_ MSGCVS_QDKY_QUAD_1 MSGCVS_QDKY_QUAD_2 - -#define MSGCVS_QBAD_DKY _QDKY_ "dky = NULL illegal.\n\n" - -#define MSGCVS_QBAD_K _QDKY_ "Illegal value for k.\n\n" - -#define MSGCVS_QBAD_T_1 _QDKY_ "Illegal value for t.\n" -#define MSGCVS_QBAD_T_2 MSG_TIME_INT -#define MSGCVS_QBAD_T MSGCVS_QBAD_T_1 MSGCVS_QBAD_T_2 - -/* CVodeGet* Error Messages */ - -#define MSGCVS_GET_NO_MEM "cvode_mem = NULL in a CVodeGet routine illegal. \n\n" - -#define MSGCVS_GET_NO_SLDET1 "CVodeGetNumStabLimOrderReds-- Illegal attempt " -#define MSGCVS_GET_NO_SLDET2 "to call without enabling SLDET.\n\n" -#define MSGCVS_GET_NO_SLDET MSGCVS_GET_NO_SLDET1 MSGCVS_GET_NO_SLDET2 - -#define MSGCVS_GET_NO_QUAD1 "CVodeGetQuad*-- Illegal attempt to call before " -#define MSGCVS_GET_NO_QUAD2 "calling CVodeQuadMalloc.\n\n" -#define MSGCVS_GET_NO_QUAD MSGCVS_GET_NO_QUAD1 MSGCVS_GET_NO_QUAD2 - -#define MSGCVS_GET_NO_SENSI1 "CVodeGetSens*-- Illegal attempt to call before " -#define MSGCVS_GET_NO_SENSI2 "calling CVodeSensMalloc.\n\n" -#define MSGCVS_GET_NO_SENSI MSGCVS_GET_NO_SENSI1 MSGCVS_GET_NO_SENSI2 - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/cvodes/cvodesio.c b/src/sundials/cvodes/cvodesio.c deleted file mode 100755 index d7e40b7472..0000000000 --- a/src/sundials/cvodes/cvodesio.c +++ /dev/null @@ -1,1725 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for the optional input and output - * functions for the CVODES solver. - * ----------------------------------------------------------------- - */ - -#include -#include - -#include "cvodes_impl.h" -#include "sundialstypes.h" - -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) - -/* - * ================================================================= - * CVODE optional input functions - * ================================================================= - */ - -/* - * CVodeSetErrFile - * - * Specifies the FILE pointer for output (NULL means no messages) - */ - -int CVodeSetErrFile(void *cvode_mem, FILE *errfp) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_errfp = errfp; - - return(CV_SUCCESS); -} - -#define errfp (cv_mem->cv_errfp) - -/* - * CVodeSetIterType - * - * Specifies the iteration type (CV_FUNCTIONAL or CV_NEWTON) - */ - -int CVodeSetIterType(void *cvode_mem, int iter) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if ((iter != CV_FUNCTIONAL) && (iter != CV_NEWTON)) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SET_BAD_ITER); - return (CV_ILL_INPUT); - } - - cv_mem->cv_iter = iter; - - return(CV_SUCCESS); -} - -/* - * CVodeSetFdata - * - * Specifies the user data pointer for f - */ - -int CVodeSetFdata(void *cvode_mem, void *f_data) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_f_data = f_data; - - return(CV_SUCCESS); -} - -/* - * CVodeSetGdata - * - * Specifies the user data pointer for g - */ - -int CVodeSetGdata(void *cvode_mem, void *g_data) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_g_data = g_data; - - return(CV_SUCCESS); -} - -/* - * CVodeSetMaxOrd - * - * Specifies the maximum method order - */ - -int CVodeSetMaxOrd(void *cvode_mem, int maxord) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (maxord <= 0) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SET_NEG_MAXORD); - return(CV_ILL_INPUT); - } - - if (maxord > cv_mem->cv_qmax) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SET_BAD_MAXORD); - return(CV_ILL_INPUT); - } - - cv_mem->cv_qmax = maxord; - - return(CV_SUCCESS); -} - -/* - * CVodeSetMaxNumSteps - * - * Specifies the maximum number of integration steps - */ - -int CVodeSetMaxNumSteps(void *cvode_mem, long int mxsteps) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (mxsteps<=0) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SET_NEG_MXSTEPS); - return(CV_ILL_INPUT); - } - - cv_mem->cv_mxstep = mxsteps; - - return(CV_SUCCESS); -} - -/* - * CVodeSetMaxHnilWarns - * - * Specifies the maximum number of warnings for small h - */ - -int CVodeSetMaxHnilWarns(void *cvode_mem, int mxhnil) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_mxhnil = mxhnil; - - return(CV_SUCCESS); -} - -/* - *CVodeSetStabLimDet - * - * Turns on/off the stability limit detection algorithm - */ - -int CVodeSetStabLimDet(void *cvode_mem, booleantype sldet) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if(cv_mem->cv_lmm != CV_BDF) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SET_SLDET); - return(CV_ILL_INPUT); - } - - cv_mem->cv_sldeton = sldet; - - return(CV_SUCCESS); -} - -/* - * CVodeSetInitStep - * - * Specifies the initial step size - */ - -int CVodeSetInitStep(void *cvode_mem, realtype hin) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_hin = hin; - - return(CV_SUCCESS); -} - -/* - * CVodeSetMinStep - * - * Specifies the minimum step size - */ - -int CVodeSetMinStep(void *cvode_mem, realtype hmin) -{ - realtype hmax; - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (hmin<=0) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SET_NEG_HMIN); - return(CV_ILL_INPUT); - } - - if (hmin * cv_mem->cv_hmax_inv > ONE) { - hmax = ONE/cv_mem->cv_hmax_inv; - if(errfp!=NULL) fprintf(errfp, MSGCVS_SET_BAD_HMIN_HMAX); - return(CV_ILL_INPUT); - } - - cv_mem->cv_hmin = hmin; - - return(CV_SUCCESS); -} - -/* - * CVodeSetMaxStep - * - * Specifies the maximum step size - */ - -int CVodeSetMaxStep(void *cvode_mem, realtype hmax) -{ - realtype hmax_inv; - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return (CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (hmax <= 0) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SET_NEG_HMAX); - return(CV_ILL_INPUT); - } - - hmax_inv = ONE/hmax; - if (hmax_inv * cv_mem->cv_hmin > ONE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SET_BAD_HMIN_HMAX); - return(CV_ILL_INPUT); - } - - cv_mem->cv_hmax_inv = hmax_inv; - - return(CV_SUCCESS); -} - -/* - * CVodeSetStopTime - * - * Specifies the time beyond which the integration is not to - * proceed - */ - -int CVodeSetStopTime(void *cvode_mem, realtype tstop) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return (CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_tstop = tstop; - cv_mem->cv_tstopset = TRUE; - - return(CV_SUCCESS); -} - -/* - * CVodeSetMaxErrTestFails - * - * Specifies the maximum number of error test failures during one - * step try. - */ - -int CVodeSetMaxErrTestFails(void *cvode_mem, int maxnef) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return (CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_maxnef = maxnef; - - return(CV_SUCCESS); -} - -/* - * CVodeSetMaxConvFails - * - * Specifies the maximum number of nonlinear convergence failures - * during one step try. - */ - -int CVodeSetMaxConvFails(void *cvode_mem, int maxncf) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return (CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_maxncf = maxncf; - - return(CV_SUCCESS); -} - -/* - * CVodeSetMaxNonlinIters - * - * Specifies the maximum number of nonlinear iterations during - * one solve. - */ - -int CVodeSetMaxNonlinIters(void *cvode_mem, int maxcor) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return (CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_maxcor = maxcor; - - return(CV_SUCCESS); -} - -/* - * CVodeSetNonlinConvCoef - * - * Specifies the coeficient in the nonlinear solver convergence - * test - */ - -int CVodeSetNonlinConvCoef(void *cvode_mem, realtype nlscoef) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_nlscoef = nlscoef; - - return(CV_SUCCESS); -} - -/* - * CVodeSetTolerances - * - * Changes te integration tolerances between calls to CVode() - */ - -int CVodeSetTolerances(void *cvode_mem, - int itol, realtype *reltol, void *abstol) -{ - CVodeMem cv_mem; - booleantype neg_abstol; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if ((itol != CV_SS) && (itol != CV_SV)) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SET_BAD_ITOL); - return(CV_ILL_INPUT); - } - - if (*reltol < ZERO) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SET_BAD_RELTOL); - return(CV_ILL_INPUT); - } - - if (abstol == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SET_ABSTOL_NULL); - return(CV_ILL_INPUT); - } - - if (itol == CV_SS) { - neg_abstol = (*((realtype *)abstol) < ZERO); - } else { - neg_abstol = (N_VMin((N_Vector)abstol) < ZERO); - } - if (neg_abstol) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_SET_BAD_ABSTOL); - return(CV_ILL_INPUT); - } - - cv_mem->cv_itol = itol; - cv_mem->cv_reltol = reltol; - cv_mem->cv_abstol = abstol; - - return(CV_SUCCESS); -} - -/* - * ================================================================= - * Quadrature optional input functions - * ================================================================= - */ - -int CVodeSetQuadFdata(void *cvode_mem, void *fQ_data) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_fQ_data = fQ_data; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeSetQuadErrCon(void *cvode_mem, booleantype errconQ) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_errconQ = errconQ; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeSetQuadTolerances(void *cvode_mem, int itolQ, - realtype *reltolQ, void *abstolQ) -{ - CVodeMem cv_mem; - booleantype neg_abstol; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if ((itolQ != CV_SS) && (itolQ != CV_SV)) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_ITOLQ); - return(CV_ILL_INPUT); - } - - if (reltolQ == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_RELTOLQ_NULL); - return(CV_ILL_INPUT); - } - - if (*reltolQ < ZERO) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_RELTOLQ); - return(CV_ILL_INPUT); - } - - if (abstolQ == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_ABSTOLQ_NULL); - return(CV_ILL_INPUT); - } - - if (itolQ == CV_SS) { - neg_abstol = (*((realtype *)abstolQ) < ZERO); - } else { - neg_abstol = (N_VMin((N_Vector)abstolQ) < ZERO); - } - if (neg_abstol) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_ABSTOLQ); - return(CV_ILL_INPUT); - } - - cv_mem->cv_itolQ = itolQ; - cv_mem->cv_reltolQ = reltolQ; - cv_mem->cv_abstolQ = abstolQ; - - return(CV_SUCCESS); -} - -/* - * ================================================================= - * FSA optional input functions - * ================================================================= - */ - - -int CVodeSetSensRhsFn(void *cvode_mem, CVSensRhsFn fS) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_ifS = CV_ALLSENS; - - if (fS != NULL) { - cv_mem->cv_fS = fS; - cv_mem->cv_fSDQ = FALSE; - } else { - cv_mem->cv_fS = CVSensRhsDQ; - cv_mem->cv_fS_data = cvode_mem; - cv_mem->cv_fSDQ = TRUE; - } - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeSetSensRhs1Fn(void *cvode_mem, CVSensRhs1Fn fS1) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_ifS = CV_ONESENS; - - if(fS1 != NULL) { - cv_mem->cv_fS1 = fS1; - cv_mem->cv_fSDQ = FALSE; - } else { - cv_mem->cv_fS1 = CVSensRhs1DQ; - cv_mem->cv_fS_data = cvode_mem; - cv_mem->cv_fSDQ = TRUE; - } - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeSetSensFdata(void *cvode_mem, void *fS_data) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_fS_data = fS_data; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeSetSensRho(void *cvode_mem, realtype rho) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_rhomax = rho; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeSetSensPbar(void *cvode_mem, realtype *pbar) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_pbar = pbar; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeSetSensErrCon(void *cvode_mem, booleantype errconS) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_errconS = errconS; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeSetSensMaxNonlinIters(void *cvode_mem, int maxcorS) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return (CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - cv_mem->cv_maxcorS = maxcorS; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeSetSensTolerances(void *cvode_mem, int itolS, - realtype *reltolS, void *abstolS) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_SET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if ((itolS != CV_SS) && (itolS != CV_SV) && (itolS != CV_EE)) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_BAD_ITOLS); - return(CV_ILL_INPUT); - } - - if (itolS == CV_EE) { - - /* CVODES will set tolerances */ - cv_mem->cv_setSensTol = TRUE; - cv_mem->cv_testSensTol = FALSE; - - } else { - - /* Test user-supplied tolerances */ - if (reltolS == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_RELTOLS_NULL); - return(CV_ILL_INPUT); - } - - if (abstolS == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_ABSTOLS_NULL); - return(CV_ILL_INPUT); - } - - cv_mem->cv_itolS = itolS; - cv_mem->cv_reltolS = reltolS; - cv_mem->cv_abstolS = abstolS; - - cv_mem->cv_setSensTol = FALSE; - cv_mem->cv_testSensTol = TRUE; - - } - - return(CV_SUCCESS); -} - -/* - * ================================================================= - * CVODE optional output functions - * ================================================================= - */ - -/* - * Readability constants - */ - -#define nst (cv_mem->cv_nst) -#define nfe (cv_mem->cv_nfe) -#define ncfn (cv_mem->cv_ncfn) -#define netf (cv_mem->cv_netf) -#define nni (cv_mem->cv_nni) -#define nsetups (cv_mem->cv_nsetups) -#define q (cv_mem->cv_q) -#define next_q (cv_mem->cv_next_q) -#define ewt (cv_mem->cv_ewt) -#define h (cv_mem->cv_h) -#define next_h (cv_mem->cv_next_h) -#define h0u (cv_mem->cv_h0u) -#define tolsf (cv_mem->cv_tolsf) -#define acor (cv_mem->cv_acor) -#define lrw (cv_mem->cv_lrw) -#define liw (cv_mem->cv_liw) -#define nge (cv_mem->cv_nge) -#define iroots (cv_mem->cv_iroots) -#define nor (cv_mem->cv_nor) -#define sldeton (cv_mem->cv_sldeton) -#define tn (cv_mem->cv_tn) - -/* - * CVodeGetNumSteps - * - * Returns the current number of integration steps - */ - -int CVodeGetNumSteps(void *cvode_mem, long int *nsteps) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *nsteps = nst; - - return(CV_SUCCESS); -} - -/* - * CVodeGetNumRhsEvals - * - * Returns the current number of calls to f - */ - -int CVodeGetNumRhsEvals(void *cvode_mem, long int *nfevals) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *nfevals = nfe; - - return(CV_SUCCESS); -} - -/* - * CVodeGetNumLinSolvSetups - * - * Returns the current number of calls to the linear solver setup routine - */ - -int CVodeGetNumLinSolvSetups(void *cvode_mem, long int *nlinsetups) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *nlinsetups = nsetups; - - return(CV_SUCCESS); -} - -/* - * CVodeGetNumErrTestFails - * - * Returns the current number of error test failures - */ - -int CVodeGetNumErrTestFails(void *cvode_mem, long int *netfails) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *netfails = netf; - - return(CV_SUCCESS); -} - -/* - * CVodeGetLastOrder - * - * Returns the order on the last succesful step - */ - -int CVodeGetLastOrder(void *cvode_mem, int *qlast) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *qlast = q; - - return(CV_SUCCESS); -} - -/* - * CVodeGetCurrentOrder - * - * Returns the order to be attempted on the next step - */ - -int CVodeGetCurrentOrder(void *cvode_mem, int *qcur) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *qcur = next_q; - - return(CV_SUCCESS); -} - -/* - * CVodeGetNumStabLimOrderReds - * - * Returns the number of order reductions triggered by the stability - * limit detection algorithm - */ - -int CVodeGetNumStabLimOrderReds(void *cvode_mem, long int *nslred) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (sldeton==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_SLDET); - return(CV_NO_SLDET); - } - - *nslred = nor; - - return(CV_SUCCESS); -} - -/* - * CVodeGetActualInitStep - * - * Returns the step size used on the first step - */ - -int CVodeGetActualInitStep(void *cvode_mem, realtype *hinused) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *hinused = h0u; - - return(CV_SUCCESS); -} - -/* - * CVodeGetLastStep - * - * Returns the step size used on the last successful step - */ - -int CVodeGetLastStep(void *cvode_mem, realtype *hlast) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *hlast = h; - - return(CV_SUCCESS); -} - -/* - * CVodeGetCurrentStep - * - * Returns the step size to be attempted on the next step - */ - -int CVodeGetCurrentStep(void *cvode_mem, realtype *hcur) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *hcur = next_h; - - return(CV_SUCCESS); -} - -/* - * CVodeGetCurrentTime - * - * Returns the current value of the independent variable - */ - -int CVodeGetCurrentTime(void *cvode_mem, realtype *tcur) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *tcur = tn; - - return(CV_SUCCESS); -} - -/* - * CVodeGetTolScaleFactor - * - * Returns a suggested factor for scaling tolerances - */ - -int CVodeGetTolScaleFactor(void *cvode_mem, realtype *tolsfact) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *tolsfact = tolsf; - - return(CV_SUCCESS); -} - -/* - * CVodeGetErrWeights - * - * This routine returns the current weight vector for y in weight. - * Note that weight need not be allocated by the user. - */ - -int CVodeGetErrWeights(void *cvode_mem, N_Vector *eweight) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *eweight = ewt; - - return(CV_SUCCESS); -} - -/* - * CVodeGetEstLocalErrors - * - * Returns an estimate of the local error - */ - -int CVodeGetEstLocalErrors(void *cvode_mem, N_Vector *ele) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *ele = acor; - - return(CV_SUCCESS); -} - -/* - * CVodeGetWorkSpace - * - * Returns integrator work space requirements - */ - -int CVodeGetWorkSpace(void *cvode_mem, long int *lenrw, long int *leniw) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *leniw = liw; - *lenrw = lrw; - - return(CV_SUCCESS); -} - -/* - * CVodeGetIntegratorStats - * - * Returns integrator statistics - */ - -int CVodeGetIntegratorStats(void *cvode_mem, long int *nsteps, long int *nfevals, - long int *nlinsetups, long int *netfails, int *qlast, - int *qcur, realtype *hinused, realtype *hlast, - realtype *hcur, realtype *tcur) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *nsteps = nst; - *nfevals = nfe; - *nlinsetups = nsetups; - *netfails = netf; - *qlast = q; - *qcur = next_q; - *hinused = h0u; - *hlast = h; - *hcur = next_h; - *tcur = tn; - - return(CV_SUCCESS); -} - -/* - * CVodeGetNumGEvals - * - * Returns the current number of calls to g (for rootfinding) - */ - -int CVodeGetNumGEvals(void *cvode_mem, long int *ngevals) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *ngevals = nge; - - return(CV_SUCCESS); -} - -/* - * CVodeGetRootInfo - * - * Returns pointer to array rootsfound showing roots found - */ - -int CVodeGetRootInfo(void *cvode_mem, int **rootsfound) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *rootsfound = iroots; - - return(CV_SUCCESS); -} - - -/* - * CVodeGetNumNonlinSolvIters - * - * Returns the current number of iterations in the nonlinear solver - */ - -int CVodeGetNumNonlinSolvIters(void *cvode_mem, long int *nniters) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *nniters = nni; - - return(CV_SUCCESS); -} - -/* - * CVodeGetNumNonlinSolvConvFails - * - * Returns the current number of convergence failures in the - * nonlinear solver - */ - -int CVodeGetNumNonlinSolvConvFails(void *cvode_mem, long int *nncfails) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *nncfails = ncfn; - - return(CV_SUCCESS); -} - -/* - * CVodeGetNonlinSolvStats - * - * Returns nonlinear solver statistics - */ - -int CVodeGetNonlinSolvStats(void *cvode_mem, long int *nniters, - long int *nncfails) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - *nniters = nni; - *nncfails = ncfn; - - return(CV_SUCCESS); -} - -/* - * ================================================================= - * Quadrature optional output functions - * ================================================================= - */ - -/* - * Readability constants - */ - -#define quadr (cv_mem->cv_quadr) -#define nfQe (cv_mem->cv_nfQe) -#define netfQ (cv_mem->cv_netfQ) -#define ewtQ (cv_mem->cv_ewtQ) -#define errconQ (cv_mem->cv_errconQ) - -/*-----------------------------------------------------------------*/ - -int CVodeGetQuadNumRhsEvals(void *cvode_mem, long int *nfQevals) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (quadr==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_QUAD); - return(CV_NO_QUAD); - } - - *nfQevals = nfQe; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeGetQuadNumErrTestFails(void *cvode_mem, long int *nQetfails) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (quadr==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_QUAD); - return(CV_NO_QUAD); - } - - *nQetfails = netfQ; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeGetQuadErrWeights(void *cvode_mem, N_Vector *eQweight) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (quadr==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_QUAD); - return(CV_NO_QUAD); - } - - if(errconQ) *eQweight = ewtQ; - else *eQweight = NULL; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeGetQuadStats(void *cvode_mem, long int *nfQevals, long int *nQetfails) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (quadr==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_QUAD); - return(CV_NO_QUAD); - } - - *nfQevals = nfQe; - *nQetfails = netfQ; - - return(CV_SUCCESS); -} - -/* - * ================================================================= - * FSA optional output functions - * ================================================================= - */ - -/* - * Readability constants - */ - -#define sensi (cv_mem->cv_sensi) -#define ism (cv_mem->cv_ism) -#define ewtS (cv_mem->cv_ewtS) -#define nfSe (cv_mem->cv_nfSe) -#define nfeS (cv_mem->cv_nfeS) -#define nniS (cv_mem->cv_nniS) -#define ncfnS (cv_mem->cv_ncfnS) -#define netfS (cv_mem->cv_netfS) -#define nsetupsS (cv_mem->cv_nsetupsS) -#define nniS1 (cv_mem->cv_nniS1) -#define ncfnS1 (cv_mem->cv_ncfnS1) -#define ncfS1 (cv_mem->cv_ncfS1) - -/*-----------------------------------------------------------------*/ - -int CVodeGetNumSensRhsEvals(void *cvode_mem, long int *nfSevals) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (sensi==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_SENSI); - return(CV_NO_SENS); - } - - *nfSevals = nfSe; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeGetNumRhsEvalsSens(void *cvode_mem, long int *nfevalsS) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (sensi==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_SENSI); - return(CV_NO_SENS); - } - - *nfevalsS = nfeS; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeGetNumSensErrTestFails(void *cvode_mem, long int *nSetfails) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (sensi==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_SENSI); - return(CV_NO_SENS); - } - - *nSetfails = netfS; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeGetNumSensLinSolvSetups(void *cvode_mem, long int *nlinsetupsS) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (sensi==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_SENSI); - return(CV_NO_SENS); - } - - *nlinsetupsS = nsetupsS; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeGetSensErrWeights(void *cvode_mem, N_Vector_S *eSweight) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (sensi==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_SENSI); - return(CV_NO_SENS); - } - - *eSweight = ewtS; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeGetSensStats(void *cvode_mem, long int *nfSevals, long int *nfevalsS, - long int *nSetfails, long int *nlinsetupsS) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (sensi==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_SENSI); - return(CV_NO_SENS); - } - - *nfSevals = nfSe; - *nfevalsS = nfeS; - *nSetfails = netfS; - *nlinsetupsS = nsetupsS; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeGetNumSensNonlinSolvIters(void *cvode_mem, long int *nSniters) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (sensi==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_SENSI); - return(CV_NO_SENS); - } - - *nSniters = nniS; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeGetNumSensNonlinSolvConvFails(void *cvode_mem, long int *nSncfails) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (sensi==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_SENSI); - return(CV_NO_SENS); - } - - *nSncfails = ncfnS; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeGetNumStgrSensNonlinSolvIters(void *cvode_mem, long int *nSTGR1niters) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (sensi==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_SENSI); - return(CV_NO_SENS); - } - - if(ism==CV_STAGGERED1) nSTGR1niters = nniS1; - else nSTGR1niters = NULL; - - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeGetNumStgrSensNonlinSolvConvFails(void *cvode_mem, long int *nSTGR1ncfails) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (sensi==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_SENSI); - return(CV_NO_SENS); - } - - if(ism==CV_STAGGERED1) nSTGR1ncfails = ncfnS1; - else nSTGR1ncfails = NULL; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeGetSensNonlinSolvStats(void *cvode_mem, long int *nSniters, - long int *nSncfails) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (sensi==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_SENSI); - return(CV_NO_SENS); - } - - *nSniters = nniS; - *nSncfails = ncfnS; - - return(CV_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int CVodeGetStgrSensNonlinSolvStats(void *cvode_mem, long int *nSTGR1niters, - long int *nSTGR1ncfails) -{ - CVodeMem cv_mem; - - if (cvode_mem==NULL) { - fprintf(stderr, MSGCVS_GET_NO_MEM); - return(CV_MEM_NULL); - } - - cv_mem = (CVodeMem) cvode_mem; - - if (sensi==FALSE) { - if(errfp!=NULL) fprintf(errfp, MSGCVS_GET_NO_SENSI); - return(CV_NO_SENS); - } - - if(ism==CV_STAGGERED1) { - nSTGR1niters = nniS1; - nSTGR1ncfails = ncfnS1; - } else { - nSTGR1niters = NULL; - nSTGR1ncfails = NULL; - } - return(CV_SUCCESS); -} - diff --git a/src/sundials/cvodes/cvspgmr.c b/src/sundials/cvodes/cvspgmr.c deleted file mode 100755 index 6452d3c1cc..0000000000 --- a/src/sundials/cvodes/cvspgmr.c +++ /dev/null @@ -1,996 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for the CVSPGMR linear solver. - * ----------------------------------------------------------------- - */ - -#include -#include - -#include "cvspgmr_impl.h" -#include "cvodes_impl.h" - -#include "sundialsmath.h" - -/* Other Constants */ - -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) - -/* CVSPGMR linit, lsetup, lsolve, and lfree routines */ - -static int CVSpgmrInit(CVodeMem cv_mem); - -static int CVSpgmrSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, - N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, - N_Vector vtemp2, N_Vector vtemp3); - -static int CVSpgmrSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, - N_Vector ynow, N_Vector fnow); - -static void CVSpgmrFree(CVodeMem cv_mem); - -/* CVSPGMR Atimes and PSolve routines called by generic SPGMR solver */ - -static int CVSpgmrAtimes(void *cv_mem, N_Vector v, N_Vector z); - -static int CVSpgmrPSolve(void *cv_mem, N_Vector r, N_Vector z, int lr); - -/* CVSPGMR difference quotient routine for J*v */ - -static int CVSpgmrDQJtimes(N_Vector v, N_Vector Jv, realtype t, - N_Vector y, N_Vector fy, void *jac_data, - N_Vector work); -/* Readability Replacements */ - -#define lrw1 (cv_mem->cv_lrw1) -#define liw1 (cv_mem->cv_liw1) -#define uround (cv_mem->cv_uround) -#define tq (cv_mem->cv_tq) -#define nst (cv_mem->cv_nst) -#define tn (cv_mem->cv_tn) -#define h (cv_mem->cv_h) -#define gamma (cv_mem->cv_gamma) -#define gammap (cv_mem->cv_gammap) -#define nfe (cv_mem->cv_nfe) -#define f (cv_mem->cv_f) -#define f_data (cv_mem->cv_f_data) -#define ewt (cv_mem->cv_ewt) -#define errfp (cv_mem->cv_errfp) -#define mnewt (cv_mem->cv_mnewt) -#define ropt (cv_mem->cv_ropt) -#define linit (cv_mem->cv_linit) -#define lsetup (cv_mem->cv_lsetup) -#define lsolve (cv_mem->cv_lsolve) -#define lfree (cv_mem->cv_lfree) -#define lmem (cv_mem->cv_lmem) -#define vec_tmpl (cv_mem->cv_tempv) -#define setupNonNull (cv_mem->cv_setupNonNull) - -#define sqrtN (cvspgmr_mem->g_sqrtN) -#define ytemp (cvspgmr_mem->g_ytemp) -#define x (cvspgmr_mem->g_x) -#define ycur (cvspgmr_mem->g_ycur) -#define fcur (cvspgmr_mem->g_fcur) -#define delta (cvspgmr_mem->g_delta) -#define deltar (cvspgmr_mem->g_deltar) -#define npe (cvspgmr_mem->g_npe) -#define nli (cvspgmr_mem->g_nli) -#define nps (cvspgmr_mem->g_nps) -#define ncfl (cvspgmr_mem->g_ncfl) -#define nstlpre (cvspgmr_mem->g_nstlpre) -#define njtimes (cvspgmr_mem->g_njtimes) -#define nfeSG (cvspgmr_mem->g_nfeSG) -#define spgmr_mem (cvspgmr_mem->g_spgmr_mem) -#define last_flag (cvspgmr_mem->g_last_flag) - -/* - * ----------------------------------------------------------------- - * CVSpgmr - * ----------------------------------------------------------------- - * This routine initializes the memory record and sets various function - * fields specific to the Spgmr linear solver module. CVSpgmr first - * calls the existing lfree routine if this is not NULL. It then sets - * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) - * to be CVSpgmrInit, CVSpgmrSetup, CVSpgmrSolve, and CVSpgmrFree, - * respectively. It allocates memory for a structure of type - * CVSpgmrMemRec and sets the cv_lmem field in (*cvode_mem) to the - * address of this structure. It sets setupNonNull in (*cvode_mem), - * and sets the following fields in the CVSpgmrMemRec structure: - * g_pretype = pretype - * g_gstype = gstype - * g_maxl = MIN(N,CVSPGMR_MAXL) if maxl <= 0 - * = maxl if maxl > 0 - * g_delt = CVSPGMR_DELT if delt == 0.0 - * = delt if delt != 0.0 - * g_P_data = P_data - * g_pset = pset - * g_psolve = psolve - * g_jtimes = input parameter jtimes if jtimes != NULL - * = CVSpgmrDQJtimes otherwise - * g_j_data = input parameter jac_data - * Finally, CVSpgmr allocates memory for ytemp and x, and calls - * SpgmrMalloc to allocate memory for the Spgmr solver. - * ----------------------------------------------------------------- - */ - -int CVSpgmr(void *cvode_mem, int pretype, int maxl) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - int mxl; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - /* Check if N_VDotProd is present */ - if(vec_tmpl->ops->nvdotprod == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_BAD_NVECTOR); - return(CVSPGMR_ILL_INPUT); - } - - if (lfree != NULL) lfree(cv_mem); - - /* Set four main function fields in cv_mem */ - linit = CVSpgmrInit; - lsetup = CVSpgmrSetup; - lsolve = CVSpgmrSolve; - lfree = CVSpgmrFree; - - /* Get memory for CVSpgmrMemRec */ - cvspgmr_mem = (CVSpgmrMem) malloc(sizeof(CVSpgmrMemRec)); - if (cvspgmr_mem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_MEM_FAIL); - return(CVSPGMR_MEM_FAIL); - } - - /* Set Spgmr parameters that have been passed in call sequence */ - cvspgmr_mem->g_pretype = pretype; - mxl = cvspgmr_mem->g_maxl = (maxl <= 0) ? CVSPGMR_MAXL : maxl; - - /* Set default values for the rest of the Spgmr parameters */ - cvspgmr_mem->g_gstype = MODIFIED_GS; - cvspgmr_mem->g_delt = CVSPGMR_DELT; - cvspgmr_mem->g_P_data = NULL; - cvspgmr_mem->g_pset = NULL; - cvspgmr_mem->g_psolve = NULL; - cvspgmr_mem->g_jtimes = CVSpgmrDQJtimes; - cvspgmr_mem->g_j_data = cvode_mem; - cvspgmr_mem->g_last_flag = CVSPGMR_SUCCESS; - - - setupNonNull = FALSE; - - /* Check for legal pretype */ - if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && - (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { - if(errfp!=NULL) - fprintf(errfp, MSGS_BAD_PRETYPE); - return(CVSPGMR_ILL_INPUT); - } - - /* Allocate memory for ytemp and x */ - ytemp = N_VClone(vec_tmpl); - if (ytemp == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_MEM_FAIL); - return(CVSPGMR_MEM_FAIL); - } - x = N_VClone(vec_tmpl); - if (x == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_MEM_FAIL); - N_VDestroy(ytemp); - return(CVSPGMR_MEM_FAIL); - } - - /* Compute sqrtN from a dot product */ - N_VConst(ONE, ytemp); - sqrtN = RSqrt( N_VDotProd(ytemp, ytemp) ); - - /* Call SpgmrMalloc to allocate workspace for Spgmr */ - spgmr_mem = SpgmrMalloc(mxl, vec_tmpl); - if (spgmr_mem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_MEM_FAIL); - N_VDestroy(ytemp); - N_VDestroy(x); - return(CVSPGMR_MEM_FAIL); - } - - /* Attach linear solver memory to integrator memory */ - lmem = cvspgmr_mem; - - return(CVSPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrSetPrecType - * ----------------------------------------------------------------- - */ - -int CVSpgmrSetPrecType(void *cvode_mem, int pretype) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_SETGET_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(CVSPGMR_LMEM_NULL); - } - cvspgmr_mem = (CVSpgmrMem) lmem; - - /* Check for legal pretype */ - if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && - (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { - if(errfp!=NULL) - fprintf(errfp, MSGS_SET_BAD_PRETYPE); - return(CVSPGMR_ILL_INPUT); - } - - cvspgmr_mem->g_pretype = pretype; - - return(CVSPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrSetGSType - * ----------------------------------------------------------------- - */ - -int CVSpgmrSetGSType(void *cvode_mem, int gstype) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_SETGET_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(CVSPGMR_LMEM_NULL); - } - cvspgmr_mem = (CVSpgmrMem) lmem; - - /* Check for legal gstype */ - if ((gstype != MODIFIED_GS) && (gstype != CLASSICAL_GS)) { - if(errfp!=NULL) - fprintf(errfp, MSGS_SET_BAD_GSTYPE); - return(CVSPGMR_ILL_INPUT); - } - - cvspgmr_mem->g_gstype = gstype; - - return(CVSPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrSetDelt - * ----------------------------------------------------------------- - */ - -int CVSpgmrSetDelt(void *cvode_mem, realtype delt) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_SETGET_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(CVSPGMR_LMEM_NULL); - } - cvspgmr_mem = (CVSpgmrMem) lmem; - - /* Check for legal delt */ - if(delt < ZERO) { - if(errfp!=NULL) fprintf(errfp, MSGS_SET_BAD_DELT); - return(CVSPGMR_ILL_INPUT); - } - - cvspgmr_mem->g_delt = (delt == ZERO) ? CVSPGMR_DELT : delt; - - return(CVSPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrSetPrecSetupFn - * ----------------------------------------------------------------- - */ - -int CVSpgmrSetPrecSetupFn(void *cvode_mem, CVSpgmrPrecSetupFn pset) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_SETGET_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(CVSPGMR_LMEM_NULL); - } - cvspgmr_mem = (CVSpgmrMem) lmem; - - cvspgmr_mem->g_pset = pset; - - return(CVSPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrSetPrecSolveFn - * ----------------------------------------------------------------- - */ - -int CVSpgmrSetPrecSolveFn(void *cvode_mem, CVSpgmrPrecSolveFn psolve) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_SETGET_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(CVSPGMR_LMEM_NULL); - } - cvspgmr_mem = (CVSpgmrMem) lmem; - - cvspgmr_mem->g_psolve = psolve; - - return(CVSPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrSetPrecData - * ----------------------------------------------------------------- - */ - -int CVSpgmrSetPrecData(void *cvode_mem, void *P_data) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_SETGET_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(CVSPGMR_LMEM_NULL); - } - cvspgmr_mem = (CVSpgmrMem) lmem; - - cvspgmr_mem->g_P_data = P_data; - - return(CVSPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrSetJacTimesVecFn - * ----------------------------------------------------------------- - */ - -int CVSpgmrSetJacTimesVecFn(void *cvode_mem, CVSpgmrJacTimesVecFn jtimes) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_SETGET_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(CVSPGMR_LMEM_NULL); - } - cvspgmr_mem = (CVSpgmrMem) lmem; - - cvspgmr_mem->g_jtimes = jtimes; - - return(CVSPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrSetJacData - * ----------------------------------------------------------------- - */ - -int CVSpgmrSetJacData(void *cvode_mem, void *jac_data) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_SETGET_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(CVSPGMR_LMEM_NULL); - } - cvspgmr_mem = (CVSpgmrMem) lmem; - - cvspgmr_mem->g_j_data = jac_data; - - return(CVSPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrGetWorkSpace - * ----------------------------------------------------------------- - */ - -int CVSpgmrGetWorkSpace(void *cvode_mem, long int *lenrwSG, long int *leniwSG) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - int maxl; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_SETGET_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(CVSPGMR_LMEM_NULL); - } - cvspgmr_mem = (CVSpgmrMem) lmem; - - maxl = cvspgmr_mem->g_maxl; - *lenrwSG = lrw1*(maxl + 5) + maxl*(maxl + 4) + 1; - *leniwSG = liw1*(maxl + 5); - - return(CVSPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrGetNumPrecEvals - * ----------------------------------------------------------------- - */ - -int CVSpgmrGetNumPrecEvals(void *cvode_mem, long int *npevals) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_SETGET_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(CVSPGMR_LMEM_NULL); - } - cvspgmr_mem = (CVSpgmrMem) lmem; - - *npevals = npe; - - return(CVSPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrGetNumPrecSolves - * ----------------------------------------------------------------- - */ - -int CVSpgmrGetNumPrecSolves(void *cvode_mem, long int *npsolves) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_SETGET_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(CVSPGMR_LMEM_NULL); - } - cvspgmr_mem = (CVSpgmrMem) lmem; - - *npsolves = nps; - - return(CVSPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrGetNumLinIters - * ----------------------------------------------------------------- - */ - -int CVSpgmrGetNumLinIters(void *cvode_mem, long int *nliters) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_SETGET_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(CVSPGMR_LMEM_NULL); - } - cvspgmr_mem = (CVSpgmrMem) lmem; - - *nliters = nli; - - return(CVSPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrGetNumConvFails - * ----------------------------------------------------------------- - */ - -int CVSpgmrGetNumConvFails(void *cvode_mem, long int *nlcfails) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_SETGET_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(CVSPGMR_LMEM_NULL); - } - cvspgmr_mem = (CVSpgmrMem) lmem; - - *nlcfails = ncfl; - - return(CVSPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrGetNumJtimesEvals - * ----------------------------------------------------------------- - */ - -int CVSpgmrGetNumJtimesEvals(void *cvode_mem, long int *njvevals) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_SETGET_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(CVSPGMR_LMEM_NULL); - } - cvspgmr_mem = (CVSpgmrMem) lmem; - - *njvevals = njtimes; - - return(CVSPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrGetNumRhsEvals - * ----------------------------------------------------------------- - */ - -int CVSpgmrGetNumRhsEvals(void *cvode_mem, long int *nfevalsSG) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_SETGET_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(CVSPGMR_LMEM_NULL); - } - cvspgmr_mem = (CVSpgmrMem) lmem; - - *nfevalsSG = nfeSG; - - return(CVSPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrGetLastFlag - * ----------------------------------------------------------------- - */ - -int CVSpgmrGetLastFlag(void *cvode_mem, int *flag) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - - /* Return immediately if cvode_mem is NULL */ - if (cvode_mem == NULL) { - fprintf(stderr, MSGS_SETGET_CVMEM_NULL); - return(CVSPGMR_MEM_NULL); - } - cv_mem = (CVodeMem) cvode_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(CVSPGMR_LMEM_NULL); - } - cvspgmr_mem = (CVSpgmrMem) lmem; - - *flag = last_flag; - - return(CVSPGMR_SUCCESS); -} - - -/* Additional readability Replacements */ - -#define pretype (cvspgmr_mem->g_pretype) -#define gstype (cvspgmr_mem->g_gstype) -#define delt (cvspgmr_mem->g_delt) -#define maxl (cvspgmr_mem->g_maxl) -#define psolve (cvspgmr_mem->g_psolve) -#define pset (cvspgmr_mem->g_pset) -#define P_data (cvspgmr_mem->g_P_data) -#define jtimes (cvspgmr_mem->g_jtimes) -#define j_data (cvspgmr_mem->g_j_data) - -/* - * ----------------------------------------------------------------- - * CVSpgmrInit - * ----------------------------------------------------------------- - * This routine does remaining initializations specific to the Spgmr - * linear solver. - * ----------------------------------------------------------------- - */ - -static int CVSpgmrInit(CVodeMem cv_mem) -{ - CVSpgmrMem cvspgmr_mem; - cvspgmr_mem = (CVSpgmrMem) lmem; - - /* Initialize counters */ - npe = nli = nps = ncfl = nstlpre = 0; - njtimes = nfeSG = 0; - - /* Check for legal combination pretype - psolve */ - if ((pretype != PREC_NONE) && (psolve == NULL)) { - if(errfp!=NULL) fprintf(errfp, MSGS_PSOLVE_REQ); - last_flag = -1; - return(-1); - } - - /* Set setupNonNull = TRUE iff there is preconditioning (pretype != PREC_NONE) - and there is a preconditioning setup phase (pset != NULL) */ - setupNonNull = (pretype != PREC_NONE) && (pset != NULL); - - /* If jtimes is NULL at this time, set it to DQ */ - if (jtimes == NULL) { - jtimes = CVSpgmrDQJtimes; - j_data = cv_mem; - } - - last_flag = CVSPGMR_SUCCESS; - return(0); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrSetup - * ----------------------------------------------------------------- - * This routine does the setup operations for the Spgmr linear solver. - * It makes a decision as to whether or not to signal for re-evaluation - * of Jacobian data in the pset routine, based on various state - * variables, then it calls pset. If we signal for re-evaluation, - * then we reset jcur = *jcurPtr to TRUE, regardless of the pset output. - * In any case, if jcur == TRUE, we increment npe and save nst in nstlpre. - * ----------------------------------------------------------------- - */ - -static int CVSpgmrSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, - N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, - N_Vector vtemp2, N_Vector vtemp3) -{ - booleantype jbad, jok; - realtype dgamma; - int ier; - CVSpgmrMem cvspgmr_mem; - - cvspgmr_mem = (CVSpgmrMem) lmem; - - /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ - dgamma = ABS((gamma/gammap) - ONE); - jbad = (nst == 0) || (nst > nstlpre + CVSPGMR_MSBPRE) || - ((convfail == CV_FAIL_BAD_J) && (dgamma < CVSPGMR_DGMAX)) || - (convfail == CV_FAIL_OTHER); - *jcurPtr = jbad; - jok = !jbad; - - /* Call pset routine and possibly reset jcur */ - ier = pset(tn, ypred, fpred, jok, jcurPtr, gamma, P_data, - vtemp1, vtemp2, vtemp3); - if (jbad) *jcurPtr = TRUE; - - /* If jcur = TRUE, increment npe and save nst value */ - if (*jcurPtr) { - npe++; - nstlpre = nst; - } - - /* Return the same value ier that pset returned */ - last_flag = ier; - return(ier); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrSolve - * ----------------------------------------------------------------- - * This routine handles the call to the generic solver SpgmrSolve - * for the solution of the linear system Ax = b with the SPGMR method, - * without restarts. The solution x is returned in the vector b. - * - * If the WRMS norm of b is small, we return x = b (if this is the first - * Newton iteration) or x = 0 (if a later Newton iteration). - * - * Otherwise, we set the tolerance parameter and initial guess (x = 0), - * call SpgmrSolve, and copy the solution x into b. The x-scaling and - * b-scaling arrays are both equal to weight, and no restarts are allowed. - * - * The counters nli, nps, and ncfl are incremented, and the return value - * is set according to the success of SpgmrSolve. The success flag is - * returned if SpgmrSolve converged, or if this is the first Newton - * iteration and the residual norm was reduced below its initial value. - * ----------------------------------------------------------------- - */ - -static int CVSpgmrSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, - N_Vector ynow, N_Vector fnow) -{ - realtype bnorm, res_norm; - CVSpgmrMem cvspgmr_mem; - int nli_inc, nps_inc, ier; - - cvspgmr_mem = (CVSpgmrMem) lmem; - - /* Test norm(b); if small, return x = 0 or x = b */ - deltar = delt*tq[4]; - - bnorm = N_VWrmsNorm(b, weight); - if (bnorm <= deltar) { - if (mnewt > 0) N_VConst(ZERO, b); - return(0); - } - - /* Set vectors ycur and fcur for use by the Atimes and Psolve routines */ - ycur = ynow; - fcur = fnow; - - /* Set inputs delta and initial guess x = 0 to SpgmrSolve */ - delta = deltar * sqrtN; - N_VConst(ZERO, x); - - /* Call SpgmrSolve and copy x to b */ - ier = SpgmrSolve(spgmr_mem, cv_mem, x, b, pretype, gstype, delta, 0, - cv_mem, weight, weight, CVSpgmrAtimes, CVSpgmrPSolve, - &res_norm, &nli_inc, &nps_inc); - - N_VScale(ONE, x, b); - - /* Increment counters nli, nps, and ncfl */ - nli += nli_inc; - nps += nps_inc; - if (ier != 0) ncfl++; - - /* Set return value to -1, 0, or 1 */ - last_flag = ier; - - if (ier < 0) return(-1); - - if ((ier == SPGMR_SUCCESS) || - ((ier == SPGMR_RES_REDUCED) && (mnewt == 0))) - return(0); - - return(1); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrFree - * ----------------------------------------------------------------- - * This routine frees memory specific to the Spgmr linear solver. - * ----------------------------------------------------------------- - */ - -static void CVSpgmrFree(CVodeMem cv_mem) -{ - CVSpgmrMem cvspgmr_mem; - - cvspgmr_mem = (CVSpgmrMem) lmem; - - N_VDestroy(ytemp); - N_VDestroy(x); - SpgmrFree(spgmr_mem); - free(cvspgmr_mem); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrAtimes - * ----------------------------------------------------------------- - * This routine generates the matrix-vector product z = Mv, where - * M = I - gamma*J. The product J*v is obtained by calling the jtimes - * routine. It is then scaled by -gamma and added to v to obtain M*v. - * The return value is the same as the value returned by jtimes -- - * 0 if successful, nonzero otherwise. - * ----------------------------------------------------------------- - */ - -static int CVSpgmrAtimes(void *cvode_mem, N_Vector v, N_Vector z) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - int jtflag; - - cv_mem = (CVodeMem) cvode_mem; - cvspgmr_mem = (CVSpgmrMem) lmem; - - jtflag = jtimes(v, z, tn, ycur, fcur, j_data, ytemp); - njtimes++; - if (jtflag != 0) return(jtflag); - - N_VLinearSum(ONE, v, -gamma, z, z); - - return(0); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrPSolve - * ----------------------------------------------------------------- - * This routine interfaces between the generic SpgmrSolve routine and - * the user's psolve routine. It passes to psolve all required state - * information from cvode_mem. Its return value is the same as that - * returned by psolve. Note that the generic SPGMR solver guarantees - * that CVSpgmrPSolve will not be called in the case in which - * preconditioning is not done. This is the only case in which the - * user's psolve routine is allowed to be NULL. - * ----------------------------------------------------------------- - */ - -static int CVSpgmrPSolve(void *cvode_mem, N_Vector r, N_Vector z, int lr) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - int ier; - - cv_mem = (CVodeMem) cvode_mem; - cvspgmr_mem = (CVSpgmrMem)lmem; - - ier = psolve(tn, ycur, fcur, r, z, gamma, delta, lr, P_data, ytemp); - /* This call is counted in nps within the CVSpgmrSolve routine */ - - return(ier); -} - -/* - * ----------------------------------------------------------------- - * CVSpgmrDQJtimes - * ----------------------------------------------------------------- - * This routine generates a difference quotient approximation to - * the Jacobian times vector f_y(t,y) * v. The approximation is - * Jv = vnrm[f(y + v/vnrm) - f(y)], where vnrm = (WRMS norm of v) is - * input, i.e. the WRMS norm of v/vnrm is 1. - * ----------------------------------------------------------------- - */ - -static int CVSpgmrDQJtimes(N_Vector v, N_Vector Jv, realtype t, - N_Vector y, N_Vector fy, - void *jac_data, N_Vector work) -{ - CVodeMem cv_mem; - CVSpgmrMem cvspgmr_mem; - realtype vnrm; - - /* jac_data is cvode_mem */ - cv_mem = (CVodeMem) jac_data; - cvspgmr_mem = (CVSpgmrMem) lmem; - - /* Evaluate norm of v */ - vnrm = N_VWrmsNorm(v, ewt); - - /* Set work = y + (1/vnrm) v */ - N_VLinearSum(ONE/vnrm, v, ONE, y, work); - - /* Set Jv = f(tn, work) */ - f(t, work, Jv, f_data); - nfeSG++; - - /* Replace Jv by vnrm*(Jv - fy) */ - N_VLinearSum(ONE, Jv, -ONE, fy, Jv); - N_VScale(vnrm, Jv, Jv); - - return(0); -} diff --git a/src/sundials/cvodes/cvspgmr.h b/src/sundials/cvodes/cvspgmr.h deleted file mode 100755 index 087fda8e8d..0000000000 --- a/src/sundials/cvodes/cvspgmr.h +++ /dev/null @@ -1,382 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * This is the header file for the CVODE/CVODES scaled, - * preconditioned GMRES linear solver, CVSPGMR. - * ----------------------------------------------------------------- - */ - -#ifndef _CVSPGMR_H -#define _CVSPGMR_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include "spgmr.h" -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * CVSPGMR solver constants - * ----------------------------------------------------------------- - * CVSPGMR_MAXL : default value for the maximum Krylov - * dimension - * - * CVSPGMR_MSBPRE : maximum number of steps between - * preconditioner evaluations - * - * CVSPGMR_DGMAX : maximum change in gamma between - * preconditioner evaluations - * - * CVSPGMR_DELT : default value for factor by which the - * tolerance on the nonlinear iteration is - * multiplied to get a tolerance on the linear - * iteration - * ----------------------------------------------------------------- - */ - -#define CVSPGMR_MAXL 5 -#define CVSPGMR_MSBPRE 50 -#define CVSPGMR_DGMAX RCONST(0.2) -#define CVSPGMR_DELT RCONST(0.05) - -/* - * ----------------------------------------------------------------- - * Type : CVSpgmrPrecSetupFn - * ----------------------------------------------------------------- - * The user-supplied preconditioner setup function PrecSetup and - * the user-supplied preconditioner solve function PrecSolve - * together must define left and right preconditoner matrices - * P1 and P2 (either of which may be trivial), such that the - * product P1*P2 is an approximation to the Newton matrix - * M = I - gamma*J. Here J is the system Jacobian J = df/dy, - * and gamma is a scalar proportional to the integration step - * size h. The solution of systems P z = r, with P = P1 or P2, - * is to be carried out by the PrecSolve function, and PrecSetup - * is to do any necessary setup operations. - * - * The user-supplied preconditioner setup function PrecSetup - * is to evaluate and preprocess any Jacobian-related data - * needed by the preconditioner solve function PrecSolve. - * This might include forming a crude approximate Jacobian, - * and performing an LU factorization on the resulting - * approximation to M. This function will not be called in - * advance of every call to PrecSolve, but instead will be called - * only as often as necessary to achieve convergence within the - * Newton iteration. If the PrecSolve function needs no - * preparation, the PrecSetup function can be NULL. - * - * For greater efficiency, the PrecSetup function may save - * Jacobian-related data and reuse it, rather than generating it - * from scratch. In this case, it should use the input flag jok - * to decide whether to recompute the data, and set the output - * flag *jcurPtr accordingly. - * - * Each call to the PrecSetup function is preceded by a call to - * the RhsFn f with the same (t,y) arguments. Thus the PrecSetup - * function can use any auxiliary data that is computed and - * saved by the f function and made accessible to PrecSetup. - * - * A function PrecSetup must have the prototype given below. - * Its parameters are as follows: - * - * t is the current value of the independent variable. - * - * y is the current value of the dependent variable vector, - * namely the predicted value of y(t). - * - * fy is the vector f(t,y). - * - * jok is an input flag indicating whether Jacobian-related - * data needs to be recomputed, as follows: - * jok == FALSE means recompute Jacobian-related data - * from scratch. - * jok == TRUE means that Jacobian data, if saved from - * the previous PrecSetup call, can be reused - * (with the current value of gamma). - * A Precset call with jok == TRUE can only occur after - * a call with jok == FALSE. - * - * jcurPtr is a pointer to an output integer flag which is - * to be set by PrecSetup as follows: - * Set *jcurPtr = TRUE if Jacobian data was recomputed. - * Set *jcurPtr = FALSE if Jacobian data was not recomputed, - * but saved data was reused. - * - * gamma is the scalar appearing in the Newton matrix. - * - * P_data is a pointer to user data - the same as the P_data - * parameter passed to CVSpgmr. - * - * tmp1, tmp2, and tmp3 are pointers to memory allocated - * for N_Vectors which can be used by - * CVSpgmrPrecSetupFn as temporary storage or - * work space. - * - * NOTE: If the user's preconditioner needs other quantities, - * they are accessible as follows: hcur (the current stepsize) - * and ewt (the error weight vector) are accessible through - * CVodeGetCurrentStep and CVodeGetErrWeights, respectively). - * The unit roundoff is available as UNIT_ROUNDOFF defined in - * sundialstypes.h. - * - * Returned value: - * The value to be returned by the PrecSetup function is a flag - * indicating whether it was successful. This value should be - * 0 if successful, - * > 0 for a recoverable error (step will be retried), - * < 0 for an unrecoverable error (integration is halted). - * ----------------------------------------------------------------- - */ - -typedef int (*CVSpgmrPrecSetupFn)(realtype t, N_Vector y, N_Vector fy, - booleantype jok, booleantype *jcurPtr, - realtype gamma, void *P_data, - N_Vector tmp1, N_Vector tmp2, - N_Vector tmp3); - -/* - * ----------------------------------------------------------------- - * Type : CVSpgmrPrecSolveFn - * ----------------------------------------------------------------- - * The user-supplied preconditioner solve function PrecSolve - * is to solve a linear system P z = r in which the matrix P is - * one of the preconditioner matrices P1 or P2, depending on the - * type of preconditioning chosen. - * - * A function PrecSolve must have the prototype given below. - * Its parameters are as follows: - * - * t is the current value of the independent variable. - * - * y is the current value of the dependent variable vector. - * - * fy is the vector f(t,y). - * - * r is the right-hand side vector of the linear system. - * - * z is the output vector computed by PrecSolve. - * - * gamma is the scalar appearing in the Newton matrix. - * - * delta is an input tolerance for use by PSolve if it uses - * an iterative method in its solution. In that case, - * the residual vector Res = r - P z of the system - * should be made less than delta in weighted L2 norm, - * i.e., sqrt [ Sum (Res[i]*ewt[i])^2 ] < delta. - * Note: the error weight vector ewt can be obtained - * through a call to the routine CVodeGetErrWeights. - * - * lr is an input flag indicating whether PrecSolve is to use - * the left preconditioner P1 or right preconditioner - * P2: lr = 1 means use P1, and lr = 2 means use P2. - * - * P_data is a pointer to user data - the same as the P_data - * parameter passed to CVSpgmr. - * - * tmp is a pointer to memory allocated for an N_Vector - * which can be used by PSolve for work space. - * - * Returned value: - * The value to be returned by the PrecSolve function is a flag - * indicating whether it was successful. This value should be - * 0 if successful, - * positive for a recoverable error (step will be retried), - * negative for an unrecoverable error (integration is halted). - * ----------------------------------------------------------------- - */ - -typedef int (*CVSpgmrPrecSolveFn)(realtype t, N_Vector y, N_Vector fy, - N_Vector r, N_Vector z, - realtype gamma, realtype delta, - int lr, void *P_data, N_Vector tmp); - -/* - * ----------------------------------------------------------------- - * Type : CVSpgmrJacTimesVecFn - * ----------------------------------------------------------------- - * The user-supplied function jtimes is to generate the product - * J*v for given v, where J is the Jacobian df/dy, or an - * approximation to it, and v is a given vector. It should return - * 0 if successful and a nonzero int otherwise. - * - * A function jtimes must have the prototype given below. Its - * parameters are as follows: - * - * v is the N_Vector to be multiplied by J. - * - * Jv is the output N_Vector containing J*v. - * - * t is the current value of the independent variable. - * - * y is the current value of the dependent variable - * vector. - * - * fy is the vector f(t,y). - * - * jac_data is a pointer to user Jacobian data, the same as the - * pointer passed to CVSpgmr. - * - * tmp is a pointer to memory allocated for an N_Vector - * which can be used by Jtimes for work space. - * ----------------------------------------------------------------- - */ - -typedef int (*CVSpgmrJacTimesVecFn)(N_Vector v, N_Vector Jv, realtype t, - N_Vector y, N_Vector fy, - void *jac_data, N_Vector tmp); - -/* - * ----------------------------------------------------------------- - * Function : CVSpgmr - * ----------------------------------------------------------------- - * A call to the CVSpgmr function links the main CVODE integrator - * with the CVSPGMR linear solver. - * - * cvode_mem is the pointer to the integrator memory returned by - * CVodeCreate. - * - * pretype is the type of user preconditioning to be done. - * This must be one of the four enumeration constants - * NONE, LEFT, RIGHT, or BOTH defined in iterative.h. - * These correspond to no preconditioning, - * left preconditioning only, right preconditioning - * only, and both left and right preconditioning, - * respectively. - * - * maxl is the maximum Krylov dimension. This is an - * optional input to the CVSPGMR solver. Pass 0 to - * use the default value CVSPGMR_MAXL=5. - * - * The return value of CVSpgmr is one of: - * CVSPGMR_SUCCESS if successful - * CVSPGMR_MEM_NULL if the cvode memory was NULL - * CVSPGMR_MEM_FAIL if there was a memory allocation failure - * CVSPGMR_ILL_INPUT if a required vector operation is missing - * ----------------------------------------------------------------- - */ - -int CVSpgmr(void *cvode_mem, int pretype, int maxl); - -/* - * ----------------------------------------------------------------- - * Function: CVSpgmrSetPrecType - * ----------------------------------------------------------------- - * CVSpgmrSetPrecType resets the type of preconditioner, pretype, - * from the value set in a prior call to CVSpgmr. - * This must be one of NONE, LEFT, RIGHT, or BOTH. - * ----------------------------------------------------------------- - */ - -int CVSpgmrSetPrecType(void *cvode_mem, int pretype); - -/* - * ----------------------------------------------------------------- - * Optional inputs to the CVSPGMR linear solver - * ----------------------------------------------------------------- - * CVSpgmrSetGSType specifies the type of Gram-Schmidt - * orthogonalization to be used. This must be one of - * the two enumeration constants MODIFIED_GS or - * CLASSICAL_GS defined in iterative.h. These correspond - * to using modified Gram-Schmidt and classical - * Gram-Schmidt, respectively. - * Default value is MODIFIED_GS. - * CVSpgmrSetDelt specifies the factor by which the tolerance on - * the nonlinear iteration is multiplied to get a - * tolerance on the linear iteration. This is an - * optional input to the CVSPGMR solver. - * Default value is 0.05. - * CVSpgmrSetPrecSetupFn specifies the PrecSetup function. - * Default is NULL. - * CVSpgmrSetPrecSolveFn specifies the PrecSolve function. - * Default is NULL. - * CVSpgmrSetPrecData specifies a pointer to user preconditioner - * data. This pointer is passed to PrecSetup and - * PrecSolve every time these routines are called. - * Default is NULL. - * CVSpgmrSetJacTimesVecFn specifies the jtimes function. - * Default is to use an internal finite - * difference approximation routine. - * CVSpgmrSetJacData specifies a pointer to user Jacobian data. - * This pointer is passed to jtimes every time this - * routine is called. - * Default is NULL. - * - * The return value of CVSpgmrSet* is one of: - * CVSPGMR_SUCCESS if successful - * CVSPGMR_MEM_NULL if the cvode memory was NULL - * CVSPGMR_LMEM_NULL if the cvspgmr memory was NULL - * CVSPGMR_ILL_INPUT if an input has an illegal value - * ----------------------------------------------------------------- - */ - -int CVSpgmrSetGSType(void *cvode_mem, int gstype); -int CVSpgmrSetDelt(void *cvode_mem, realtype delt); -int CVSpgmrSetPrecSetupFn(void *cvode_mem, CVSpgmrPrecSetupFn pset); -int CVSpgmrSetPrecSolveFn(void *cvode_mem, CVSpgmrPrecSolveFn psolve); -int CVSpgmrSetPrecData(void *cvode_mem, void *P_data); -int CVSpgmrSetJacTimesVecFn(void *cvode_mem, CVSpgmrJacTimesVecFn jtimes); -int CVSpgmrSetJacData(void *cvode_mem, void *jac_data); - -/* - * ----------------------------------------------------------------- - * Optional outputs from the CVSPGMR linear solver - * ----------------------------------------------------------------- - * CVSpgmrGetWorkSpace returns the real and integer workspace used - * by CVSPGMR. - * CVSpgmrGetNumPrecEvals returns the number of preconditioner - * evaluations, i.e. the number of calls made - * to PrecSetup with jok==FALSE. - * CVSpgmrGetNumPrecSolves returns the number of calls made to - * PrecSolve. - * CVSpgmrGetNumLinIters returns the number of linear iterations. - * CVSpgmrGetNumConvFails returns the number of linear - * convergence failures. - * CVSpgmrGetNumJtimesEvals returns the number of calls to jtimes. - * CVSpgmrGetNumRhsEvals returns the number of calls to the user - * f routine due to finite difference Jacobian - * times vector evaluation. - * CVSpgmrGetLastFlag returns the last error flag set by any of - * the CVSPGMR interface functions. - * - * The return value of CVSpgmrGet* is one of: - * CVSPGMR_SUCCESS if successful - * CVSPGMR_MEM_NULL if the cvode memory was NULL - * CVSPGMR_LMEM_NULL if the cvspgmr memory was NULL - * ----------------------------------------------------------------- - */ - -int CVSpgmrGetWorkSpace(void *cvode_mem, long int *lenrwSG, long int *leniwSG); -int CVSpgmrGetNumPrecEvals(void *cvode_mem, long int *npevals); -int CVSpgmrGetNumPrecSolves(void *cvode_mem, long int *npsolves); -int CVSpgmrGetNumLinIters(void *cvode_mem, long int *nliters); -int CVSpgmrGetNumConvFails(void *cvode_mem, long int *nlcfails); -int CVSpgmrGetNumJtimesEvals(void *cvode_mem, long int *njvevals); -int CVSpgmrGetNumRhsEvals(void *cvode_mem, long int *nfevalsSG); -int CVSpgmrGetLastFlag(void *cvode_mem, int *flag); - -/* CVSPGMR return values */ - -#define CVSPGMR_SUCCESS 0 -#define CVSPGMR_MEM_NULL -1 -#define CVSPGMR_LMEM_NULL -2 -#define CVSPGMR_ILL_INPUT -3 -#define CVSPGMR_MEM_FAIL -4 - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/cvodes/cvspgmr_impl.h b/src/sundials/cvodes/cvspgmr_impl.h deleted file mode 100755 index 97a686e753..0000000000 --- a/src/sundials/cvodes/cvspgmr_impl.h +++ /dev/null @@ -1,120 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/cvodes/LICENSE. - * ----------------------------------------------------------------- - * Implementation header file for the scaled, preconditioned GMRES - * linear solver, CVSPGMR. - * ----------------------------------------------------------------- - */ - -#ifndef _CVSPGMR_IMPL_H -#define _CVSPGMR_IMPL_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include - -#include "cvspgmr.h" - -#include "spgmr.h" -#include "iterative.h" -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Types : CVSpgmrMemRec, CVSpgmrMem - * ----------------------------------------------------------------- - * The type CVSpgmrMem is pointer to a CVSpgmrMemRec. - * This structure contains CVSpgmr solver-specific data. - * ----------------------------------------------------------------- - */ - -typedef struct { - - int g_pretype; /* type of preconditioning */ - int g_gstype; /* type of Gram-Schmidt orthogonalization */ - realtype g_sqrtN; /* sqrt(N) */ - realtype g_delt; /* delt = user specified or DELT_DEFAULT */ - realtype g_deltar; /* deltar = delt * tq4 */ - realtype g_delta; /* delta = deltar * sqrtN */ - int g_maxl; /* maxl = maximum dimension of the Krylov space */ - - long int g_nstlpre; /* value of nst at the last pset call */ - long int g_npe; /* npe = total number of pset calls */ - long int g_nli; /* nli = total number of linear iterations */ - long int g_nps; /* nps = total number of psolve calls */ - long int g_ncfl; /* ncfl = total number of convergence failures */ - long int g_njtimes; /* njtimes = total number of calls to jtimes */ - long int g_nfeSG; /* nfeSG = total number of calls to f for - difference quotient Jacobian-vector products */ - - N_Vector g_ytemp; /* temp vector passed to jtimes and psolve */ - N_Vector g_x; /* temp vector used by CVSpgmrSolve */ - N_Vector g_ycur; /* CVODE current y vector in Newton Iteration */ - N_Vector g_fcur; /* fcur = f(tn, ycur) */ - - CVSpgmrPrecSetupFn g_pset; - /* pset = user-supplied routine to compute */ - /* a preconditioner */ - - CVSpgmrPrecSolveFn g_psolve; - /* psolve = user-supplied routine to solve */ - /* preconditioner linear system */ - - void *g_P_data; /* P_data passed to psolve and pset */ - SpgmrMem g_spgmr_mem; /* spgmr_mem is memory used by the */ - /* generic Spgmr solver */ - - CVSpgmrJacTimesVecFn g_jtimes; - /* jtimes = Jacobian * vector routine */ - void *g_j_data; /* j_data is passed to jtimes */ - - int g_last_flag; /* last error flag returned by any function */ - -} CVSpgmrMemRec, *CVSpgmrMem; - -/* Error Messages */ - -#define _CVSPGMR_ "CVSpgmr-- " -#define MSGS_CVMEM_NULL _CVSPGMR_ "Integrator memory is NULL.\n\n" -#define MSGS_MEM_FAIL _CVSPGMR_ "A memory request failed.\n\n" -#define MSGS_BAD_PRETYPE1 _CVSPGMR_ "Illegal value for pretype.\n" -#define MSGS_BAD_PRETYPE2 "The legal values are PREC_NONE, PREC_LEFT, " -#define MSGS_BAD_PRETYPE3 "PREC_RIGHT, and PREC_BOTH.\n\n" -#define MSGS_BAD_PRETYPE MSGS_BAD_PRETYPE1 MSGS_BAD_PRETYPE2 MSGS_BAD_PRETYPE3 -#define MSGS_PSOLVE_REQ _CVSPGMR_ "pretype != PREC_NONE, but PSOLVE = NULL is illegal.\n\n" -#define MSGS_BAD_NVECTOR _CVSPGMR_ "A required vector operation is not implemented.\n\n" - -#define MSGS_SETGET_CVMEM_NULL "CVSpgmrSet*/CVSpgmrGet*-- Integrator memory is NULL.\n\n" - -#define MSGS_SETGET_LMEM_NULL "CVSpgmrSet*/CVSpgmrGet*-- cvspgmr memory is NULL.\n\n" - -#define MSGS_SET_BAD_PRETYPE1 "CVSpgmrSetPrecType-- Illegal value for pretype.\n" -#define MSGS_SET_BAD_PRETYPE2 "The legal values are PREC_NONE, PREC_LEFT, " -#define MSGS_SET_BAD_PRETYPE3 "PREC_RIGHT, and PREC_BOTH.\n\n" -#define MSGS_SET_BAD_PRETYPE MSGS_SET_BAD_PRETYPE1 MSGS_SET_BAD_PRETYPE2 MSGS_SET_BAD_PRETYPE3 - -#define MSGS_SET_BAD_GSTYPE1 "CVSpgmrSetGSType-- Illegal value for gstype.\n" -#define MSGS_SET_BAD_GSTYPE2 "The legal values are MODIFIED_GS and " -#define MSGS_SET_BAD_GSTYPE3 "CLASSICAL_GS.\n\n" -#define MSGS_SET_BAD_GSTYPE MSGS_SET_BAD_GSTYPE1 MSGS_SET_BAD_GSTYPE2 MSGS_SET_BAD_GSTYPE3 - -#define MSGS_SET_BAD_DELT "CVSpgmrSetDelt-- delt < 0 illegal.\n\n" - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/ida/ida.c b/src/sundials/ida/ida.c deleted file mode 100755 index fd69e1ea7c..0000000000 --- a/src/sundials/ida/ida.c +++ /dev/null @@ -1,2159 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/ida/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for the main IDA solver. - * It is independent of the linear solver in use. - * ----------------------------------------------------------------- - */ - -#include -#include - -#include "ida_impl.h" -#include "sundialsmath.h" - -/* - * ----------------------------------------------------------------- - * private constants - * ----------------------------------------------------------------- - */ - -#define ZERO RCONST(0.0) /* real 0.0 */ -#define HALF RCONST(0.5) /* real 0.5 */ -#define QUARTER RCONST(0.25) /* real 0.25 */ -#define TWOTHIRDS RCONST(0.667) /* real 2/3 */ -#define ONE RCONST(1.0) /* real 1.0 */ -#define ONEPT5 RCONST(1.5) /* real 1.5 */ -#define TWO RCONST(2.0) /* real 2.0 */ -#define TWOPT5 RCONST(2.5) /* real 2.5 */ -#define TEN RCONST(10.0) /* real 10.0 */ -#define TWELVE RCONST(12.0) /* real 12.0 */ -#define TWENTY RCONST(20.0) /* real 20.0 */ -#define HUNDRED RCONST(100.0) /* real 100.0 */ -#define PT9 RCONST(0.9) /* real 0.9 */ -#define PT99 RCONST(0.99) /* real 0.99 */ -#define PT1 RCONST(0.1) /* real 0.1 */ -#define PT01 RCONST(0.01) /* real 0.01 */ -#define PT001 RCONST(0.001) /* real 0.001 */ -#define PT0001 RCONST(0.0001) /* real 0.0001 */ - -/* - * ----------------------------------------------------------------- - * default constants - * ----------------------------------------------------------------- - */ - -#define MXSTEP_DEFAULT 500 /* mxstep default value */ -#define MAXORD_DEFAULT 5 /* maxord default value */ -#define MXNCF 10 /* max number of convergence failures allowed */ -#define MXNEF 10 /* max number of error test failures allowed */ -#define MAXNH 5 /* max. number of h tries in IC calc. */ -#define MAXNJ 4 /* max. number of J tries in IC calc. */ -#define MAXNI 10 /* max. Newton iterations in IC calc. */ -#define EPCON RCONST(0.33) /* Newton convergence test constant */ - -/* - * ----------------------------------------------------------------- - * routine-specific constants - * ----------------------------------------------------------------- - */ - -/* IDAStep control constants */ - -#define PREDICT_AGAIN 20 - -/* IDANewtonIter constants */ - -#define MAXIT 4 -#define RATEMAX RCONST(0.9) -#define XRATE RCONST(0.25) - -/* Return values for lower level routines used by IDASolve */ - -#define IDA_RES_RECVR +1 -#define IDA_LSETUP_RECVR +2 -#define IDA_LSOLVE_RECVR +3 - -#define IDA_NCONV_RECVR +4 -#define IDA_CONSTR_RECVR +5 -#define CONTINUE_STEPS +99 - -/* IDACompleteStep constants */ - -#define UNSET -1 -#define LOWER 1 -#define RAISE 2 -#define MAINTAIN 3 - -/* IDATestError constants */ - -#define ERROR_TEST_FAIL +7 - -/* Macro: loop */ - -#define loop for(;;) - -/* - * ----------------------------------------------------------------- - * private helper function prototypes - * ----------------------------------------------------------------- - */ - -static booleantype IDACheckNvector(N_Vector tmpl); - -static booleantype IDAAllocVectors(IDAMem IDA_mem, N_Vector tmpl); -static void IDAFreeVectors(IDAMem IDA_mem); - -realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w, - booleantype mask); -int IDAInitialSetup(IDAMem IDA_mem); -booleantype IDAEwtSet(IDAMem IDA_mem, N_Vector ycur); - -static booleantype IDAEwtSetSS(IDAMem IDA_mem, N_Vector ycur); -static booleantype IDAEwtSetSV(IDAMem IDA_mem, N_Vector ycur); - -static int IDAStopTest1(IDAMem IDA_mem, realtype tout,realtype *tret, - N_Vector yret, N_Vector ypret, int itask); -static int IDAStopTest2(IDAMem IDA_mem, realtype tout, realtype *tret, - N_Vector yret, N_Vector ypret, int itask); -static int IDAHandleFailure(IDAMem IDA_mem, int sflag); - -static int IDAStep(IDAMem IDA_mem); -static void IDASetCoeffs(IDAMem IDA_mem, realtype *ck); -static int IDAnls(IDAMem IDA_mem); -static int IDAPredict(IDAMem IDA_mem); -static int IDANewtonIter(IDAMem IDA_mem); -static int IDATestError(IDAMem IDA_mem, realtype *ck, realtype *est, - realtype *terk, realtype *terkm1, realtype *erkm1); -static int IDAHandleNFlag(IDAMem IDA_mem, int nflag, realtype saved_t, - int *ncfPtr, int *nefPtr, realtype *est); -static int IDACompleteStep(IDAMem IDA_mem, realtype *est, - realtype *terk, realtype *terkm1, realtype *erkm1); - -/* - * ----------------------------------------------------------------- - * user-callable functions - * ----------------------------------------------------------------- - */ - -/* - * ----------------------------------------------------------------- - * IDACreate - * ----------------------------------------------------------------- - * IDACreate creates an internal memory block for a problem to - * be solved by IDA. - * If successful, IDACreate returns a pointer to the problem memory. - * This pointer should be passed to IDAMalloc. - * If an initialization error occurs, IDACreate prints an error - * message to standard err and returns NULL. - * ----------------------------------------------------------------- -*/ - -void *IDACreate(void) -{ - IDAMem IDA_mem; - - IDA_mem = (IDAMem) malloc(sizeof(struct IDAMemRec)); - if (IDA_mem == NULL) { - fprintf(stderr, MSG_MEM_FAIL); - return (NULL); - } - - /* Set unit roundoff in IDA_mem */ - IDA_mem->ida_uround = UNIT_ROUNDOFF; - - /* Set default values for integrator optional inputs */ - IDA_mem->ida_rdata = NULL; - IDA_mem->ida_errfp = stderr; - IDA_mem->ida_maxord = MAXORD_DEFAULT; - IDA_mem->ida_mxstep = MXSTEP_DEFAULT; - IDA_mem->ida_hmax_inv = ZERO; - IDA_mem->ida_hin = ZERO; - IDA_mem->ida_epcon = EPCON; - IDA_mem->ida_maxnef = MXNEF; - IDA_mem->ida_maxncf = MXNCF; - IDA_mem->ida_maxcor = MAXIT; - IDA_mem->ida_suppressalg = FALSE; - IDA_mem->ida_id = NULL; - IDA_mem->ida_constraints = NULL; - IDA_mem->ida_tstopset = FALSE; - - /* Set default values for IC optional inputs */ - IDA_mem->ida_epiccon = PT01 * EPCON; - IDA_mem->ida_maxnh = MAXNH; - IDA_mem->ida_maxnj = MAXNJ; - IDA_mem->ida_maxnit = MAXNI; - IDA_mem->ida_lsoff = FALSE; - IDA_mem->ida_steptol = RPowerR(IDA_mem->ida_uround, TWOTHIRDS); - - /* No mallocs have been done yet */ - IDA_mem->ida_MallocDone = FALSE; - - /* Return pointer to IDA memory block */ - return((void *)IDA_mem); -} - -/*-----------------------------------------------------------------*/ - -#define errfp (IDA_mem->ida_errfp) - -/*-----------------------------------------------------------------*/ - -/* - * ----------------------------------------------------------------- - * IDAMalloc - * ----------------------------------------------------------------- - * IDAMalloc allocates and initializes memory for a problem. All - * problem specification inputs are checked for errors. If any - * error occurs during initialization, it is reported to the file - * whose file pointer is errfp and an error flag is returned. - * ----------------------------------------------------------------- - */ - -int IDAMalloc(void *ida_mem, IDAResFn res, - realtype t0, N_Vector yy0, N_Vector yp0, - int itol, realtype *rtol, void *atol) -{ - IDAMem IDA_mem; - booleantype nvectorOK, allocOK, neg_atol; - long int lrw1, liw1; - - /* Check ida_mem */ - if (ida_mem == NULL) { - fprintf(stderr, MSG_IDAM_NO_MEM); - return(IDA_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - /* Check for legal input parameters */ - - if (yy0 == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_Y0_NULL); - return(IDA_ILL_INPUT); - } - - if (yp0 == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_YP0_NULL); - return(IDA_ILL_INPUT); - } - - if ((itol != IDA_SS) && (itol != IDA_SV)) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_ITOL); - return(IDA_ILL_INPUT); - } - - if (res == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_RES_NULL); - return(IDA_ILL_INPUT); - } - - if (rtol == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_RTOL_NULL); - return(IDA_ILL_INPUT); - } - - if (*rtol < ZERO) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_RTOL); - return(IDA_ILL_INPUT); - } - - if (atol == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_ATOL_NULL); - return(IDA_ILL_INPUT); - } - - /* Test if all required vector operations are implemented */ - nvectorOK = IDACheckNvector(yy0); - if(!nvectorOK) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_NVECTOR); - return(IDA_ILL_INPUT); - } - - /* Test absolute tolerances */ - if (itol == IDA_SS) { - neg_atol = (*((realtype *)atol) < ZERO); - } else { - neg_atol = (N_VMin((N_Vector)atol) < ZERO); - } - if (neg_atol) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_ATOL); - return(IDA_ILL_INPUT); - } - - /* Set space requirements for one N_Vector */ - if (yy0->ops->nvspace != NULL) { - N_VSpace(yy0, &lrw1, &liw1); - } else { - lrw1 = 0; - liw1 = 0; - } - IDA_mem->ida_lrw1 = lrw1; - IDA_mem->ida_liw1 = liw1; - - /* Allocate the vectors (using yy0 as a template) */ - allocOK = IDAAllocVectors(IDA_mem, yy0); - if (!allocOK) { - if(errfp!=NULL) fprintf(errfp, MSG_MEM_FAIL); - return(IDA_MEM_FAIL); - } - - /* All error checking is complete at this point */ - - /* Copy the input parameters into IDA memory block */ - IDA_mem->ida_res = res; - IDA_mem->ida_tn = t0; - IDA_mem->ida_y0 = yy0; - IDA_mem->ida_yp0 = yp0; - IDA_mem->ida_itol = itol; - IDA_mem->ida_rtol = rtol; - IDA_mem->ida_atol = atol; - - /* Set the linear solver addresses to NULL */ - IDA_mem->ida_linit = NULL; - IDA_mem->ida_lsetup = NULL; - IDA_mem->ida_lsolve = NULL; - IDA_mem->ida_lperf = NULL; - IDA_mem->ida_lfree = NULL; - IDA_mem->ida_lmem = NULL; - - /* Initialize the phi array */ - N_VScale(ONE, yy0, IDA_mem->ida_phi[0]); - N_VScale(ONE, yp0, IDA_mem->ida_phi[1]); - - /* Initialize all the counters and other optional output values */ - IDA_mem->ida_nst = 0; - IDA_mem->ida_nre = 0; - IDA_mem->ida_ncfn = 0; - IDA_mem->ida_netf = 0; - IDA_mem->ida_nni = 0; - IDA_mem->ida_nsetups = 0; - - IDA_mem->ida_kused = 0; - IDA_mem->ida_hused = ZERO; - IDA_mem->ida_tolsf = ONE; - - /* Initial setup not done yet */ - IDA_mem->ida_SetupDone = FALSE; - - /* Problem memory has been successfully allocated */ - IDA_mem->ida_MallocDone = TRUE; - return(IDA_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * IDAReInit - * ----------------------------------------------------------------- - * IDAReInit re-initializes IDA's memory for a problem, assuming - * it has already beeen allocated in a prior IDAMalloc call. - * All problem specification inputs are checked for errors. - * The problem size Neq is assumed to be unchaged since the call - * to IDAMalloc, and the maximum order maxord must not be larger. - * If any error occurs during reinitialization, it is reported to - * the file whose file pointer is errfp. - * The return value is IDA_SUCCESS = 0 if no errors occurred, or - * a negative value otherwise. - * ----------------------------------------------------------------- - */ - -int IDAReInit(void *ida_mem, IDAResFn res, - realtype t0, N_Vector yy0, N_Vector yp0, - int itol, realtype *rtol, void *atol) -{ - IDAMem IDA_mem; - booleantype neg_atol; - - /* Check for legal input parameters */ - - if (ida_mem == NULL) { - fprintf(stderr, MSG_IDAM_NO_MEM); - return(IDA_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - /* Check if problem was malloc'ed */ - - if (IDA_mem->ida_MallocDone == FALSE) { - if(errfp!=NULL) fprintf(errfp, MSG_REI_NO_MALLOC); - return(IDA_NO_MALLOC); - } - - /* Check for legal input parameters */ - - if (yy0 == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_Y0_NULL); - return(IDA_ILL_INPUT); - } - - if (yp0 == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_YP0_NULL); - return(IDA_ILL_INPUT); - } - - if ((itol != IDA_SS) && (itol != IDA_SV)) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_ITOL); - return(IDA_ILL_INPUT); - } - - if (res == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_RES_NULL); - return(IDA_ILL_INPUT); - } - - if (rtol == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_RTOL_NULL); - return(IDA_ILL_INPUT); - } - - if (*rtol < ZERO) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_RTOL); - return(IDA_ILL_INPUT); - } - - if (atol == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_ATOL_NULL); - return(IDA_ILL_INPUT); - } - - if (itol == IDA_SS) { - neg_atol = (*((realtype *)atol) < ZERO); - } else { - neg_atol = (N_VMin((N_Vector)atol) < ZERO); - } - if (neg_atol) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_ATOL); - return(IDA_ILL_INPUT); - } - - /* All error checking is complete at this point */ - - /* Copy the input parameters into IDA memory block */ - IDA_mem->ida_res = res; - IDA_mem->ida_y0 = yy0; - IDA_mem->ida_yp0 = yp0; - IDA_mem->ida_tn = t0; - IDA_mem->ida_itol = itol; - IDA_mem->ida_rtol = rtol; - IDA_mem->ida_atol = atol; - - /* Initialize the phi array */ - N_VScale(ONE, yy0, IDA_mem->ida_phi[0]); - N_VScale(ONE, yp0, IDA_mem->ida_phi[1]); - - /* Initialize all the counters and other optional output values */ - - IDA_mem->ida_nst = 0; - IDA_mem->ida_nre = 0; - IDA_mem->ida_ncfn = 0; - IDA_mem->ida_netf = 0; - IDA_mem->ida_nni = 0; - IDA_mem->ida_nsetups = 0; - - IDA_mem->ida_kused = 0; - IDA_mem->ida_hused = ZERO; - IDA_mem->ida_tolsf = ONE; - - /* Initial setup not done yet */ - IDA_mem->ida_SetupDone = FALSE; - - /* Problem has been successfully re-initialized */ - - return(IDA_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * readability constants - * ----------------------------------------------------------------- - */ - -#define res (IDA_mem->ida_res) -#define y0 (IDA_mem->ida_y0) -#define yp0 (IDA_mem->ida_yp0) -#define itol (IDA_mem->ida_itol) -#define rtol (IDA_mem->ida_rtol) -#define atol (IDA_mem->ida_atol) - -#define rdata (IDA_mem->ida_rdata) -#define maxord (IDA_mem->ida_maxord) -#define mxstep (IDA_mem->ida_mxstep) -#define hin (IDA_mem->ida_hin) -#define hmax_inv (IDA_mem->ida_hmax_inv) -#define tstop (IDA_mem->ida_tstop) -#define tstopset (IDA_mem->ida_tstopset) -#define epcon (IDA_mem->ida_epcon) -#define maxnef (IDA_mem->ida_maxnef) -#define maxncf (IDA_mem->ida_maxncf) -#define maxcor (IDA_mem->ida_maxcor) -#define suppressalg (IDA_mem->ida_suppressalg) -#define id (IDA_mem->ida_id) -#define constraints (IDA_mem->ida_constraints) - -#define epiccon (IDA_mem->ida_epiccon) -#define maxnh (IDA_mem->ida_maxnh) -#define maxnj (IDA_mem->ida_maxnj) -#define maxnit (IDA_mem->ida_maxnit) -#define lsoff (IDA_mem->ida_lsoff) -#define steptol (IDA_mem->ida_steptol) - -#define uround (IDA_mem->ida_uround) -#define phi (IDA_mem->ida_phi) -#define ewt (IDA_mem->ida_ewt) -#define yy (IDA_mem->ida_yy) -#define yp (IDA_mem->ida_yp) -#define delta (IDA_mem->ida_delta) -#define mm (IDA_mem->ida_mm) -#define ee (IDA_mem->ida_ee) -#define savres (IDA_mem->ida_savres) -#define tempv1 (IDA_mem->ida_tempv1) -#define tempv2 (IDA_mem->ida_tempv2) -#define kk (IDA_mem->ida_kk) -#define hh (IDA_mem->ida_hh) -#define h0u (IDA_mem->ida_h0u) -#define tn (IDA_mem->ida_tn) -#define tretp (IDA_mem->ida_tretp) -#define cj (IDA_mem->ida_cj) -#define cjold (IDA_mem->ida_cjold) -#define cjratio (IDA_mem->ida_cjratio) -#define cjlast (IDA_mem->ida_cjlast) -#define nbacktr (IDA_mem->ida_nbacktr) -#define nst (IDA_mem->ida_nst) -#define nre (IDA_mem->ida_nre) -#define ncfn (IDA_mem->ida_ncfn) -#define netf (IDA_mem->ida_netf) -#define nni (IDA_mem->ida_nni) -#define nsetups (IDA_mem->ida_nsetups) -#define ns (IDA_mem->ida_ns) -#define lrw1 (IDA_mem->ida_lrw1) -#define liw1 (IDA_mem->ida_liw1) -#define lrw (IDA_mem->ida_lrw) -#define liw (IDA_mem->ida_liw) -#define linit (IDA_mem->ida_linit) -#define lsetup (IDA_mem->ida_lsetup) -#define lsolve (IDA_mem->ida_lsolve) -#define lperf (IDA_mem->ida_lperf) -#define lfree (IDA_mem->ida_lfree) -#define lmem (IDA_mem->ida_lmem) -#define knew (IDA_mem->ida_knew) -#define kused (IDA_mem->ida_kused) -#define hused (IDA_mem->ida_hused) -#define tolsf (IDA_mem->ida_tolsf) -#define phase (IDA_mem->ida_phase) -#define epsNewt (IDA_mem->ida_epsNewt) -#define toldel (IDA_mem->ida_toldel) -#define ss (IDA_mem->ida_ss) -#define rr (IDA_mem->ida_rr) -#define psi (IDA_mem->ida_psi) -#define alpha (IDA_mem->ida_alpha) -#define beta (IDA_mem->ida_beta) -#define sigma (IDA_mem->ida_sigma) -#define gamma (IDA_mem->ida_gamma) -#define setupNonNull (IDA_mem->ida_setupNonNull) -#define constraintsSet (IDA_mem->ida_constraintsSet) - -/* - * ----------------------------------------------------------------- - * IDASolve - * ----------------------------------------------------------------- - * This routine is the main driver of the IDA package. - * - * It integrates over an independent variable interval defined by the user, - * by calling IDAStep to take internal independent variable steps. - * - * The first time that IDASolve is called for a successfully initialized - * problem, it computes a tentative initial step size. - * - * IDASolve supports four modes, specified by itask: - * IDA_NORMAL, IDA_ONE_STEP, IDA_NORMAL_TSTOP, and IDA_ONE_STEP_TSTOP. - * In the IDA_NORMAL and IDA_NORMAL_TSTOP modes, the solver steps until it - * passes tout and then interpolates to obtain y(tout) and yp(tout). - * In the IDA_ONE_STEP and IDA_ONE_STEP_TSTOP modes, it takes one internal step - * and returns. In the IDA_NORMAL_TSTOP and IDA_ONE_STEP_TSTOP modes, it also - * takes steps so as to reach tstop exactly and never to go past it. - * - * IDASolve returns integer values corresponding to success and failure as below: - * - * successful returns: - * - * IDA_SUCCESS - * IDA_TSTOP_RETURN - * - * failed returns: - * - * IDA_ILL_INPUT - * IDA_TOO_MUCH_WORK - * IDA_MEM_NULL - * IDA_TOO_MUCH_ACC - * IDA_CONV_FAIL - * IDA_LSETUP_FAIL - * IDA_LSOLVE_FAIL - * IDA_CONSTR_FAIL - * IDA_ERR_FAIL - * IDA_REP_RES_ERR - * IDA_RES_FAIL - * ----------------------------------------------------------------- - */ - -int IDASolve(void *ida_mem, realtype tout, realtype *tret, - N_Vector yret, N_Vector ypret, int itask) -{ - long int nstloc; - int sflag, istate, ier; - realtype tdist, troundoff, ypnorm, rh, nrm; - booleantype istop, ewtsetOK; - IDAMem IDA_mem; - - /* Check for legal inputs in all cases. */ - - if (ida_mem == NULL) { - fprintf(stderr, MSG_IDA_NO_MEM); - return(IDA_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - /* Check if problem was malloc'ed */ - - if (IDA_mem->ida_MallocDone == FALSE) { - if(errfp!=NULL) fprintf(errfp, MSG_NO_MALLOC); - return(IDA_NO_MALLOC); - } - - /* Check for legal arguments */ - - if (yret == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_YRET_NULL); - return(IDA_ILL_INPUT); - } - yy = yret; - - if (ypret == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_YPRET_NULL); - return(IDA_ILL_INPUT); - } - yp = ypret; - - if (tret == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_TRET_NULL); - return(IDA_ILL_INPUT); - } - *tret = tretp = tn; /* Set tret now in case of illegal-input return. */ - - if ((itask < IDA_NORMAL) || (itask > IDA_ONE_STEP_TSTOP)) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_ITASK); - return(IDA_ILL_INPUT); - } - - if ( (itask == IDA_NORMAL_TSTOP) || (itask == IDA_ONE_STEP_TSTOP) ) { - if ( tstopset == FALSE ) { - if(errfp!=NULL) fprintf(errfp, MSG_NO_TSTOP); - return(IDA_ILL_INPUT); - } - istop = TRUE; - } else { - istop = FALSE; - } - - - if (nst == 0) { /* THIS IS THE FIRST CALL */ - - /* Check inputs to the IDA for correctness and consistency */ - - if (IDA_mem->ida_SetupDone == FALSE) { - ier = IDAInitialSetup(IDA_mem); - if(ier != IDA_SUCCESS) return(IDA_ILL_INPUT); - IDA_mem->ida_SetupDone = TRUE; - } - - /* On the first call, check for tout - tn too small, - set initial hh, - check for approach to tstop, and scale phi[1] by hh. */ - - tdist = ABS(tout - tn); - troundoff = TWO*uround*(ABS(tn) + ABS(tout)); - if (tdist < troundoff) { - if(errfp!=NULL) fprintf(errfp, MSG_TOO_CLOSE); - return(IDA_ILL_INPUT); - } - - hh = hin; - if ( (hh != ZERO) && ((tout-tn)*hh < ZERO) ) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_HINIT); - return(IDA_ILL_INPUT); - } - - if (hh == ZERO) { - hh = PT001*tdist; - ypnorm = IDAWrmsNorm(IDA_mem, phi[1], ewt, suppressalg); - if (ypnorm > HALF/hh) hh = HALF/ypnorm; - if(tout < tn) hh = -hh; - } - - rh = ABS(hh)*hmax_inv; - if (rh > ONE) hh /= rh; - - if(istop) { - if ( (tstop - tn)*hh < ZERO) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_TSTOP, tn); - return(IDA_ILL_INPUT); - } - if ( (tn + hh - tstop)*hh > ZERO) hh = tstop - tn; - } - - h0u = hh; - - N_VScale(hh, phi[1], phi[1]); - kk = 0; kused = 0; /* set in case of an error return before a step */ - - /* Set the convergence test constants epsNewt and toldel */ - - epsNewt = epcon; - toldel = PT0001 * epsNewt; - - } /* end of first-call block. */ - - /* Call lperf function and set nstloc for later performance testing. */ - - if (lperf != NULL) lperf(IDA_mem, 0); - nstloc = 0; - - /* If not the first call, check for stop conditions. */ - - if (nst > 0) { - istate = IDAStopTest1(IDA_mem, tout, tret, yret, ypret, itask); - if (istate != CONTINUE_STEPS) return(istate); - } - - /* Looping point for internal steps. */ - - loop { - - /* Check for too many steps taken. */ - - if (nstloc >= mxstep) { - if(errfp!=NULL) fprintf(errfp, MSG_MAX_STEPS, tn); - istate = IDA_TOO_MUCH_WORK; - *tret = tretp = tn; - break; /* Here yy=yret and yp=ypret already have the current solution. */ - } - - /* Call lperf to generate warnings of poor performance. */ - - if (lperf != NULL) lperf(IDA_mem, 1); - - /* Reset and check ewt (if not first call). */ - - if (nst > 0) { - ewtsetOK = IDAEwtSet(IDA_mem, phi[0]); - if (!ewtsetOK) { - if(errfp!=NULL) fprintf(errfp, MSG_EWT_NOW_BAD, tn); - istate = IDA_ILL_INPUT; - ier = IDAGetSolution(IDA_mem, tn, yret, ypret); - *tret = tretp = tn; - break; - } - } - - /* Check for too much accuracy requested. */ - - nrm = IDAWrmsNorm(IDA_mem, phi[0], ewt, suppressalg); - tolsf = uround * nrm; - if (tolsf > ONE) { - tolsf *= TEN; - if(errfp!=NULL) fprintf(errfp, MSG_TOO_MUCH_ACC, tn); - istate = IDA_TOO_MUCH_ACC; - *tret = tretp = tn; - if (nst > 0) ier = IDAGetSolution(IDA_mem, tn, yret, ypret); - break; - } - - /* Call IDAStep to take a step. */ - - sflag = IDAStep(IDA_mem); - - /* Process all failed-step cases, and exit loop. */ - - if (sflag != IDA_SUCCESS) { - istate = IDAHandleFailure(IDA_mem, sflag); - *tret = tretp = tn; - ier = IDAGetSolution(IDA_mem, tn, yret, ypret); - break; - } - - nstloc++; - - /* After successful step, check for stop conditions; continue or break. */ - - istate = IDAStopTest2(IDA_mem, tout, tret, yret, ypret, itask); - if (istate != CONTINUE_STEPS) break; - - } /* End of step loop */ - - return(istate); -} - -/* - * ----------------------------------------------------------------- - * IDAGetSolution - * ----------------------------------------------------------------- - * This routine evaluates y(t) and y'(t) as the value and derivative of - * the interpolating polynomial at the independent variable t, and stores - * the results in the vectors yret and ypret. It uses the current - * independent variable value, tn, and the method order last used, kused. - * This function is called by IDASolve with t = tout, t = tn, or t = tstop. - * - * If kused = 0 (no step has been taken), or if t = tn, then the order used - * here is taken to be 1, giving yret = phi[0], ypret = phi[1]/psi[0]. - * - * The return values are: - * IDA_SUCCESS if t is legal, or - * IDA_BAD_T if t is not within the interval of the last step taken. - * ----------------------------------------------------------------- - */ - -int IDAGetSolution(void *ida_mem, realtype t, N_Vector yret, N_Vector ypret) -{ - IDAMem IDA_mem; - realtype tfuzz, tp, delt, c, d, gam; - int j, kord; - - if (ida_mem == NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return (IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - /* Check t for legality. Here tn - hused is t_{n-1}. */ - - tfuzz = HUNDRED * uround * (tn + hh); - tp = tn - hused - tfuzz; - if ( (t - tp)*hh < ZERO) { - if(errfp!=NULL) fprintf(errfp, MSG_IDAG_BAD_T, t, tn-hused, tn); - return(IDA_BAD_T); - } - - /* Initialize yret = phi[0], ypret = 0, and kord = (kused or 1). */ - - N_VScale (ONE, phi[0], yret); - N_VConst (ZERO, ypret); - kord = kused; - if (kused == 0) kord = 1; - - /* Accumulate multiples of columns phi[j] into yret and ypret. */ - - delt = t - tn; - c = ONE; d = ZERO; - gam = delt/psi[0]; - for (j=1; j <= kord; j++) { - d = d*gam + c/psi[j-1]; - c = c*gam; - gam = (delt + psi[j-1])/psi[j]; - N_VLinearSum(ONE, yret, c, phi[j], yret); - N_VLinearSum(ONE, ypret, d, phi[j], ypret); - } - return(IDA_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * IDAFree - * ----------------------------------------------------------------- - * This routine frees the problem memory allocated by IDAMalloc - * Such memory includes all the vectors allocated by IDAAllocVectors, - * and the memory lmem for the linear solver (deallocated by a call - * to lfree). - * ----------------------------------------------------------------- - */ - -void IDAFree(void *ida_mem) -{ - IDAMem IDA_mem; - - if (ida_mem == NULL) return; - - IDA_mem = (IDAMem) ida_mem; - - IDAFreeVectors(IDA_mem); - if (lfree != NULL) lfree(IDA_mem); - free(IDA_mem); -} - -/* - * ----------------------------------------------------------------- - * private helper functions - * ----------------------------------------------------------------- - */ - -/* - * ----------------------------------------------------------------- - * IDACheckNvector - * ----------------------------------------------------------------- - * This routine checks if all required vector operations are present. - * If any of them is missing it returns FALSE. - * ----------------------------------------------------------------- - */ - -static booleantype IDACheckNvector(N_Vector tmpl) -{ - if((tmpl->ops->nvclone == NULL) || - (tmpl->ops->nvdestroy == NULL) || - (tmpl->ops->nvlinearsum == NULL) || - (tmpl->ops->nvconst == NULL) || - (tmpl->ops->nvprod == NULL) || - (tmpl->ops->nvscale == NULL) || - (tmpl->ops->nvabs == NULL) || - (tmpl->ops->nvinv == NULL) || - (tmpl->ops->nvaddconst == NULL) || - (tmpl->ops->nvwrmsnorm == NULL) || - (tmpl->ops->nvmin == NULL)) - return(FALSE); - else - return(TRUE); -} - -/* - * ----------------------------------------------------------------- - * IDAAllocVectors - * ----------------------------------------------------------------- - * This routine allocates the IDA vectors ewt, tempv1, tempv2, and - * phi[0], ..., phi[maxord]. The length of the vectors is the input - * parameter Neq and the maximum order (needed to allocate phi) is the - * input parameter maxord. If all memory allocations are successful, - * IDAAllocVectors returns TRUE. Otherwise all allocated memory is freed - * and IDAAllocVectors returns FALSE. - * This routine also sets the optional outputs lrw and liw, which are - * (respectively) the lengths of the real and integer work spaces - * allocated here. - * ----------------------------------------------------------------- - */ - -static booleantype IDAAllocVectors(IDAMem IDA_mem, N_Vector tmpl) -{ - int i, j, maxcol; - - /* Allocate ewt, ee, delta, tempv1, tempv2 */ - - ewt = N_VClone(tmpl); - if (ewt == NULL) return(FALSE); - - ee = N_VClone(tmpl); - if (ee == NULL) { - N_VDestroy(ewt); - return(FALSE); - } - delta = N_VClone(tmpl); - if (delta == NULL) { - N_VDestroy(ewt); - N_VDestroy(ee); - return(FALSE); - } - tempv1 = N_VClone(tmpl); - if (tempv1 == NULL) { - N_VDestroy(ewt); - N_VDestroy(ee); - N_VDestroy(delta); - return(FALSE); - } - tempv2= N_VClone(tmpl); - if (tempv2 == NULL) { - N_VDestroy(ewt); - N_VDestroy(ee); - N_VDestroy(delta); - N_VDestroy(tempv1); - return(FALSE); - } - - savres = tempv1; - - /* Allocate phi[0] ... phi[maxord]. Make sure phi[2] and phi[3] are - allocated (for use as temporary vectors), regardless of maxord. */ - - maxcol = MAX(maxord,3); - for (j=0; j <= maxcol; j++) { - phi[j] = N_VClone(tmpl); - if (phi[j] == NULL) { - N_VDestroy(ewt); - N_VDestroy(ee); - N_VDestroy(delta); - N_VDestroy(tempv1); - N_VDestroy(tempv2); - for (i=0; i < j; i++) N_VDestroy(phi[i]); - return(FALSE); - } - } - - /* Set solver workspace lengths */ - - lrw = (maxcol + 6) * lrw1; - liw = (maxcol + 6) * liw1; - - return(TRUE); -} - -/* - * ----------------------------------------------------------------- - * IDAfreeVectors - * ----------------------------------------------------------------- - * This routine frees the IDA vectors allocated in IDAAllocVectors. - * ----------------------------------------------------------------- - */ - -static void IDAFreeVectors(IDAMem IDA_mem) -{ - int j, maxcol; - - N_VDestroy(ewt); - N_VDestroy(ee); - N_VDestroy(delta); - N_VDestroy(tempv1); - N_VDestroy(tempv2); - maxcol = MAX(maxord,3); - for(j=0; j <= maxcol; j++) N_VDestroy(phi[j]); -} - -/* - * ----------------------------------------------------------------- - * IDAInitialSetup - * ----------------------------------------------------------------- - * This routine is called by IDASolve once at the first step. It performs - * all checks on optional inputs and inputs to IDAMalloc/IDAReInit that - * could not be done before. - * - * If no merror is encountered, IDAInitialSetup returns IDA_SUCCESS. Otherwise, - * it returns an error flag and prints a message to errfp. - * ----------------------------------------------------------------- - */ - -int IDAInitialSetup(IDAMem IDA_mem) -{ - realtype temptest; - booleantype ewtsetOK, conOK; - int ier; - - /* Test for more vector operations, depending on options */ - - if (suppressalg) - if (id->ops->nvwrmsnormmask == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_NVECTOR); - return(IDA_ILL_INPUT); - } - - if (constraints != NULL) - if (constraints->ops->nvdiv == NULL || - constraints->ops->nvmaxnorm == NULL || - constraints->ops->nvcompare == NULL || - constraints->ops->nvconstrmask == NULL || - constraints->ops->nvminquotient == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_NVECTOR); - return(IDA_ILL_INPUT); - } - - /* Test id vector for legality */ - - if(suppressalg && (id==NULL)){ - if(errfp!=NULL) fprintf(errfp, MSG_MISSING_ID); - return(IDA_ILL_INPUT); - } - - /* Load ewt */ - - ewtsetOK = IDAEwtSet(IDA_mem, y0); - if (!ewtsetOK) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_EWT); - return(IDA_ILL_INPUT); - } - - /* Check the constraints pointer and vector */ - - if (constraints == NULL) - constraintsSet = FALSE; - else { - constraintsSet = TRUE; - temptest = N_VMaxNorm(constraints); - if(temptest > TWOPT5){ - if(errfp!=NULL) fprintf(errfp, MSG_BAD_CONSTRAINTS); - return(IDA_ILL_INPUT); - } else if(temptest < HALF) constraintsSet = FALSE; /* constraints empty */ - } - - /* Check to see if y0 satisfies constraints. */ - - if (constraintsSet) { - conOK = N_VConstrMask (constraints, y0, tempv2); - if (!conOK) { - if(errfp!=NULL) fprintf(errfp, MSG_Y0_FAIL_CONSTR); - return(IDA_ILL_INPUT); - } - } - - /* Check that lsolve exists and call linit function if it exists. */ - - if (lsolve == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_LSOLVE_NULL); - return(IDA_ILL_INPUT); - } - - if (linit != NULL) { - ier = linit(IDA_mem); - if (ier < 0) { - if(errfp!=NULL) fprintf(errfp, MSG_LINIT_FAIL); - return(IDA_LINIT_FAIL); - } - } - - return(IDA_SUCCESS); - -} - -/* - * ----------------------------------------------------------------- - * IDAEwtSet - * ----------------------------------------------------------------- - * This routine is responsible for loading the error weight vector - * ewt, according to itol, as follows: - * (1) ewt[i] = 1 / (*rtol * ABS(ycur[i]) + *atol), i=0,...,Neq-1 - * if itol = IDA_SS - * (2) ewt[i] = 1 / (*rtol * ABS(ycur[i]) + atol[i]), i=0,...,Neq-1 - * if itol = IDA_SV - * - * IDAEwtSet returns TRUE if ewt is successfully set as above to a - * positive vector and FALSE otherwise. In the latter case, ewt is - * considered undefined after the FALSE return from IDAEwtSet. - * - * All the real work is done in the routines IDAEwtSetSS, IDAEwtSetSV. - * ----------------------------------------------------------------- - */ - -booleantype IDAEwtSet(IDAMem IDA_mem, N_Vector ycur) -{ - booleantype ewtsetOK=TRUE; - - switch(itol) { - case IDA_SS: - ewtsetOK = IDAEwtSetSS(IDA_mem, ycur); - break; - case IDA_SV: - ewtsetOK = IDAEwtSetSV(IDA_mem, ycur); - break; - } - return(ewtsetOK); -} - -/* - * ----------------------------------------------------------------- - * IDAEwtSetSS - * ----------------------------------------------------------------- - * This routine sets ewt as decribed above in the case itol=IDA_SS. - * It tests for non-positive components before inverting. IDAEwtSetSS - * returns TRUE if ewt is successfully set to a positive vector - * and FALSE otherwise. In the latter case, ewt is considered - * undefined after the FALSE return from IDAEwtSetSS. - * ----------------------------------------------------------------- - */ - -static booleantype IDAEwtSetSS(IDAMem IDA_mem, N_Vector ycur) -{ - realtype rtoli, *atoli; - - rtoli = *rtol; - atoli = (realtype *)atol; - N_VAbs(ycur, tempv1); - N_VScale(rtoli, tempv1, tempv1); - N_VAddConst(tempv1, *atoli, tempv1); - if (N_VMin(tempv1) <= ZERO) return(FALSE); - N_VInv(tempv1, ewt); - return(TRUE); -} - -/* - * ----------------------------------------------------------------- - * IDAEwtSetSV - * ----------------------------------------------------------------- - * This routine sets ewt as decribed above in the case itol=IDA_SV. - * It tests for non-positive components before inverting. IDAEwtSetSV - * returns TRUE if ewt is successfully set to a positive vector - * and FALSE otherwise. In the latter case, ewt is considered - * undefined after the FALSE return from IDAEwtSetSV. - * ----------------------------------------------------------------- - */ - -static booleantype IDAEwtSetSV(IDAMem IDA_mem, N_Vector ycur) -{ - realtype rtoli; - N_Vector atoli; - - rtoli = *rtol; - atoli = (N_Vector)atol; - N_VAbs(ycur, tempv1); - N_VLinearSum(rtoli, tempv1, ONE, atoli, tempv1); - if (N_VMin(tempv1) <= ZERO) return(FALSE); - N_VInv(tempv1, ewt); - return(TRUE); -} - -/* - * ----------------------------------------------------------------- - * IDAStopTest1 - * ----------------------------------------------------------------- - * This routine tests for stop conditions before taking a step. - * The tests depend on the value of itask. - * The variable tretp is the previously returned value of tret. - * - * The return values are: - * CONTINUE_STEPS if no stop conditions were found - * IDA_SUCCESS for a normal return to the user - * IDA_TSTOP_RETURN for a tstop-reached return to the user - * IDA_ILL_INPUT for an illegal-input return to the user - * - * In the tstop cases, this routine may adjust the stepsize hh to cause - * the next step to reach tstop exactly. - * ----------------------------------------------------------------- - */ - -static int IDAStopTest1(IDAMem IDA_mem, realtype tout, realtype *tret, - N_Vector yret, N_Vector ypret, int itask) -{ - - int ier; - realtype troundoff; - - switch (itask) { - - case IDA_NORMAL: - /* Test for tout = tretp, and for tn past tout. */ - if (tout == tretp) { - *tret = tretp = tout; - return(IDA_SUCCESS); - } - if ( (tn - tout)*hh >= ZERO) { - ier = IDAGetSolution(IDA_mem, tout, yret, ypret); - if (ier != IDA_SUCCESS) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_TOUT, tout); - return(IDA_ILL_INPUT); - } - *tret = tretp = tout; - return(IDA_SUCCESS); - } - return(CONTINUE_STEPS); - - case IDA_ONE_STEP: - /* Test for tn past tretp. */ - if ( (tn - tretp)*hh > ZERO) { - ier = IDAGetSolution(IDA_mem, tn, yret, ypret); - *tret = tretp = tn; - return(IDA_SUCCESS); - } - return(CONTINUE_STEPS); - - case IDA_NORMAL_TSTOP: - /* Test for tn past tstop, tn = tretp, tn past tout, tn near tstop. */ - if ( (tn - tstop)*hh > ZERO) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_TSTOP, tn); - return(IDA_ILL_INPUT); - } - if (tout == tretp) { - *tret = tretp = tout; - return(IDA_SUCCESS); - } - if ( (tn - tout)*hh >= ZERO) { - ier = IDAGetSolution(IDA_mem, tout, yret, ypret); - if (ier != IDA_SUCCESS) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_TOUT, tout); - return(IDA_ILL_INPUT); - } - *tret = tretp = tout; - return(IDA_SUCCESS); - } - troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); - if ( ABS(tn - tstop) <= troundoff) { - ier = IDAGetSolution(IDA_mem, tstop, yret, ypret); - if (ier != IDA_SUCCESS) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_TSTOP, tn); - return(IDA_ILL_INPUT); - } - *tret = tretp = tstop; - return(IDA_TSTOP_RETURN); - } - if ( (tn + hh - tstop)*hh > ZERO) hh = tstop - tn; - return(CONTINUE_STEPS); - - case IDA_ONE_STEP_TSTOP: - /* Test for tn past tstop, tn past tretp, and tn near tstop. */ - if ( (tn - tstop)*hh > ZERO) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_TSTOP, tn); - return(IDA_ILL_INPUT); - } - if ( (tn - tretp)*hh > ZERO) { - ier = IDAGetSolution(IDA_mem, tn, yret, ypret); - *tret = tretp = tn; - return(IDA_SUCCESS); - } - troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); - if ( ABS(tn - tstop) <= troundoff) { - ier = IDAGetSolution(IDA_mem, tstop, yret, ypret); - if (ier != IDA_SUCCESS) { - if(errfp!=NULL) fprintf(errfp, MSG_BAD_TSTOP, tn); - return(IDA_ILL_INPUT); - } - *tret = tretp = tstop; - return(IDA_TSTOP_RETURN); - } - if ( (tn + hh - tstop)*hh > ZERO) hh = tstop - tn; - return(CONTINUE_STEPS); - - } - return(-99); -} - -/* - * ----------------------------------------------------------------- - * IDAStopTest2 - * ----------------------------------------------------------------- - * This routine tests for stop conditions after taking a step. - * The tests depend on the value of itask. - * - * The return values are: - * CONTINUE_STEPS if no stop conditions were found - * IDA_SUCCESS for a normal return to the user - * IDA_TSTOP_RETURN for a tstop-reached return to the user - * - * In the two cases with tstop, this routine may reset the stepsize hh - * to cause the next step to reach tstop exactly. - * - * In the two cases with ONE_STEP mode, no interpolation to tn is needed - * because yret and ypret already contain the current y and y' values. - * - * Note: No test is made for an error return from IDAGetSolution here, - * because the same test was made prior to the step. - * ----------------------------------------------------------------- - */ - -static int IDAStopTest2(IDAMem IDA_mem, realtype tout, realtype *tret, - N_Vector yret, N_Vector ypret, int itask) -{ - - int ier; - realtype troundoff; - - switch (itask) { - - case IDA_NORMAL: - /* Test for tn past tout. */ - if ( (tn - tout)*hh >= ZERO) { - ier = IDAGetSolution(IDA_mem, tout, yret, ypret); - *tret = tretp = tout; - return(IDA_SUCCESS); - } - return(CONTINUE_STEPS); - - case IDA_ONE_STEP: - *tret = tretp = tn; - return(IDA_SUCCESS); - - case IDA_NORMAL_TSTOP: - /* Test for tn at tstop, for tn past tout, and for tn near tstop. */ - troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); - if ( ABS(tn - tstop) <= troundoff) { - ier = IDAGetSolution(IDA_mem, tstop, yret, ypret); - *tret = tretp = tstop; - return(IDA_TSTOP_RETURN); - } - if ( (tn - tout)*hh >= ZERO) { - ier = IDAGetSolution(IDA_mem, tout, yret, ypret); - *tret = tretp = tout; - return(IDA_SUCCESS); - } - if ( (tn + hh - tstop)*hh > ZERO) hh = tstop - tn; - return(CONTINUE_STEPS); - - case IDA_ONE_STEP_TSTOP: - /* Test for tn at tstop. */ - troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); - if ( ABS(tn - tstop) <= troundoff) { - ier = IDAGetSolution(IDA_mem, tstop, yret, ypret); - *tret = tretp = tstop; - return(IDA_TSTOP_RETURN); - } - if ( (tn + hh - tstop)*hh > ZERO) hh = tstop - tn; - *tret = tretp = tn; - return(IDA_SUCCESS); - - } - return -99; -} - -/* - * ----------------------------------------------------------------- - * IDAHandleFailure - * ----------------------------------------------------------------- - * This routine prints error messages for all cases of failure by - * IDAStep. It returns to IDASolve the value that it is to return to - * the user. - * ----------------------------------------------------------------- - */ - -static int IDAHandleFailure(IDAMem IDA_mem, int sflag) -{ - - /* Depending on sflag, print error message and return error flag */ - switch (sflag) { - - case IDA_ERR_FAIL: - if(errfp!=NULL) fprintf(errfp, MSG_ERR_FAILS, tn, hh); - return(IDA_ERR_FAIL); - - case IDA_CONV_FAIL: - if(errfp!=NULL) fprintf(errfp, MSG_CONV_FAILS, tn, hh); - return(IDA_CONV_FAIL); - - case IDA_LSETUP_FAIL: - if(errfp!=NULL) fprintf(errfp, MSG_SETUP_FAILED, tn); - return(IDA_LSETUP_FAIL); - - case IDA_LSOLVE_FAIL: - if(errfp!=NULL) fprintf(errfp, MSG_SOLVE_FAILED, tn); - return(IDA_LSOLVE_FAIL); - - case IDA_REP_RES_ERR: - if(errfp!=NULL) fprintf(errfp, MSG_REP_RES_ERR, tn); - return(IDA_REP_RES_ERR); - - case IDA_RES_FAIL: - if(errfp!=NULL) fprintf(errfp, MSG_RES_NONRECOV, tn); - return(IDA_RES_FAIL); - - case IDA_CONSTR_FAIL: - if(errfp!=NULL) fprintf(errfp, MSG_FAILED_CONSTR, tn); - return(IDA_CONSTR_FAIL); - - } - - return -99; - -} - -/* - * ----------------------------------------------------------------- - * IDAStep - * ----------------------------------------------------------------- - * This routine performs one internal IDA step, from tn to tn + hh. - * It calls other routines to do all the work. - * - * It solves a system of differential/algebraic equations of the form - * F(t,y,y') = 0, for one step. In IDA, tt is used for t, - * yy is used for y, and yp is used for y'. The function F is supplied as 'res' - * by the user. - * - * The methods used are modified divided difference, fixed leading - * coefficient forms of backward differentiation formulas. - * The code adjusts the stepsize and order to control the local error per step. - * - * The main operations done here are as follows: - * * initialize various quantities; - * * setting of multistep method coefficients; - * * solution of the nonlinear system for yy at t = tn + hh; - * * deciding on order reduction and testing the local error; - * * attempting to recover from failure in nonlinear solver or error test; - * * resetting stepsize and order for the next step. - * * updating phi and other state data if successful; - * - * On a failure in the nonlinear system solution or error test, the - * step may be reattempted, depending on the nature of the failure. - * - * Variables or arrays (all in the IDAMem structure) used in IDAStep are: - * - * tt -- Independent variable. - * yy -- Solution vector at tt. - * yp -- Derivative of solution vector after successful stelp. - * res -- User-supplied function to evaluate the residual. See the - * description given in file ida.h . - * lsetup -- Routine to prepare for the linear solver call. It may either - * save or recalculate quantities used by lsolve. (Optional) - * lsolve -- Routine to solve a linear system. A prior call to lsetup - * may be required. - * hh -- Appropriate step size for next step. - * ewt -- Vector of weights used in all convergence tests. - * phi -- Array of divided differences used by IDAStep. This array is composed - * of (maxord+1) nvectors (each of size Neq). (maxord+1) is the maximum - * order for the problem, maxord, plus 1. - * - * Return values are: - * IDA_SUCCESS IDA_RES_FAIL LSETUP_ERROR_NONRECVR - * IDA_LSOLVE_FAIL IDA_ERR_FAIL - * IDA_CONSTR_FAIL IDA_CONV_FAIL - * IDA_REP_RES_ERR - * ----------------------------------------------------------------- - */ - -static int IDAStep(IDAMem IDA_mem) -{ - realtype saved_t, ck, est=0.0; - realtype terk=0.0, terkm1=0.0, erkm1=0.0; - int ncf, nef, nflag, kflag; - - saved_t = tn; - ncf = nef = 0; - - if(nst == ZERO){ - kk = 1; - kused = 0; - hused = ZERO; - psi[0] = hh; - cj = ONE/hh; - phase = 0; - ns = 0; - } - - /* Looping point for attempts to take a step */ - - loop { - IDASetCoeffs(IDA_mem, &ck); - kflag = IDA_SUCCESS; - - nflag = IDAnls(IDA_mem); - - if(nflag == IDA_SUCCESS) - nflag = IDATestError(IDA_mem, &ck, &est, &terk, &terkm1, &erkm1); - - if(nflag != IDA_SUCCESS) - kflag = IDAHandleNFlag(IDA_mem, nflag, saved_t, &ncf, &nef, &est); - - if (kflag == PREDICT_AGAIN) continue; - else if(kflag == IDA_SUCCESS) break; - else return(kflag); - } - - /* Nonlinear system solve and error test were both successful; - update data, and consider change of step and/or order */ - - IDACompleteStep(IDA_mem, &est, &terk, &terkm1, &erkm1); - - return(IDA_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * IDASetCoeffs - * ----------------------------------------------------------------- - * This routine computes the coefficients relevant to the current step. - * The counter ns counts the number of consecutive steps taken at - * constant stepsize h and order k, up to a maximum of k + 2. - * Then the first ns components of beta will be one, and on a step - * with ns = k + 2, the coefficients alpha, etc. need not be reset here. - * Also, IDACompleteStep prohibits an order increase until ns = k + 2. - * ----------------------------------------------------------------- - */ - -static void IDASetCoeffs(IDAMem IDA_mem, realtype *ck) -{ - int i; - realtype temp1, temp2, alpha0, alphas; - - /* Set coefficients for the current stepsize h */ - - if(hh != hused || kk != kused) ns = 0; - ns = MIN(ns+1,kused+2); - if(kk+1 >= ns){ - beta[0] = ONE; - alpha[0] = ONE; - temp1 = hh; - gamma[0] = ZERO; - sigma[0] = ONE; - for(i=1;i<=kk;i++){ - temp2 = psi[i-1]; - psi[i-1] = temp1; - beta[i] = beta[i-1] * psi[i-1] / temp2; - temp1 = temp2 + hh; - alpha[i] = hh / temp1; - sigma[i] = i * sigma[i-1] * alpha[i]; - gamma[i] = gamma[i-1] + alpha[i-1] / hh; - } - psi[kk] = temp1; - } - /* compute alphas, alpha0 */ - alphas = ZERO; - alpha0 = ZERO; - for(i=0;i temp2) callSetup = TRUE;} - {if(cj != cjlast) ss=HUNDRED;} - } - - /* Begin the main loop. This loop is traversed at most twice. - The second pass only occurs when the first pass had a recoverable - failure with old Jacobian data */ - loop{ - - - /* Compute predicted values for yy and yp, and compute residual there. */ - ier = IDAPredict(IDA_mem); - - retval = res(tn, yy, yp, delta, rdata); - nre++; - if(retval < 0) return(IDA_RES_FAIL); - if(retval > 0) return(IDA_RES_RECVR); - - /* If indicated, call linear solver setup function and reset parameters. */ - if(callSetup){ - nsetups++; - retval = lsetup(IDA_mem, yy, yp, delta, tempv1, tempv2, tempv3); - cjold = cj; - cjratio = ONE; - ss = TWENTY; - if (retval < 0) return(IDA_LSETUP_FAIL); - if (retval > 0) return(IDA_LSETUP_RECVR); - } - - /* Call the Newton iteration routine. */ - - retval = IDANewtonIter(IDA_mem); - - - /* Retry the current step on recoverable failure with old Jacobian data. */ - - tryAgain = (retval>0)&&(setupNonNull) &&(!callSetup); - - if(tryAgain){ - callSetup = TRUE; - continue; - } - else break; - - } /* end of loop */ - - if(retval != IDA_SUCCESS) return(retval); - - - /* If otherwise successful, check and enforce inequality constraints. */ - - if(constraintsSet){ /* Check constraints and get mask vector mm, - set where constraints failed */ - constraintsPassed = N_VConstrMask(constraints,yy,mm); - if(constraintsPassed) return(IDA_SUCCESS); - else { - N_VCompare(ONEPT5, constraints, tempv1); - /* a , where a[i] =1. when |c[i]| = 2 , c the vector of constraints */ - N_VProd(tempv1, constraints, tempv1); /* a * c */ - N_VDiv(tempv1, ewt, tempv1); /* a * c * wt */ - N_VLinearSum(ONE, yy, -PT1, tempv1, tempv1);/* y - 0.1 * a * c * wt */ - N_VProd(tempv1, mm, tempv1); /* v = mm*(y-.1*a*c*wt) */ - vnorm = IDAWrmsNorm(IDA_mem, tempv1, ewt, FALSE); /* ||v|| */ - - /* If vector v of constraint corrections is small - in norm, correct and accept this step */ - if(vnorm <= epsNewt){ - N_VLinearSum(ONE, ee, -ONE, tempv1, ee); /* ee <- ee - v */ - return(IDA_SUCCESS); - } - else { - /* Constraints not met -- reduce h by computing rr = h'/h */ - N_VLinearSum(ONE, phi[0], -ONE, yy, tempv1); - N_VProd(mm, tempv1, tempv1); - rr = PT9*N_VMinQuotient(phi[0], tempv1); - rr = MAX(rr,PT1); - return(IDA_CONSTR_RECVR); - } - } - } - return(IDA_SUCCESS); -} - - -/* - * ----------------------------------------------------------------- - * IDAPredict - * ----------------------------------------------------------------- - * This routine predicts the new values for vectors yy and yp. - * ----------------------------------------------------------------- - */ - -static int IDAPredict(IDAMem IDA_mem) -{ - int j; - - N_VScale(ONE, phi[0], yy); - N_VConst(ZERO, yp); - - for(j=1; j<=kk; j++) { - N_VLinearSum(ONE, phi[j], ONE, yy, yy); - N_VLinearSum(gamma[j], phi[j], ONE, yp, yp); - } - - return(IDA_SUCCESS); -} - - -/* - * ----------------------------------------------------------------- - * IDANewtonIter - * ----------------------------------------------------------------- - * This routine performs the Newton iteration. - * It assumes that delta contains the initial residual vector on entry. - * If the iteration succeeds, it returns the value IDA_SUCCESS = 0. - * If not, it returns either: - * a positive value (for a recoverable failure), namely one of: - * IDA_RES_RECVR - * IDA_LSOLVE_RECVR - * IDA_NCONV_RECVR - * or - * a negative value (for a nonrecoverable failure), namely one of: - * IDA_RES_FAIL - * IDA_LSOLVE_FAIL - * - * NOTE: This routine uses N_Vector savres, which is preset to tempv1. - * ----------------------------------------------------------------- - */ - -static int IDANewtonIter(IDAMem IDA_mem) -{ - int mnewt, retval; - realtype delnrm, oldnrm, rate; - - /* Initialize counter mnewt and cumulative correction vector ee. */ - mnewt = 0; - N_VConst (ZERO, ee); - - /* Looping point for Newton iteration. Break out on any error. */ - loop { - - nni++; - - /* Save a copy of the residual vector in savres. */ - N_VScale(ONE, delta, savres); - - /* Call the lsolve function to get correction vector delta. */ - retval = lsolve(IDA_mem, delta, ewt, yy, yp, savres); - if(retval < 0) return(IDA_LSOLVE_FAIL); - if(retval > 0) return(IDA_LSOLVE_RECVR); - - /* Apply delta to yy, yp, and ee, and get norm(delta). */ - N_VLinearSum(ONE, yy, -ONE, delta, yy); - N_VLinearSum(ONE, ee, -ONE, delta, ee); - N_VLinearSum(ONE, yp, -cj, delta, yp); - delnrm = IDAWrmsNorm(IDA_mem, delta, ewt, FALSE); - - /* Test for convergence, first directly, then with rate estimate. */ - - if (mnewt == 0){ - oldnrm = delnrm; - if (delnrm <= toldel) return(IDA_SUCCESS); - } - else { - rate = RPowerR( delnrm/oldnrm, ONE/mnewt ); - if (rate > RATEMAX) return(IDA_NCONV_RECVR); - ss = rate/(ONE - rate); - } - - if (ss*delnrm <= epsNewt) return(IDA_SUCCESS); - - /* Not yet converged. Increment mnewt and test for max allowed. */ - mnewt++; - if (mnewt >= maxcor) {retval = IDA_NCONV_RECVR; break;} - - /* Call res for new residual and check error flag from res. */ - retval = res(tn, yy, yp, delta, rdata); - nre++; - if(retval < 0) return(IDA_RES_FAIL); - if(retval > 0) return(IDA_RES_RECVR); - - /* Loop for next iteration. */ - - } /* end of Newton iteration loop */ - - /* All error returns exit here. */ - return(retval); - -} - -/* - * ----------------------------------------------------------------- - * IDATestError - * ----------------------------------------------------------------- - * This routine estimates errors at orders k, k-1, k-2, decides whether - * or not to reduce order, and performs the local error test. - * - * IDATestError returns either IDA_SUCCESS or ERROR_TEST_FAIL - * ----------------------------------------------------------------- - */ - -static int IDATestError(IDAMem IDA_mem, realtype *ck, realtype *est, - realtype *terk, realtype *terkm1, realtype *erkm1) -{ - int retval; - realtype enorm; - realtype terkm2; - realtype erk, erkm2; - - /* Compute error for order k. */ - enorm = IDAWrmsNorm(IDA_mem, ee, ewt, suppressalg); - erk = sigma[kk] * enorm; - *terk = (kk+1) * erk; - *est = erk; - knew = kk; - - /* Now compute the errors for orders k-1 and k-2, and decide whether to - reduce the order k to k-1 */ - - if(kk > 1){ - N_VLinearSum(ONE, phi[kk], ONE, ee, delta); - *erkm1 = sigma[kk-1] * IDAWrmsNorm(IDA_mem, delta, ewt, suppressalg); - *terkm1 = kk * *erkm1; - { - if(kk > 2){ - N_VLinearSum(ONE, phi[kk-1], ONE, delta, delta); - erkm2 = sigma[kk-2] * IDAWrmsNorm(IDA_mem, delta, ewt, suppressalg); - terkm2 = (kk-1) * erkm2; - if(MAX(*terkm1, terkm2) > *terk) goto evaltest; - } - - else if(*terkm1 > (HALF * (*terk))) goto evaltest; /* executed for kk=2 only */ - } - /* end of "kk>2" if/else block */ - - knew = kk-1; - *est = *erkm1; - - } /* end kk>1 if block */ - - - evaltest: - retval = IDA_SUCCESS; - - if ((*ck * enorm) > ONE) retval = ERROR_TEST_FAIL; - return(retval); -} - - -/* - * ----------------------------------------------------------------- - * IDAHandleNFlag - * ----------------------------------------------------------------- - * This routine handles failures indicated by the input variable nflag. - * Positive values indicate various recoverable failures while negative - * values indicate nonrecoverable failures. This routine adjusts the - * step size for recoverable failures. - * - * Possible nflag values (input): - * - * --convergence failures-- - * IDA_RES_RECVR > 0 - * IDA_LSOLVE_RECVR > 0 - * IDA_CONSTR_RECVR > 0 - * IDA_NCONV_RECVR > 0 - * IDA_RES_FAIL < 0 - * IDA_LSOLVE_FAIL < 0 - * IDA_LSETUP_FAIL < 0 - * - * --error test failure-- - * ERROR_TEST_FAIL > 0 - * - * Possible kflag values (output): - * - * --recoverable-- - * PREDICT_AGAIN - * - * --nonrecoverable-- - * IDA_CONSTR_FAIL - * IDA_REP_RES_ERR - * IDA_ERR_FAIL - * IDA_CONV_FAIL - * IDA_RES_FAIL - * IDA_LSETUP_FAIL - * IDA_LSOLVE_FAIL - * ----------------------------------------------------------------- - */ - -static int IDAHandleNFlag(IDAMem IDA_mem, int nflag, realtype saved_t, - int *ncfPtr, int *nefPtr, realtype *est) -{ - int j; - int *ncf, *nef; - - ncf = ncfPtr; nef = nefPtr; - phase = 1; - - /* restore tn, phi, and psi */ - tn = saved_t; - for (j = ns; j <= kk; j++) N_VScale(ONE/beta[j], phi[j], phi[j]); - for (j = 1; j <= kk; j++) psi[j-1] = psi[j] - hh; - - /* NLS FAILURE */ - - if (nflag != ERROR_TEST_FAIL) { - - (*ncf)++; ncfn++; - - /* Nonrecoverable failure */ - if (nflag < 0) return(nflag); - - /* If there were too many convergence failures */ - if (*ncf >= maxncf) { - if (nflag == IDA_RES_RECVR) return(IDA_REP_RES_ERR); - if (nflag == IDA_CONSTR_RECVR) return(IDA_CONSTR_FAIL); - return(IDA_CONV_FAIL); - } - - /* Prepare to predict again */ - rr = QUARTER; - hh *= rr; - - } - - /* ERROR TEST FAILURE */ - - else { - - (*nef)++; netf++; - - /* If there were too many error test failures */ - if (*nef >= maxnef) return(IDA_ERR_FAIL); - - /* Prepare to predict again */ - if (*nef == 1){ - /* On first error test failure, keep current order or lower order - by one. Compute new stepsize based on differences of the solution. */ - kk = knew; - - rr = PT9 * RPowerR( TWO*(*est) + PT0001,(-ONE/(kk+1)) ); - rr = MAX(QUARTER, MIN(PT9,rr)); - hh *=rr; /* adjust step size */ - } else if (*nef == 2){ - /* On second error test failure, use current order or decrease order - by one. Reduce stepsize by factor of 1/4. */ - kk = knew; - rr = QUARTER; - hh *= rr; - - } else if (*nef > 2){ - /* On third and subsequent error test failures, set order to 1 and - reduce stepsize h by factor of 1/4. */ - kk = 1; - rr = QUARTER; - hh *= rr; - } - - } /* end of nflag if block */ - - if (nst == 0){ - psi[0] = hh; - N_VScale(rr, phi[1], phi[1]); - } - - return(PREDICT_AGAIN); - -} - -/* - * ----------------------------------------------------------------- - * IDACompleteStep - * ----------------------------------------------------------------- - * This routine completes a successful step. It increments nst, - * saves the stepsize and order used, makes the final selection of - * stepsize and order for the next step, and updates the phi array. - * Its return value is IDA_SUCCESS= 0. - * ----------------------------------------------------------------- - */ - -static int IDACompleteStep(IDAMem IDA_mem, realtype *est, - realtype *terk, realtype *terkm1, realtype *erkm1) -{ - int j, kdiff, action; - realtype terkp1, erkp1, temp, hnew; - - nst++; - kdiff = kk - kused; - kused = kk; - hused = hh; - - if ( (knew == kk-1) || (kk == maxord) ) phase = 1; - - /* For the first few steps, until either a step fails, or the order is - reduced, or the order reaches its maximum, we raise the order and double - the stepsize. During these steps, phase = 0. Thereafter, phase = 1, and - stepsize and order are set by the usual local error algorithm. - - Note that, after the first step, the order is not increased, as not all - of the neccessary information is available yet. - */ - - if (phase == 0) { - - if (nst > 1) { - kk++; - hnew = TWO * hh; - hh = hnew; - } - - } else { - - action = UNSET; - - /* Set action = LOWER/MAINTAIN/RAISE to specify order decision */ - - if (knew == kk-1) {action = LOWER; goto takeaction;} - if (kk == maxord) {action = MAINTAIN; goto takeaction;} - if ( (kk+1 >= ns ) || (kdiff == 1)) {action = MAINTAIN;goto takeaction;} - - /* Estimate the error at order k+1, unless already decided to - reduce order, or already using maximum order, or stepsize has not - been constant, or order was just raised. */ - - N_VLinearSum (ONE, ee, -ONE, phi[kk+1], delta); - terkp1 = IDAWrmsNorm(IDA_mem, delta, ewt, suppressalg); - erkp1= terkp1/(kk+2); - - /* Choose among orders k-1, k, k+1 using local truncation error norms. */ - - if (kk == 1) { - if (terkp1 >= HALF * (*terk)) {action = MAINTAIN; goto takeaction;} - else {action = RAISE; goto takeaction;} - } - else { - if (*terkm1 <= MIN(*terk, terkp1)) {action = LOWER; goto takeaction;} - if (terkp1 >= *terk) {action = MAINTAIN; goto takeaction;} - action = RAISE; - goto takeaction; - } - - takeaction: - - /* On change of order, reset kk and the estimated error norm. */ - - if (action == RAISE) { kk++; *est = erkp1;} - else if (action == LOWER) { kk--; *est = *erkm1;} - - /* Compute rr = tentative ratio hnew/hh from error norm. - Reduce hh if rr <= 1, double hh if rr >= 2, else leave hh as is. - If hh is reduced, hnew/hh is restricted to be between .5 and .9. */ - - hnew = hh; - rr = RPowerR( (TWO * (*est) + PT0001) , (-ONE/(kk+1) ) ); - - if (rr >= TWO) { - hnew = TWO * hh; - if( (temp = ABS(hnew)*hmax_inv) > ONE ) hnew /= temp; - } - else if (rr <= ONE ) { - rr = MAX(HALF, MIN(PT9,rr)); - hnew = hh * rr; - } - - hh = hnew; - - } /* end of phase if block */ - - /* Save ee for possible order increase on next step; update phi array. */ - - if (kused < maxord) N_VScale(ONE, ee, phi[kused+1]); - - N_VLinearSum(ONE, ee, ONE, phi[kused], phi[kused]); - for (j= kused-1; j>=0; j--) - N_VLinearSum(ONE, phi[j], ONE, phi[j+1], phi[j]); - - return (IDA_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * IDAWrmsNorm - * ----------------------------------------------------------------- - * Returns the WRMS norm of vector x with weights w. - * If mask = TRUE, the weight vector w is masked by id, i.e., - * nrm = N_VWrmsNormMask(x,w,id); - * Otherwise, - * nrm = N_VWrmsNorm(x,w); - * - * mask = FALSE when the call is made from the nonlinear solver. - * mask = suppressalg otherwise. - * ----------------------------------------------------------------- -*/ - -realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w, - booleantype mask) -{ - realtype nrm; - - if (mask) nrm = N_VWrmsNormMask(x, w, id); - else nrm = N_VWrmsNorm(x, w); - - return(nrm); -} - diff --git a/src/sundials/ida/ida.h b/src/sundials/ida/ida.h deleted file mode 100644 index e37de0d841..0000000000 --- a/src/sundials/ida/ida.h +++ /dev/null @@ -1,880 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmers: Allan G. Taylor, Alan C. Hindmarsh, and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California - * Produced at the Lawrence Livermore National Laboratory - * All rights reserved - * For details, see sundials/ida/LICENSE - * ----------------------------------------------------------------- - * This is the header (include) file for the main IDA solver. - * ----------------------------------------------------------------- - */ - -#ifndef _IDA_H -#define _IDA_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include -#include "sundialstypes.h" -#include "nvector.h" - -/* - * ----------------------------------------------------------------- - * IDA is used to solve numerically the initial value problem - * for the differential algebraic equation (DAE) system - * F(t,y,y') = 0, - * given initial conditions - * y(t0) = y0, y'(t0) = yp0. - * Here y and F are vectors of length N. - * ----------------------------------------------------------------- - */ - -/* - * ---------------------------------------------------------------- - * Type : IDAResFn - * ---------------------------------------------------------------- - * The F function which defines the DAE system F(t,y,y')=0 - * must have type IDAResFn. - * Symbols are as follows: - * t <-> t y <-> yy - * y' <-> yp F <-> rr - * A IDAResFn takes as input the independent variable value t, - * the dependent variable vector yy, and the derivative (with - * respect to t) of the yy vector, yp. It stores the result of - * F(t,y,y') in the vector rr. The yy, yp, and rr arguments are of - * type N_Vector. The res_data parameter is the pointer res_data - * passed by the user to the IDASetRdata routine. This user-supplied - * pointer is passed to the user's res function every time it is called, - * to provide access in res to user data. - * - * A IDAResFn res should return a value of 0 if successful, a positive - * value if a recoverable error occured (e.g. yy has an illegal value), - * or a negative value if a nonrecoverable error occured. In the latter - * case, the program halts. If a recoverable error occured, the integrator - * will attempt to correct and retry. - * ---------------------------------------------------------------- - */ - -typedef int (*IDAResFn)(realtype tt, - N_Vector yy, N_Vector yp, N_Vector rr, - void *res_data); - -/* - * ---------------------------------------------------------------- - * Inputs to IDAMalloc, IDAReInit, IDACalcIC, and IDASolve. - * ---------------------------------------------------------------- - */ - -/* itol */ -#define IDA_SS 1 -#define IDA_SV 2 - -/* itask */ -#define IDA_NORMAL 1 -#define IDA_ONE_STEP 2 -#define IDA_NORMAL_TSTOP 3 -#define IDA_ONE_STEP_TSTOP 4 - -/* icopt */ -#define IDA_YA_YDP_INIT 1 -#define IDA_Y_INIT 2 - -/* - * ================================================================ - * U S E R - C A L L A B L E R O U T I N E S - * ================================================================ - */ - -/* - * ---------------------------------------------------------------- - * Function : IDACreate - * ---------------------------------------------------------------- - * IDACreate creates an internal memory block for a problem to - * be solved by IDA. - * - * If successful, IDACreate returns a pointer to initialized - * problem memory. This pointer should be passed to IDAMalloc. - * If an initialization error occurs, IDACreate prints an error - * message to standard err and returns NULL. - * - * ---------------------------------------------------------------- - */ - -void *IDACreate(void); - -/* - * ---------------------------------------------------------------- - * Integrator optional input specification functions - * ---------------------------------------------------------------- - * The following functions can be called to set optional inputs - * to values other than the defaults given below: - * - * | - * Function | Optional input / [ default value ] - * | - * ---------------------------------------------------------------- - * | - * IDASetRdata | a pointer to user data that will be - * | passed to the user's res function every - * | time res is called. - * | [NULL] - * | - * IDASetErrFile | the file pointer for an error file - * | where all IDA warning and error - * | messages will be written. This parameter - * | can be stdout (standard output), stderr - * | (standard error), a file pointer - * | (corresponding to a user error file - * | opened for writing) returned by fopen. - * | If not called, then all messages will - * | be written to standard output. - * | [NULL] - * | - * IDASetMaxOrd | maximum lmm order to be used by the - * | solver. - * | [5] - * | - * IDASetMaxNumSteps | maximum number of internal steps to be - * | taken by the solver in its attempt to - * | reach tout. - * | [500] - * | - * IDASetInitStep | initial step size. - * | [estimated by IDA] - * | - * IDASetMaxStep | maximum absolute value of step size - * | allowed. - * | [infinity] - * | - * IDASetStopTime | the independent variable value past - * | which the solution is not to proceed. - * | [infinity] - * | - * IDASetNonlinConvCoef | Newton convergence test constant - * | for use during integration. - * | [0.33] - * | - * IDASetMaxErrTestFails| Maximum number of error test failures - * | in attempting one step. - * | [10] - * | - * IDASetMaxNonlinIters | Maximum number of nonlinear solver - * | iterations at one solution. - * | [4] - * | - * IDASetMaxConvFails | Maximum number of allowable conv. - * | failures in attempting one step. - * | [10] - * | - * IDASetSuppressAlg | flag to indicate whether or not to - * | suppress algebraic variables in the - * | local error tests: - * | FALSE = do not suppress; - * | TRUE = do suppress; - * | [FALSE] - * | NOTE: if suppressed algebraic variables - * | is selected, the nvector 'id' must be - * | supplied for identification of those - * | algebraic components (see IDASetId). - * | - * IDASetId | an N_Vector, which states a given - * | element to be either algebraic or - * | differential. - * | A value of 1.0 indicates a differential - * | variable while a 0.0 indicates an - * | algebraic variable. 'id' is required - * | if optional input SUPPRESSALG is set, - * | or if IDACalcIC is to be called with - * | icopt = IDA_YA_YDP_INIT. - * | - * IDASetConstraints | an N_Vector defining inequality - * | constraints for each component of the - * | solution vector y. If a given element - * | of this vector has values +2 or -2, - * | then the corresponding component of y - * | will be constrained to be > 0.0 or - * | <0.0, respectively, while if it is +1 - * | or -1, the y component is constrained - * | to be >= 0.0 or <= 0.0, respectively. - * | If a component of constraints is 0.0, - * | then no constraint is imposed on the - * | corresponding component of y. - * | The presence of a non-NULL constraints - * | vector that is not 0.0 (ZERO) in all - * | components will cause constraint - * | checking to be performed. - * | - * ----------------------------------------------------------------- - * | - * IDASetTolerances | Changes the integration tolerances - * | between calls to IDASolve(). - * | [set by IDAMalloc/IDAReInit] - * | - * ---------------------------------------------------------------- - * Return flag: - * IDA_SUCCESS if successful - * IDA_MEM_NULL if the ida memory is NULL - * IDA_ILL_INPUT if an argument has an illegal value - * - * ---------------------------------------------------------------- - */ - -int IDASetRdata(void *ida_mem, void *res_data); -int IDASetErrFile(void *ida_mem, FILE *errfp); -int IDASetMaxOrd(void *ida_mem, int maxord); -int IDASetMaxNumSteps(void *ida_mem, long int mxsteps); -int IDASetInitStep(void *ida_mem, realtype hin); -int IDASetMaxStep(void *ida_mem, realtype hmax); -int IDASetStopTime(void *ida_mem, realtype tstop); -int IDASetNonlinConvCoef(void *ida_mem, realtype epcon); -int IDASetMaxErrTestFails(void *ida_mem, int maxnef); -int IDASetMaxNonlinIters(void *ida_mem, int maxcor); -int IDASetMaxConvFails(void *ida_mem, int maxncf); -int IDASetSuppressAlg(void *ida_mem, booleantype suppressalg); -int IDASetId(void *ida_mem, N_Vector id); -int IDASetConstraints(void *ida_mem, N_Vector constraints); - -int IDASetTolerances(void *cvode_mem, int itol, realtype *rtol, void *atol); - -/* - * ---------------------------------------------------------------- - * Function : IDAMalloc - * ---------------------------------------------------------------- - * IDAMalloc allocates and initializes memory for a problem to - * to be solved by IDA. - * - * res is the residual function F in F(t,y,y') = 0. - * - * t0 is the initial value of t, the independent variable. - * - * yy0 is the initial condition vector y(t0). - * - * yp0 is the initial condition vector y'(t0) - * - * itol is the type of tolerances to be used. - * The legal values are: - * SS (scalar relative and absolute tolerances), - * SV (scalar relative tolerance and vector - * absolute tolerance). - * - * rtol is a pointer to the relative tolerance scalar. - * - * atol is a pointer (void) to the absolute tolerance scalar or - * an N_Vector tolerance. - * (ewt) - * Both rtol and atol are used to compute the error weight - * vector, ewt. The error test required of a correction - * delta is that the weighted-RMS norm of delta be less - * than or equal to 1.0. Other convergence tests use the - * same norm. The weighting vector used in this norm is - * ewt. The components of ewt are defined by - * ewt[i] = 1.0/(rtol*yy[i] + atol[i]). Here, yy is the - * current approximate solution. See the routine - * N_VWrmsNorm for the norm used in this error test. - * - * Note: The tolerance values may be changed in between calls to - * IDASolve for the same problem. These values refer to - * (*rtol) and either (*atol), for a scalar absolute - * tolerance, or the components of atol, for a vector - * absolute tolerance. - * - * IDA_SUCCESS if successful - * IDA_MEM_NULL if the ida memory was NULL - * IDA_MEM_FAIL if a memory allocation failed - * IDA_ILL_INPUT f an argument has an illegal value. - * - * ---------------------------------------------------------------- - */ - -int IDAMalloc(void *ida_mem, IDAResFn res, - realtype t0, N_Vector yy0, N_Vector yp0, - int itol, realtype *rtol, void *atol); - -/* - * ---------------------------------------------------------------- - * Function : IDAReInit - * ---------------------------------------------------------------- - * IDAReInit re-initializes IDA for the solution of a problem, - * where a prior call to IDAMalloc has been made. - * IDAReInit performs the same input checking and initializations - * that IDAMalloc does. - * But it does no memory allocation, assuming that the existing - * internal memory is sufficient for the new problem. - * - * The use of IDAReInit requires that the maximum method order, - * maxord, is no larger for the new problem than for the problem - * specified in the last call to IDAMalloc. This condition is - * automatically fulfilled if the default value for maxord is - * specified. - * - * Following the call to IDAReInit, a call to the linear solver - * specification routine is necessary if a different linear solver - * is chosen, but may not be otherwise. If the same linear solver - * is chosen, and there are no changes in its input parameters, - * then no call to that routine is needed. - * - * The first argument to IDAReInit is: - * - * ida_mem = pointer to IDA memory returned by IDACreate. - * - * All the remaining arguments to IDAReInit have names and - * meanings identical to those of IDAMalloc. - * - * The return value of IDAReInit is equal to SUCCESS = 0 if there - * were no errors; otherwise it is a negative int equal to: - * IDA_MEM_NULL indicating ida_mem was NULL, or - * IDA_NO_MALLOC indicating that ida_mem was not allocated. - * IDA_ILL_INPUT indicating an input argument was illegal - * (including an attempt to increase maxord). - * In case of an error return, an error message is also printed. - * ---------------------------------------------------------------- - */ - -int IDAReInit(void *ida_mem, IDAResFn res, - realtype t0, N_Vector yy0, N_Vector yp0, - int itol, realtype *rtol, void *atol); - -/* ---------------------------------------------------------------- - * Initial Conditions optional input specification functions - * ---------------------------------------------------------------- - * The following functions can be called to set optional inputs - * to control the initial conditions calculations. - * - * | - * Function | Optional input / [ default value ] - * | - * -------------------------------------------------------------- - * | - * IDASetNonlinConvCoefIC | positive coeficient in the Newton - * | convergence test. This test uses a - * | weighted RMS norm (with weights - * | defined by the tolerances, as in - * | IDASolve). For new initial value - * | vectors y and y' to be accepted, the - * | norm of J-inverse F(t0,y,y') is - * | required to be less than epiccon, - * | where J is the system Jacobian. - * | [0.01 * 0.33] - * | - * IDASetMaxNumStepsIC | maximum number of values of h allowed - * | when icopt = IDA_YA_YDP_INIT, where - * | h appears in the system Jacobian, - * | J = dF/dy + (1/h)dF/dy'. - * | [5] - * | - * IDASetMaxNumJacsIC | maximum number of values of the - * | approximate Jacobian or preconditioner - * | allowed, when the Newton iterations - * | appear to be slowly converging. - * | [4] - * | - * IDASetMaxNumItersIC | maximum number of Newton iterations - * | allowed in any one attempt to solve - * | the IC problem. - * | [10] - * | - * IDASetLineSearchOffIC | a bool flag to turn off the - * | linesearch algorithm. - * | [FALSE] - * | - * IDASetStepToleranceIC | positive lower bound on the norm of - * | a Newton step. - * | [(unit roundoff)^(2/3) - * - * ---------------------------------------------------------------- - * Return flag: - * IDA_SUCCESS if successful - * IDA_MEM_NULL if the ida memory is NULL - * IDA_ILL_INPUT if an argument has an illegal value - * - * ---------------------------------------------------------------- - */ - -int IDASetNonlinConvCoefIC(void *ida_mem, realtype epiccon); -int IDASetMaxNumStepsIC(void *ida_mem, int maxnh); -int IDASetMaxNumJacsIC(void *ida_mem, int maxnj); -int IDASetMaxNumItersIC(void *ida_mem, int maxnit); -int IDASetLineSearchOffIC(void *ida_mem, booleantype lsoff); -int IDASetStepToleranceIC(void *ida_mem, realtype steptol); - -/* - * ---------------------------------------------------------------- - * Function : IDACalcIC - * ---------------------------------------------------------------- - * IDACalcIC calculates corrected initial conditions for the DAE - * system for a class of index-one problems of semi-implicit form. - * It uses Newton iteration combined with a Linesearch algorithm. - * Calling IDACalcIC is optional. It is only necessary when the - * initial conditions do not solve the given system. I.e., if - * y0 and yp0 are known to satisfy F(t0, y0, yp0) = 0, then - * a call to IDACalcIC is NOT necessary (for index-one problems). - * - * A call to IDACalcIC must be preceded by a successful call to - * IDAMalloc or IDAReInit for the given DAE problem, and by a - * successful call to the linear system solver specification - * routine. - * In addition, IDACalcIC assumes that the vectors y0, yp0, and - * (if relevant) id and constraints that were set through - * IDASetConstraints remain unaltered since that call. - * - * The call to IDACalcIC should precede the call(s) to IDASolve - * for the given problem. - * - * The arguments to IDACalcIC are as follows. The first three -- - * ida_mem, icopt, tout1 -- are required; the others are optional. - * A zero value passed for any optional input specifies that the - * default value is to be used. - * - * IDA_mem is the pointer to IDA memory returned by IDACreate. - * - * icopt is the option of IDACalcIC to be used. - * icopt = IDA_YA_YDP_INIT directs IDACalcIC to compute - * the algebraic components of y and differential - * components of y', given the differential - * components of y. This option requires that the - * N_Vector id was set through a call to IDASetId - * specifying the differential and algebraic - * components. - * icopt = IDA_Y_INIT directs IDACalcIC to compute all - * components of y, given y'. id is not required. - * - * tout1 is the first value of t at which a soluton will be - * requested (from IDASolve). (This is needed here to - * determine the direction of integration and rough scale - * in the independent variable t. - * - * - * IDACalcIC returns an int flag. Its symbolic values and their - * meanings are as follows. (The numerical return values are set - * above in this file.) All unsuccessful returns give a negative - * return value. If IFACalcIC failed, y0 and yp0 contain - * (possibly) altered values, computed during the attempt. - * - * SUCCESS IDACalcIC was successful. The corrected - * initial value vectors are in y0 and yp0. - * - * IDA_MEM_NULL The argument ida_mem was NULL. - * - * IDA_ILL_INPUT One of the input arguments was illegal. - * See printed message. - * - * IDA_LINIT_FAIL The linear solver's init routine failed. - * - * IDA_BAD_EWT Some component of the error weight vector - * is zero (illegal), either for the input - * value of y0 or a corrected value. - * - * IDA_RES_FAIL The user's residual routine returned - * a non-recoverable error flag. - * - * IDA_FIRST_RES_FAIL The user's residual routine returned - * a recoverable error flag on the first call, - * but IDACalcIC was unable to recover. - * - * IDA_LSETUP_FAIL The linear solver's setup routine had a - * non-recoverable error. - * - * IDA_LSOLVE_FAIL The linear solver's solve routine had a - * non-recoverable error. - * - * IDA_NO_RECOVERY The user's residual routine, or the linear - * solver's setup or solve routine had a - * recoverable error, but IDACalcIC was - * unable to recover. - * - * IDA_CONSTR_FAIL IDACalcIC was unable to find a solution - * satisfying the inequality constraints. - * - * IDA_LINESEARCH_FAIL The Linesearch algorithm failed to find a - * solution with a step larger than steptol - * in weighted RMS norm. - * - * IDA_CONV_FAIL IDACalcIC failed to get convergence of the - * Newton iterations. - * - * ---------------------------------------------------------------- - */ - -int IDACalcIC (void *ida_mem, int icopt, realtype tout1); - -/* - * ---------------------------------------------------------------- - * Function : IDASolve - * ---------------------------------------------------------------- - * IDASolve integrates the DAE over an interval in t, the - * independent variable. If itask is NORMAL, then the solver - * integrates from its current internal t value to a point at or - * beyond tout, then interpolates to t = tout and returns y(tret) - * in the user-allocated vector yret. In general, tret = tout. - * If itask is ONE_STEP, then the solver takes one internal step - * of the independent variable and returns in yret the value of y - * at the new internal independent variable value. In this case, - * tout is used only during the first call to IDASolve to - * determine the direction of integration and the rough scale of - * the problem. In either case, the independent variable value - * reached by the solver is placed in (*tret). The user is - * responsible for allocating the memory for this value. - * - * IDA_mem is the pointer (void) to IDA memory returned by - * IDACreate. - * - * tout is the next independent variable value at which a - * computed solution is desired. - * - * *tret is the actual independent variable value corresponding - * to the solution vector yret. - * - * yret is the computed solution vector. With no errors, - * yret = y(tret). - * - * ypret is the derivative of the computed solution at t = tret. - * - * Note: yret and ypret may be the same N_Vectors as y0 and yp0 - * in the call to IDAMalloc or IDAReInit. - * - * itask is NORMAL, NORMAL_TSTOP, ONE_STEP, or ONE_STEP_TSTOP. - * These modes are described above. - * - * - * The return values for IDASolve are described below. - * (The numerical return values are defined above in this file.) - * All unsuccessful returns give a negative return value. - * - * IDA_SUCCESS - * IDASolve succeeded. - * - * IDA_TSTOP_RETURN: - * IDASolve returns computed results for the independent variable - * value tstop. That is, tstop was reached. - * - * IDA_MEM_NULL: - * The IDA_mem argument was NULL. - * - * IDA_ILL_INPUT: - * One of the inputs to IDASolve is illegal. This includes the - * situation when a component of the error weight vectors - * becomes < 0 during internal stepping. The ILL_INPUT flag - * will also be returned if the linear solver function IDA - * (called by the user after calling IDACreate) failed to set one - * of the linear solver-related fields in IDA_mem or if the linear - * solver's init routine failed. In any case, the user should see - * the printed error message for more details. - * - * IDA_TOO_MUCH_WORK: - * The solver took mxstep internal steps but could not reach tout. - * The default value for mxstep is MXSTEP_DEFAULT = 500. - * - * IDA_TOO_MUCH_ACC: - * The solver could not satisfy the accuracy demanded by the user - * for some internal step. - * - * IDA_ERR_FAIL: - * Error test failures occurred too many times (=MXETF = 10) during - * one internal step. - * - * IDA_CONV_FAIL: - * Convergence test failures occurred too many times (= MXNCF = 10) - * during one internal step. - * - * IDA_LSETUP_FAIL: - * The linear solver's setup routine failed - * in an unrecoverable manner. - * - * IDA_LSOLVE_FAIL: - * The linear solver's solve routine failed - * in an unrecoverable manner. - * - * IDA_CONSTR_FAIL: - * The inequality constraints were violated, - * and the solver was unable to recover. - * - * IDA_REP_RES_ERR: - * The user's residual function repeatedly returned a recoverable - * error flag, but the solver was unable to recover. - * - * IDA_RES_FAIL: - * The user's residual function returned a nonrecoverable error - * flag. - * - * ---------------------------------------------------------------- - */ - -int IDASolve(void *ida_mem, realtype tout, realtype *tret, - N_Vector yret, N_Vector ypret, int itask); - -/* - * ---------------------------------------------------------------- - * Function: IDAGetSolution - * ---------------------------------------------------------------- - * - * This routine evaluates y(t) and y'(t) as the value and - * derivative of the interpolating polynomial at the independent - * variable t, and stores the results in the vectors yret and - * ypret. It uses the current independent variable value, tn, - * and the method order last used, kused. This function is - * called by IDASolve with t = tout, t = tn, or t = tstop. - * - * If kused = 0 (no step has been taken), or if t = tn, then the - * order used here is taken to be 1, giving yret = phi[0], - * ypret = phi[1]/psi[0]. - * - * The return values are: - * IDA_SUCCESS: succeess. - * IDA_BAD_T: t is not in the interval [tn-hu,tn]. - * IDA_MEM_NULL: The ida_mem argument was NULL. - * - * ---------------------------------------------------------------- - */ - -int IDAGetSolution(void *ida_mem, realtype t, - N_Vector yret, N_Vector ypret); - -/* ---------------------------------------------------------------- - * Integrator optional output extraction functions - * ---------------------------------------------------------------- - * - * The following functions can be called to get optional outputs - * and statistics related to the main integrator. - * ---------------------------------------------------------------- - * - * IDAGetWorkSpace returns the IDA real and integer workspace sizes - * IDAGetNumSteps returns the cumulative number of internal - * steps taken by the solver - * IDAGetNumRhsEvals returns the number of calls to the user's - * res function - * IDAGetNumLinSolvSetups returns the number of calls made to - * the linear solver's setup routine - * IDAGetNumErrTestFails returns the number of local error test - * failures that have occured - * IDAGetNumBacktrackOps returns the number of backtrack - * operations done in the linesearch algorithm in IDACalcIC - * IDAGetLastOrder returns the order used during the last - * internal step - * IDAGetCurentOrder returns the order to be used on the next - * internal step - * IDAGetActualInitStep returns the actual initial step size - * used by IDA - * IDAGetLAstStep returns the step size for the last internal - * step (if from IDASolve), or the last value of the - * artificial step size h (if from IDACalcIC) - * IDAGetCurrentStep returns the step size to be attempted on the - * next internal step - * IDAGetCurrentTime returns the current internal time reached - * by the solver - * IDAGetTolScaleFactor returns a suggested factor by which the - * user's tolerances should be scaled when too much - * accuracy has been requested for some internal step - * IDAGetErrWeights returns the state error weight vector. - * The user need not allocate space for ewt. - * IDAGetEstLocalErrors returns the vector of estimated local - * errors. The user need not allocate space for ele. - * - * IDAGet* return values: - * IDA_SUCCESS if succesful - * IDA_MEM_NULL if the ida memory was NULL - * - * ---------------------------------------------------------------- - */ - -int IDAGetWorkSpace(void *ida_mem, long int *lenrw, long int *leniw); -int IDAGetNumSteps(void *ida_mem, long int *nsteps); -int IDAGetNumResEvals(void *ida_mem, long int *nrevals); -int IDAGetNumLinSolvSetups(void *ida_mem, long int *nlinsetups); -int IDAGetNumErrTestFails(void *ida_mem, long int *netfails); -int IDAGetNumBacktrackOps(void *ida_mem, long int *nbacktr); -int IDAGetLastOrder(void *ida_mem, int *klast); -int IDAGetCurrentOrder(void *ida_mem, int *kcur); -int IDAGetActualInitStep(void *ida_mem, realtype *hinused); -int IDAGetLastStep(void *ida_mem, realtype *hlast); -int IDAGetCurrentStep(void *ida_mem, realtype *hcur); -int IDAGetCurrentTime(void *ida_mem, realtype *tcur); -int IDAGetTolScaleFactor(void *ida_mem, realtype *tolsfact); -int IDAGetErrWeights(void *ida_mem, N_Vector *eweight); - -int IDAGetIntegratorStats(void *ida_mem, long int *nsteps, - long int *nrevals, long int *nlinsetups, - long int *netfails, int *qlast, int *qcur, - realtype *hlast, realtype *hcur, - realtype *tcur); - -/* - * ---------------------------------------------------------------- - * Nonlinear solver optional output extraction functions - * ---------------------------------------------------------------- - * - * The following functions can be called to get optional outputs - * and statistics related to the nonlinear solver. - * -------------------------------------------------------------- - * - * IDAGetNumNonlinSolvIters returns the number of nonlinear - * solver iterations performed. - * IDAGetNumNonlinSolvConvFails returns the number of nonlinear - * convergence failures. - * - * ---------------------------------------------------------------- - */ - -int IDAGetNumNonlinSolvIters(void *ida_mem, long int *nniters); -int IDAGetNumNonlinSolvConvFails(void *ida_mem, long int *nncfails); - -/* - * ---------------------------------------------------------------- - * As a convenience, the following function provides the - * optional outputs in a group. - * ---------------------------------------------------------------- - */ - -int IDAGetNonlinSolvStats(void *ida_mem, long int *nniters, - long int *nncfails); - -/* - * ---------------------------------------------------------------- - * Function : IDAFree - * ---------------------------------------------------------------- - * IDAFree frees the problem memory IDA_mem allocated by - * IDAMalloc. Its only argument is the pointer idamem - * returned by IDAMalloc. - * ---------------------------------------------------------------- - */ - -void IDAFree(void *ida_mem); - -/* - * ---------------------------------------- - * IDA return flags - * ---------------------------------------- - */ - - -#define IDA_SUCCESS 0 -#define IDA_TSTOP_RETURN 1 - -#define IDA_MEM_NULL -1 -#define IDA_ILL_INPUT -2 -#define IDA_NO_MALLOC -3 -#define IDA_TOO_MUCH_WORK -4 -#define IDA_TOO_MUCH_ACC -5 -#define IDA_ERR_FAIL -6 -#define IDA_CONV_FAIL -7 -#define IDA_LINIT_FAIL -8 -#define IDA_LSETUP_FAIL -9 -#define IDA_LSOLVE_FAIL -10 -#define IDA_RES_FAIL -11 -#define IDA_CONSTR_FAIL -12 -#define IDA_REP_RES_ERR -13 - -#define IDA_MEM_FAIL -14 - -#define IDA_BAD_T -15 - -#define IDA_BAD_EWT -16 -#define IDA_FIRST_RES_FAIL -17 -#define IDA_LINESEARCH_FAIL -18 -#define IDA_NO_RECOVERY -19 - -#define IDA_PDATA_NULL -20 - -/* - * ================================================================= - * I N T E R F A C E T O L I N E A R S O L V E R S - * ================================================================= - */ - -/* - * ----------------------------------------------------------------- - * int (*ida_linit)(IDAMem IDA_mem); - * ----------------------------------------------------------------- - * The purpose of ida_linit is to allocate memory for the - * solver-specific fields in the structure *(idamem->ida_lmem) and - * perform any needed initializations of solver-specific memory, - * such as counters/statistics. An (*ida_linit) should return - * 0 if it has successfully initialized the IDA linear solver and - * a negative value otherwise. If an error does occur, an - * appropriate message should be sent to (idamem->errfp). - * ---------------------------------------------------------------- - */ - -/* - * ----------------------------------------------------------------- - * int (*ida_lsetup)(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, - * N_Vector resp, - * N_Vector tempv1, N_Vector tempv2, N_Vector tempv3); - * ----------------------------------------------------------------- - * The job of ida_lsetup is to prepare the linear solver for - * subsequent calls to ida_lsolve. Its parameters are as follows: - * - * idamem - problem memory pointer of type IDAMem. See the big - * typedef earlier in this file. - * - * - * yyp - the predicted y vector for the current IDA internal - * step. - * - * ypp - the predicted y' vector for the current IDA internal - * step. - * - * resp - F(tn, yyp, ypp). - * - * tempv1, tempv2, tempv3 - temporary N_Vectors provided for use - * by ida_lsetup. - * - * The ida_lsetup routine should return 0 if successful, - * a positive value for a recoverable error, and a negative value - * for an unrecoverable error. - * ----------------------------------------------------------------- - */ - -/* - * ----------------------------------------------------------------- - * int (*ida_lsolve)(IDAMem IDA_mem, N_Vector b, N_Vector weight, - * N_Vector ycur, N_Vector ypcur, N_Vector rescur); - * ----------------------------------------------------------------- - * ida_lsolve must solve the linear equation P x = b, where - * P is some approximation to the system Jacobian - * J = (dF/dy) + cj (dF/dy') - * evaluated at (tn,ycur,ypcur) and the RHS vector b is input. - * The N-vector ycur contains the solver's current approximation - * to y(tn), ypcur contains that for y'(tn), and the vector rescur - * contains the N-vector residual F(tn,ycur,ypcur). - * The solution is to be returned in the vector b. - * - * The ida_lsolve routine should return 0 if successful, - * a positive value for a recoverable error, and a negative value - * for an unrecoverable error. - * ----------------------------------------------------------------- - */ - -/* - * ----------------------------------------------------------------- - * int (*ida_lperf)(IDAMem IDA_mem, int perftask); - * ----------------------------------------------------------------- - * ida_lperf is called two places in IDA where linear solver - * performance data is required by IDA. For perftask = 0, an - * initialization of performance variables is performed, while for - * perftask = 1, the performance is evaluated. - * ----------------------------------------------------------------- - */ - -/* - * ----------------------------------------------------------------- - * int (*ida_lfree)(IDAMem IDA_mem); - * ----------------------------------------------------------------- - * ida_lfree should free up any memory allocated by the linear - * solver. This routine is called once a problem has been - * completed and the linear solver is no longer needed. - * ----------------------------------------------------------------- - */ - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/ida/ida_impl.h b/src/sundials/ida/ida_impl.h deleted file mode 100755 index 748d96edc8..0000000000 --- a/src/sundials/ida/ida_impl.h +++ /dev/null @@ -1,420 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Allan G. Taylor, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/ida/LICENSE. - * ----------------------------------------------------------------- - * This is the header file (private version) for the main IDA solver. - * ----------------------------------------------------------------- - */ - -#ifndef _IDA_IMPL_H -#define _IDA_IMPL_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include - -#include "ida.h" - -#include "sundialstypes.h" -#include "nvector.h" - -/* Basic IDA constants */ - -#define MXORDP1 6 /* max. number of N_Vectors kept in the phi array */ - -/****************************************************************** - * Types : struct IDAMemRec, IDAMem * - *----------------------------------------------------------------* - * The type IDAMem is type pointer to struct IDAMemRec. This * - * structure contains fields to keep track of problem state. * - * * - ******************************************************************/ - -typedef struct IDAMemRec { - - realtype ida_uround; /* machine unit roundoff */ - - /* Problem Specification Data */ - - IDAResFn ida_res; /* F(t,y(t),y'(t))=0; the function F */ - void *ida_rdata; /* user pointer passed to res */ - int ida_itol; /* itol = SS or SV */ - realtype *ida_rtol; /* ptr to relative tolerance */ - void *ida_atol; /* ptr to absolute tolerance */ - booleantype ida_setupNonNull; /* Does setup do something? */ - booleantype ida_constraintsSet; /* constraints vector present: - do constraints calc */ - booleantype ida_suppressalg; /* true means suppress algebraic vars - in local error tests */ - - /* Divided differences array and associated minor arrays */ - - N_Vector ida_phi[MXORDP1]; /* phi = (maxord+1) arrays of divided differences */ - - realtype ida_psi[MXORDP1]; /* differences in t (sums of recent step sizes) */ - realtype ida_alpha[MXORDP1]; /* ratios of current stepsize to psi values */ - realtype ida_beta[MXORDP1]; /* ratios of current to previous product of psi's */ - realtype ida_sigma[MXORDP1]; /* product successive alpha values and factorial */ - realtype ida_gamma[MXORDP1]; /* sum of reciprocals of psi values */ - - /* N_Vectors */ - - N_Vector ida_ewt; /* error weight vector */ - N_Vector ida_y0; /* initial y vector (user-supplied) */ - N_Vector ida_yp0; /* initial y' vector (user-supplied) */ - N_Vector ida_yy; /* work space for y vector (= user's yret) */ - N_Vector ida_yp; /* work space for y' vector (= user's ypret) */ - N_Vector ida_delta; /* residual vector */ - N_Vector ida_id; /* bit vector for diff./algebraic components */ - N_Vector ida_constraints; /* vector of inequality constraint options */ - N_Vector ida_savres; /* saved residual vector (= tempv1) */ - N_Vector ida_ee; /* accumulated corrections to y */ - N_Vector ida_mm; /* mask vector in constraints tests (= tempv2) */ - N_Vector ida_tempv1; /* work space vector */ - N_Vector ida_tempv2; /* work space vector */ - N_Vector ida_ynew; /* work vector for y in IDACalcIC (= tempv2) */ - N_Vector ida_ypnew; /* work vector for yp in IDACalcIC (= ee) */ - N_Vector ida_delnew; /* work vector for delta in IDACalcIC (= phi[2]) */ - N_Vector ida_dtemp; /* work vector in IDACalcIC (= phi[3]) */ - - /* Scalars for use by IDACalcIC*/ - - int ida_icopt; /* IC calculation user option */ - booleantype ida_lsoff; /* IC calculation linesearch turnoff option */ - int ida_maxnh; /* max. number of h tries in IC calculation */ - int ida_maxnj; /* max. number of J tries in IC calculation */ - int ida_maxnit; /* max. number of Netwon iterations in IC calc. */ - int ida_nbacktr; /* number of IC linesearch backtrack operations */ - int ida_sysindex; /* computed system index (0 or 1) */ - realtype ida_epiccon; /* IC nonlinear convergence test constant */ - realtype ida_steptol; /* minimum Newton step size in IC calculation */ - realtype ida_tscale; /* time scale factor = abs(tout1 - t0) */ - - /* Tstop information */ - - booleantype ida_tstopset; - realtype ida_tstop; - - /* Step Data */ - - int ida_kk; /* current BDF method order */ - int ida_kused; /* method order used on last successful step */ - int ida_knew; /* order for next step from order decrease decision */ - int ida_phase; /* flag to trigger step doubling in first few steps */ - int ida_ns; /* counts steps at fixed stepsize and order */ - - realtype ida_hin; /* initial step */ - realtype ida_h0u; /* actual initial stepsize */ - realtype ida_hh; /* current step size h */ - realtype ida_hused; /* step size used on last successful step */ - realtype ida_rr; /* rr = hnext / hused */ - realtype ida_tn; /* current internal value of t */ - realtype ida_tretp; /* value of tret previously returned by IDASolve */ - realtype ida_cj; /* current value of scalar (-alphas/hh) in Jacobian */ - realtype ida_cjlast; /* cj value saved from last successful step */ - realtype ida_cjold; /* cj value saved from last call to lsetup */ - realtype ida_cjratio; /* ratio of cj values: cj/cjold */ - realtype ida_ss; /* scalar used in Newton iteration convergence test */ - realtype ida_epsNewt; /* test constant in Newton convergence test */ - realtype ida_epcon; /* coeficient of the Newton covergence test */ - realtype ida_toldel; /* tolerance in direct test on Newton corrections */ - - /* Limits */ - - int ida_maxncf; /* max numer of convergence failures */ - int ida_maxcor; /* max number of Newton corrections */ - int ida_maxnef; /* max number of error test failures */ - - int ida_maxord; /* max value of method order k: */ - long int ida_mxstep; /* max number of internal steps for one user call */ - realtype ida_hmax_inv; /* inverse of max. step size hmax (default = 0.0) */ - - /* Counters */ - - long int ida_nst; /* number of internal steps taken */ - long int ida_nre; /* number of function (res) calls */ - long int ida_ncfn; /* number of corrector convergence failures */ - long int ida_netf; /* number of error test failures */ - long int ida_nni; /* number of Newton iterations performed */ - long int ida_nsetups; /* number of lsetup calls */ - - /* Space requirements for IDA */ - - long int ida_lrw1; /* no. of realtype words in 1 N_Vector */ - long int ida_liw1; /* no. of integer words in 1 N_Vector */ - long int ida_lrw; /* number of realtype words in IDA work vectors */ - long int ida_liw; /* no. of integer words in IDA work vectors */ - - realtype ida_tolsf; /* tolerance scale factor (saved value) */ - - FILE *ida_errfp; /* IDA error messages are sent to errfp */ - - /* Flags to verify correct calling sequence */ - - booleantype ida_SetupDone; /* set to FALSE by IDAMalloc and IDAReInit */ - /* set to TRUE by IDACalcIC or IDASolve */ - - booleantype ida_MallocDone; /* set to FALSE by IDACreate */ - /* set to TRUE by IDAMAlloc */ - /* tested by IDAReInit and IDASolve */ - - /* Linear Solver Data */ - - /* Linear Solver functions to be called */ - - int (*ida_linit)(struct IDAMemRec *idamem); - - int (*ida_lsetup)(struct IDAMemRec *idamem, N_Vector yyp, - N_Vector ypp, N_Vector resp, - N_Vector tempv1, N_Vector tempv2, N_Vector tempv3); - - int (*ida_lsolve)(struct IDAMemRec *idamem, N_Vector b, N_Vector weight, - N_Vector ycur, N_Vector ypcur, N_Vector rescur); - - int (*ida_lperf)(struct IDAMemRec *idamem, int perftask); - - int (*ida_lfree)(struct IDAMemRec *idamem); - - /* Linear Solver specific memory */ - - void *ida_lmem; - - /* Flag to indicate successful ida_linit call */ - - booleantype ida_linitOK; - -} *IDAMem; - - -/* - *---------------------------------------------------------------- - * IDA Error Messages - *---------------------------------------------------------------- - */ - -#if defined(SUNDIALS_EXTENDED_PRECISION) - -#define MSG_TIME "at t = %Lg, " -#define MSG_TIME_H "at t = %Lg and h = %Lg, " -#define MSG_TIME_INT "t is not between tcur - hu = %Lg and tcur = %Lg.\n\n" -#define MSG_TIME_TOUT "tout = %Lg" - -#elif defined(SUNDIALS_DOUBLE_PRECISION) - -#define MSG_TIME "at t = %lg, " -#define MSG_TIME_H "at t = %lg and h = %lg, " -#define MSG_TIME_INT "t is not between tcur - hu = %lg and tcur = %lg.\n\n" -#define MSG_TIME_TOUT "tout = %lg" - -#else - -#define MSG_TIME "at t = %g, " -#define MSG_TIME_H "at t = %g and h = %g, " -#define MSG_TIME_INT "t is not between tcur - hu = %g and tcur = %g.\n\n" -#define MSG_TIME_TOUT "tout = %g" - -#endif - -/* IDACreate error messages */ - -#define MSG_IDAMEM_FAIL "IDACreate-- allocation of ida_mem failed. \n\n" - -/* IDAMalloc/IDAReInit error messages */ - -#define _IDAM_ "IDAMalloc/IDAReInit-- " - -#define MSG_IDAM_NO_MEM _IDAM_ "ida_mem = NULL illegal.\n\n" - -#define MSG_Y0_NULL _IDAM_ "y0 = NULL illegal.\n\n" -#define MSG_YP0_NULL _IDAM_ "yp0 = NULL illegal.\n\n" - -#define MSG_BAD_ITOL _IDAM_ "itol has an illegal value.\n" - -#define MSG_RES_NULL _IDAM_ "res = NULL illegal.\n\n" - -#define MSG_RTOL_NULL _IDAM_ "reltol = NULL illegal.\n\n" - -#define MSG_BAD_RTOL _IDAM_ "*reltol < 0 illegal.\n\n" - -#define MSG_ATOL_NULL _IDAM_ "abstol = NULL illegal.\n\n" - -#define MSG_BAD_ATOL _IDAM_ "some abstol component < 0.0 illegal.\n\n" - -#define MSG_BAD_NVECTOR _IDAM_ "a required vector operation is not implemented.\n\n" - -#define MSG_MEM_FAIL _IDAM_ "a memory request failed.\n\n" - -#define MSG_REI_NO_MALLOC "IDAReInit-- attempt to call before IDAMalloc. \n\n" - -/* IDAInitialSetup error messages -- called from IDACalcIC or IDASolve */ - -#define _IDAIS_ "Initial setup-- " - -#define MSG_MISSING_ID _IDAIS_ "id = NULL but suppressalg option on.\n\n" - -#define MSG_BAD_EWT _IDAIS_ "some initial ewt component = 0.0 illegal.\n\n" - -#define MSG_BAD_CONSTRAINTS _IDAIS_ "illegal values in constraints vector.\n\n" - -#define MSG_Y0_FAIL_CONSTR _IDAIS_ "y0 fails to satisfy constraints.\n\n" - -#define MSG_LSOLVE_NULL _IDAIS_ "the linear solver's solve routine is NULL.\n\n" - -#define MSG_LINIT_FAIL _IDAIS_ "the linear solver's init routine failed.\n\n" - -/* IDASolve error messages */ - -#define _IDASLV_ "IDASolve-- " - -#define MSG_IDA_NO_MEM _IDASLV_ "ida_mem = NULL illegal.\n\n" - -#define MSG_NO_MALLOC _IDASLV_ "attempt to call before IDAMalloc. \n\n" - -#define MSG_BAD_HINIT _IDASLV_ "initial step is not towards tout.\n\n" - -#define MSG_BAD_TOUT1 _IDASLV_ "trouble interpolating at " MSG_TIME_TOUT ".\n" -#define MSG_BAD_TOUT2 "tout too far back in direction of integration.\n\n" -#define MSG_BAD_TOUT MSG_BAD_TOUT1 MSG_BAD_TOUT2 - -#define MSG_BAD_TSTOP _IDASLV_ MSG_TIME "tstop is behind.\n\n" - -#define MSG_MAX_STEPS _IDASLV_ MSG_TIME "maximum number of steps reached.\n\n" - -#define MSG_EWT_NOW_BAD _IDASLV_ MSG_TIME "some ewt component has become <= 0.0.\n\n" - -#define MSG_TOO_MUCH_ACC _IDASLV_ MSG_TIME "too much accuracy requested.\n\n" - -#define MSG_ERR_FAILS1 "the error test\nfailed repeatedly or with |h| = hmin.\n\n" -#define MSG_ERR_FAILS _IDASLV_ MSG_TIME_H MSG_ERR_FAILS1 - -#define MSG_CONV_FAILS1 "the corrector convergence\nfailed repeatedly.\n\n" -#define MSG_CONV_FAILS _IDASLV_ MSG_TIME_H MSG_CONV_FAILS1 - -#define MSG_SETUP_FAILED1 "the linear solver setup failed unrecoverably.\n\n" -#define MSG_SETUP_FAILED _IDASLV_ MSG_TIME MSG_SETUP_FAILED1 - -#define MSG_SOLVE_FAILED1 "the linear solver solve failed unrecoverably.\n\n" -#define MSG_SOLVE_FAILED _IDASLV_ MSG_TIME MSG_SOLVE_FAILED1 - -#define MSG_TOO_CLOSE _IDASLV_ "tout too close to t0 to start integration.\n\n" - -#define MSG_YRET_NULL _IDASLV_ "yret = NULL illegal.\n\n" -#define MSG_YPRET_NULL _IDASLV_ "ypret = NULL illegal.\n\n" -#define MSG_TRET_NULL _IDASLV_ "tret = NULL illegal.\n\n" - -#define MSG_BAD_ITASK _IDASLV_ "itask has an illegal value.\n\n" - -#define MSG_NO_TSTOP _IDASLV_ "tstop not set for this itask. \n\n" - -#define MSG_REP_RES_ERR1 "repeated recoverable residual errors.\n\n" -#define MSG_REP_RES_ERR _IDASLV_ MSG_TIME MSG_REP_RES_ERR1 - -#define MSG_RES_NONRECOV1 "the residual function failed unrecoverably. \n\n" -#define MSG_RES_NONRECOV _IDASLV_ MSG_TIME MSG_RES_NONRECOV1 - -#define MSG_FAILED_CONSTR1 "unable to satisfy inequality constraints. \n\n" -#define MSG_FAILED_CONSTR _IDASLV_ MSG_TIME MSG_FAILED_CONSTR1 - -/* IDACalcIC error messages */ - -#define _IDAIC_ "IDACalcIC-- " - -#define MSG_IC_NO_MEM _IDAIC_ "IDA_mem = NULL illegal.\n\n" - -#define MSG_IC_NO_MALLOC _IDAIC_ "attempt to call before IDAMalloc. \n\n" - -#define MSG_IC_BAD_ICOPT _IDAIC_ "icopt has an illegal value.\n\n" - -#define MSG_IC_MISSING_ID _IDAIC_ "id = NULL conflicts with icopt.\n\n" - -#define MSG_IC_BAD_ID _IDAIC_ "id has illegal values.\n\n" - -#define MSG_IC_TOO_CLOSE1 _IDAIC_ "tout1 too close to t0 to attempt " -#define MSG_IC_TOO_CLOSE2 "initial condition calculation.\n\n" -#define MSG_IC_TOO_CLOSE MSG_IC_TOO_CLOSE1 MSG_IC_TOO_CLOSE2 - -#define MSG_IC_BAD_EWT _IDAIC_ "some ewt component = 0.0 illegal.\n\n" - -#define MSG_IC_RES_NONR1 "the residual function failed unrecoverably. \n\n" -#define MSG_IC_RES_NONREC _IDAIC_ MSG_IC_RES_NONR1 - -#define MSG_IC_RES_FAIL1 "the residual function failed at the first call. \n\n" -#define MSG_IC_RES_FAIL _IDAIC_ MSG_IC_RES_FAIL1 - -#define MSG_IC_SETUP_FAIL1 "the linear solver setup failed unrecoverably.\n\n" -#define MSG_IC_SETUP_FAIL _IDAIC_ MSG_IC_SETUP_FAIL1 - -#define MSG_IC_SOLVE_FAIL1 "the linear solver solve failed unrecoverably.\n\n" -#define MSG_IC_SOLVE_FAIL _IDAIC_ MSG_IC_SOLVE_FAIL1 - -#define MSG_IC_NO_RECOV1 _IDAIC_ "The residual routine or the linear" -#define MSG_IC_NO_RECOV2 " setup or solve routine had a recoverable" -#define MSG_IC_NO_RECOV3 " error, but IDACalcIC was unable to recover.\n\n" -#define MSG_IC_NO_RECOVERY MSG_IC_NO_RECOV1 MSG_IC_NO_RECOV2 MSG_IC_NO_RECOV3 - -#define MSG_IC_FAIL_CON1 "Unable to satisfy the inequality constraints.\n\n" -#define MSG_IC_FAIL_CONSTR _IDAIC_ MSG_IC_FAIL_CON1 - -#define MSG_IC_FAILED_LS1 "the linesearch algorithm failed with too small a step.\n\n" -#define MSG_IC_FAILED_LINS _IDAIC_ MSG_IC_FAILED_LS1 - -#define MSG_IC_CONV_FAIL1 "Newton/Linesearch algorithm failed to converge.\n\n" -#define MSG_IC_CONV_FAILED _IDAIC_ MSG_IC_CONV_FAIL1 - -/* IDASet* error messages */ - -#define MSG_IDAS_NO_MEM "IDASet*-- ida_mem = NULL illegal. \n\n" - -#define MSG_IDAS_NEG_MAXORD "IDASetMaxOrd-- maxord<=0 illegal. \n\n" - -#define MSG_IDAS_BAD_MAXORD "IDASetMaxOrd-- illegal to increase maximum order.\n\n" - -#define MSG_IDAS_NEG_MXSTEPS "IDASetMaxNumSteps-- mxsteps <= 0 illegal. \n\n" - -#define MSG_IDAS_NEG_HMAX "IDASetMaxStep-- hmax <= 0 illegal. \n\n" - -#define MSG_IDAS_NEG_EPCON "IDASetNonlinConvCoef-- epcon < 0.0 illegal. \n\n" - -#define MSG_IDAS_BAD_ITOL "IDASetTolerances-- itol has an illegal value.\n\n" - -#define MSG_IDAS_RTOL_NULL "IDASetTolerances-- rtol = NULL illegal.\n\n" - -#define MSG_IDAS_BAD_RTOL "IDASetTolerances-- *rtol < 0 illegal.\n\n" - -#define MSG_IDAS_ATOL_NULL "IDASetTolerances-- atol = NULL illegal.\n\n" - -#define MSG_IDAS_BAD_ATOL "IDASetTolerances-- some atol component < 0.0 illegal.\n\n" - -#define MSG_IDAS_BAD_EPICCON "IDASetNonlinConvCoefIC-- epiccon < 0.0 illegal.\n\n" - -#define MSG_IDAS_BAD_MAXNH "IDASetMaxNumStepsIC-- maxnh < 0 illegal.\n\n" - -#define MSG_IDAS_BAD_MAXNJ "IDASetMaxNumJacsIC-- maxnj < 0 illegal.\n\n" - -#define MSG_IDAS_BAD_MAXNIT "IDASetMaxNumItersIC-- maxnit < 0 illegal.\n\n" - -#define MSG_IDAS_BAD_STEPTOL "IDASetLineSearchOffIC-- steptol < 0.0 illegal.\n\n" - -/* IDAGet* Error Messages */ - -#define MSG_IDAG_NO_MEM "IDAGet*-- ida_mem = NULL illegal. \n\n" - -#define MSG_IDAG_BAD_T1 "IDAGetSolution-- " -#define MSG_IDAG_BAD_T MSG_IDAG_BAD_T1 MSG_TIME MSG_TIME_INT - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/ida/idaband.c b/src/sundials/ida/idaband.c deleted file mode 100755 index d5276af594..0000000000 --- a/src/sundials/ida/idaband.c +++ /dev/null @@ -1,598 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/ida/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for the IDA banded linear - * solver module, IDABAND. This module uses standard banded - * matrix techniques to solve the linear systems generated by the - * (nonlinear) Newton iteration process. The user may either - * supply a banded Jacobian routine or use the routine supplied - * with this module (IDABandDQJac). - * ----------------------------------------------------------------- - */ - -#include -#include -#include - -#include "ida_impl.h" -#include "idaband_impl.h" - -#include "sundialsmath.h" - -/* Constants */ - -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) -#define TWO RCONST(2.0) - -/* IDABAND linit, lsetup, lsolve, and lfree routines */ - -static int IDABandInit(IDAMem IDA_mem); - -static int IDABandSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, - N_Vector rrp, N_Vector tmp1, - N_Vector tmp2, N_Vector tmp3); - -static int IDABandSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, - N_Vector ycur, N_Vector ypcur, N_Vector rrcur); - -static int IDABandFree(IDAMem IDA_mem); - -static int IDABandDQJac(long int Neq, long int mupper, long int mlower, - realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, - realtype c_j, void *jac_data, BandMat Jac, - N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); - -/* Readability Replacements */ - -#define res (IDA_mem->ida_res) -#define rdata (IDA_mem->ida_rdata) -#define uround (IDA_mem->ida_uround) -#define tn (IDA_mem->ida_tn) -#define hh (IDA_mem->ida_hh) -#define cj (IDA_mem->ida_cj) -#define cjratio (IDA_mem->ida_cjratio) -#define ewt (IDA_mem->ida_ewt) -#define constraints (IDA_mem->ida_constraints) -#define nre (IDA_mem->ida_nre) -#define errfp (IDA_mem->ida_errfp) -#define iopt (IDA_mem->ida_iopt) -#define linit (IDA_mem->ida_linit) -#define lsetup (IDA_mem->ida_lsetup) -#define lsolve (IDA_mem->ida_lsolve) -#define lperf (IDA_mem->ida_lperf) -#define lfree (IDA_mem->ida_lfree) -#define lmem (IDA_mem->ida_lmem) -#define setupNonNull (IDA_mem->ida_setupNonNull) -#define vec_tmpl (IDA_mem->ida_tempv1) - -#define neq (idaband_mem->b_neq) -#define ml (idaband_mem->b_mlower) -#define mu (idaband_mem->b_mupper) -#define jac (idaband_mem->b_jac) -#define JJ (idaband_mem->b_J) -#define storage_mu (idaband_mem->b_storage_mu) -#define pivots (idaband_mem->b_pivots) -#define nje (idaband_mem->b_nje) -#define nreB (idaband_mem->b_nreB) -#define jacdata (idaband_mem->b_jdata) -#define last_flag (idaband_mem->b_last_flag) - -/* - * ----------------------------------------------------------------- - * IDABand - * ----------------------------------------------------------------- - * This routine initializes the memory record and sets various function - * fields specific to the IDABAND linear solver module. - * IDABand first calls the existing lfree routine if this is not NULL. - * Then it sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and - * ida_lfree fields in (*IDA_mem) to be IDABandInit, IDABandSetup, - * IDABandSolve, NULL, and IDABandFree, respectively. - * It allocates memory for a structure of type IDABandMemRec and sets - * the ida_lmem field in (*IDA_mem) to the address of this structure. - * It sets setupNonNull in (*IDA_mem) to TRUE, sets the b_jdata field in - * the IDABandMemRec structure to be the input parameter jdata, and sets - * the b_jac field to be: - * (1) the input parameter bjac, if bjac != NULL, or - * (2) IDABandDQJac, if bjac == NULL. - * Finally, it allocates memory for JJ and pivots. - * IDABand returns IDABAND_SUCCESS = 0, IDABAND_LMEM_FAIL = -1, - * or IDABAND_ILL_INPUT = -2. - * - * NOTE: The band linear solver assumes a serial implementation - * of the NVECTOR package. Therefore, IDABand will first - * test for a compatible N_Vector internal representation by - * checking that the N_VGetArrayPointer function exists - * ----------------------------------------------------------------- - */ - -int IDABand(void *ida_mem, long int Neq, - long int mupper, long int mlower) -{ - IDAMem IDA_mem; - IDABandMem idaband_mem; - int flag; - - /* Return immediately if ida_mem is NULL. */ - if (ida_mem == NULL) { - fprintf(stderr, MSGB_MEM_FAIL); - return(IDABAND_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - /* Test if the NVECTOR package is compatible with the BAND solver */ - if(vec_tmpl->ops->nvgetarraypointer == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_BAD_NVECTOR); - return(IDABAND_ILL_INPUT); - } - - if (lfree != NULL) flag = lfree((IDAMem) ida_mem); - - /* Set five main function fields in ida_mem. */ - linit = IDABandInit; - lsetup = IDABandSetup; - lsolve = IDABandSolve; - lperf = NULL; - lfree = IDABandFree; - - /* Get memory for IDABandMemRec. */ - idaband_mem = (IDABandMem) malloc(sizeof(IDABandMemRec)); - if (idaband_mem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_MEM_FAIL); - return(IDABAND_MEM_FAIL); - } - - /* Set default Jacobian routine and Jacobian data */ - jac = IDABandDQJac; - jacdata = IDA_mem; - last_flag = IDABAND_SUCCESS; - - setupNonNull = TRUE; - - /* Store problem size */ - neq = Neq; - - /* Test mlower and mupper for legality and load in memory. */ - if ((mlower < 0) || (mupper < 0) || (mlower >= Neq) || (mupper >= Neq)) { - if(errfp!=NULL) fprintf(errfp, MSGB_BAD_SIZES); - return(IDABAND_ILL_INPUT); - } - idaband_mem->b_mlower = mlower; - idaband_mem->b_mupper = mupper; - - /* Set extended upper half-bandwidth for JJ (required for pivoting). */ - storage_mu = MIN(Neq-1, mupper + mlower); - - /* Allocate memory for JJ and pivot array. */ - JJ = BandAllocMat(Neq, mupper, mlower, storage_mu); - if (JJ == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_MEM_FAIL); - return(IDABAND_MEM_FAIL); - } - pivots = BandAllocPiv(Neq); - if (pivots == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_MEM_FAIL); - BandFreeMat(JJ); - return(IDABAND_MEM_FAIL); - } - - /* Attach linear solver memory to the integrator memory */ - lmem = idaband_mem; - - return(IDABAND_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * IDABandSet* and IDABandGet* - * ----------------------------------------------------------------- - */ - -int IDABandSetJacFn(void *ida_mem, IDABandJacFn bjac) -{ - IDAMem IDA_mem; - IDABandMem idaband_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGB_SETGET_IDAMEM_NULL); - return(IDABAND_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_SETGET_LMEM_NULL); - return(IDABAND_LMEM_NULL); - } - idaband_mem = (IDABandMem) lmem; - - jac = bjac; - - return(IDABAND_SUCCESS); -} - -int IDABandSetJacData(void *ida_mem, void *jac_data) -{ - IDAMem IDA_mem; - IDABandMem idaband_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGB_SETGET_IDAMEM_NULL); - return(IDABAND_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_SETGET_LMEM_NULL); - return(IDABAND_LMEM_NULL); - } - idaband_mem = (IDABandMem) lmem; - - jacdata = jac_data; - - return(IDABAND_SUCCESS); -} - -int IDABandGetWorkSpace(void *ida_mem, long int *lenrwB, long int *leniwB) -{ - IDAMem IDA_mem; - IDABandMem idaband_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGB_SETGET_IDAMEM_NULL); - return(IDABAND_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_SETGET_LMEM_NULL); - return(IDABAND_LMEM_NULL); - } - idaband_mem = (IDABandMem) lmem; - - *lenrwB = neq*(storage_mu + ml + 1); - *leniwB = neq; - - return(IDABAND_SUCCESS); -} - -int IDABandGetNumJacEvals(void *ida_mem, long int *njevalsB) -{ - IDAMem IDA_mem; - IDABandMem idaband_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGB_SETGET_IDAMEM_NULL); - return(IDABAND_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_SETGET_LMEM_NULL); - return(IDABAND_LMEM_NULL); - } - idaband_mem = (IDABandMem) lmem; - - *njevalsB = nje; - - return(IDABAND_SUCCESS); -} - -int IDABandGetNumResEvals(void *ida_mem, long int *nrevalsB) -{ - IDAMem IDA_mem; - IDABandMem idaband_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGB_SETGET_IDAMEM_NULL); - return(IDABAND_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_SETGET_LMEM_NULL); - return(IDABAND_LMEM_NULL); - } - idaband_mem = (IDABandMem) lmem; - - *nrevalsB = nreB; - - return(IDABAND_SUCCESS); -} - -int IDABandGetLastFlag(void *ida_mem, int *flag) -{ - IDAMem IDA_mem; - IDABandMem idaband_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGB_SETGET_IDAMEM_NULL); - return(IDABAND_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGB_SETGET_LMEM_NULL); - return(IDABAND_LMEM_NULL); - } - idaband_mem = (IDABandMem) lmem; - - *flag = last_flag; - - return(IDABAND_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * IDABAND interface functions - * ----------------------------------------------------------------- - */ - -/* - This routine does remaining initializations specific to the IDABAND - linear solver module. It returns 0. -*/ - -static int IDABandInit(IDAMem IDA_mem) -{ - IDABandMem idaband_mem; - - idaband_mem = (IDABandMem) lmem; - - /* Initialize nje and nreB */ - nje = 0; - nreB = 0; - - if (jac == NULL) { - jac = IDABandDQJac; - jacdata = IDA_mem; - } - - last_flag = 0; - return(0); -} - - -/* - This routine does the setup operations for the IDABAND linear - solver module. It calls the Jacobian evaluation routine, - updates counters, and calls the band LU factorization routine. - The return value is either - IDABAND_SUCCESS = 0 if successful, - +1 if the jac routine failed recoverably or the - LU factorization failed, or - -1 if the jac routine failed unrecoverably. -*/ - -static int IDABandSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, - N_Vector rrp, N_Vector tmp1, N_Vector tmp2, - N_Vector tmp3) -{ - int retval; - long int retfac; - IDABandMem idaband_mem; - - idaband_mem = (IDABandMem) lmem; - - /* Increment nje counter. */ - nje++; - - /* Zero out JJ; call Jacobian routine jac; return if it failed. */ - BandZero(JJ); - retval = jac(neq, mu, ml, tn, yyp, ypp, rrp, cj, - jacdata, JJ, tmp1, tmp2, tmp3); - last_flag = retval; - if (retval < 0) return(-1); - if (retval > 0) return(+1); - - /* Do LU factorization of JJ; return success or fail flag. */ - retfac = BandFactor(JJ, pivots); - - if (retfac != 0) { - last_flag = 1; - return(+1); - } - last_flag = 0; - return(0); -} -/* - This routine handles the solve operation for the IDABAND linear - solver module. It calls the band backsolve routine, scales the - solution vector according to cjratio, then returns IDABAND_SUCCESS = 0. -*/ - -static int IDABandSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, - N_Vector ycur, N_Vector ypcur, N_Vector rrcur) -{ - IDABandMem idaband_mem; - realtype *bd; - - idaband_mem = (IDABandMem) lmem; - - bd = N_VGetArrayPointer(b); - BandBacksolve(JJ, pivots, bd); - - /* Scale the correction to account for change in cj. */ - if (cjratio != ONE) N_VScale(TWO/(ONE + cjratio), b, b); - - last_flag = 0; - return(0); -} - -/* - This routine frees memory specific to the IDABAND linear solver. -*/ - -static int IDABandFree(IDAMem IDA_mem) -{ - IDABandMem idaband_mem; - - idaband_mem = (IDABandMem) lmem; - - BandFreeMat(JJ); - BandFreePiv(pivots); - free(lmem); - - return(0); - -} - -/* - * ----------------------------------------------------------------- - * IDABAND private routines - * ----------------------------------------------------------------- - */ - -/* - This routine generates a banded difference quotient approximation JJ - to the DAE system Jacobian J. It assumes that a band matrix of type - BandMat is stored column-wise, and that elements within each column - are contiguous. The address of the jth column of JJ is obtained via - the macros BAND_COL and BAND_COL_ELEM. The columns of the Jacobian are - constructed using mupper + mlower + 1 calls to the res routine, and - appropriate differencing. - The return value is either IDABAND_SUCCESS = 0, or the nonzero value returned - by the res routine, if any. -*/ - -static int IDABandDQJac(long int Neq, long int mupper, long int mlower, - realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, - realtype c_j, void *jac_data, BandMat Jac, - N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) -{ - realtype inc, inc_inv, yj, ypj, srur, conj, ewtj; - realtype *y_data, *yp_data, *ewt_data, *cns_data = NULL; - realtype *ytemp_data, *yptemp_data, *rtemp_data, *r_data, *col_j; - int group; - - N_Vector rtemp, ytemp, yptemp; - long int i, j, i1, i2, width, ngroups; - int retval = IDABAND_SUCCESS; - - IDAMem IDA_mem; - IDABandMem idaband_mem; - - /* jac_data points to IDA_mem */ - IDA_mem = (IDAMem) jac_data; - idaband_mem = (IDABandMem) lmem; - - rtemp = tmp1; /* Rename work vector for use as the perturbed residual. */ - - ytemp = tmp2; /* Rename work vector for use as a temporary for yy. */ - - - yptemp= tmp3; /* Rename work vector for use as a temporary for yp. */ - - /* Obtain pointers to the data for all eight vectors used. */ - - ewt_data = N_VGetArrayPointer(ewt); - r_data = N_VGetArrayPointer(rr); - y_data = N_VGetArrayPointer(yy); - yp_data = N_VGetArrayPointer(yp); - - rtemp_data = N_VGetArrayPointer(rtemp); - ytemp_data = N_VGetArrayPointer(ytemp); - yptemp_data = N_VGetArrayPointer(yptemp); - - if (constraints != NULL) cns_data = N_VGetArrayPointer(constraints); - - /* Initialize ytemp and yptemp. */ - - N_VScale(ONE, yy, ytemp); - N_VScale(ONE, yp, yptemp); - - /* Compute miscellaneous values for the Jacobian computation. */ - - srur = RSqrt(uround); - width = mlower + mupper + 1; - ngroups = MIN(width, neq); - - /* Loop over column groups. */ - for (group=1; group <= ngroups; group++) { - - /* Increment all yy[j] and yp[j] for j in this group. */ - - for (j=group-1; j - -#include "band.h" -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Type : IDABandJacFn - * ----------------------------------------------------------------- - * A banded Jacobian approximation function bjac must have the - * prototype given below. Its parameters are: - * - * Neq is the problem size, and length of all vector arguments. - * - * mupper is the upper bandwidth of the banded Jacobian matrix. - * - * mlower is the lower bandwidth of the banded Jacobian matrix. - * - * tt is the current value of the independent variable t. - * - * yy is the current value of the dependent variable vector, - * namely the predicted value of y(t). - * - * yp is the current value of the derivative vector y', - * namely the predicted value of y'(t). - * - * rr is the residual vector F(tt,yy,yp). - * - * c_j is the scalar in the system Jacobian, proportional to 1/hh. - * - * jac_data is a pointer to user Jacobian data - the same as the - * jdata parameter passed to IDABand. - * - * Jac is the band matrix (of type BandMat) to be loaded by - * an IDABandJacFn routine with an approximation to the - * system Jacobian matrix - * J = dF/dy + cj*dF/dy' - * at the given point (t,y,y'), where the DAE system is - * given by F(t,y,y') = 0. Jac is preset to zero, so only - * the nonzero elements need to be loaded. See note below. - * - * tmp1, tmp2, tmp3 are pointers to memory allocated for - * N_Vectors which can be used by an IDABandJacFn routine - * as temporary storage or work space. - * - * NOTE: The following are two efficient ways to load Jac: - * - * (1) (with macros - no explicit data structure references) - * for (j=0; j < Neq; j++) { - * col_j = BAND_COL(Jac,j); - * for (i=j-mupper; i <= j+mlower; i++) { - * generate J_ij = the (i,j)th Jacobian element - * BAND_COL_ELEM(col_j,i,j) = J_ij; - * } - * } - * - * (2) (with BAND_COL macro, but without BAND_COL_ELEM macro) - * for (j=0; j < Neq; j++) { - * col_j = BAND_COL(Jac,j); - * for (k=-mupper; k <= mlower; k++) { - * generate J_ij = the (i,j)th Jacobian element, i=j+k - * col_j[k] = J_ij; - * } - * } - * - * NOTE: If the user's Jacobian routine needs other quantities, - * they are accessible as follows: hcur (the current stepsize) - * and ewt (the error weight vector) are accessible through - * IDAGetCurrentStep and IDAGetErrWeights, respectively (see - * ida.h). The unit roundoff is available as - * UNIT_ROUNDOFF defined in sundialstypes.h - * - * A third way, using the BAND_ELEM(A,i,j) macro, is much less - * efficient in general. It is only appropriate for use in small - * problems in which efficiency of access is NOT a major concern. - * - * The IDABandJacFn should return - * 0 if successful, - * a positive int if a recoverable error occurred, or - * a negative int if a nonrecoverable error occurred. - * In the case of a recoverable error return, the integrator will - * attempt to recover by reducing the stepsize (which changes cj). - * ----------------------------------------------------------------- - */ - -typedef int (*IDABandJacFn)(long int Neq, long int mupper, - long int mlower, realtype tt, - N_Vector yy, N_Vector yp, N_Vector rr, - realtype c_j, void *jac_data, BandMat Jac, - N_Vector tmp1, N_Vector tmp2, - N_Vector tmp3); - -/* - * ----------------------------------------------------------------- - * Function : IDABand - * ----------------------------------------------------------------- - * A call to the IDABand function links the main integrator - * with the IDABAND linear solver module. - * - * ida_mem is the pointer to the integrator memory returned by - * IDACreate. - * - * mupper is the upper bandwidth of the banded Jacobian matrix. - * - * mlower is the lower bandwidth of the banded Jacobian matrix. - * - * The return values of IDABand are: - * IDABAND_SUCCESS = 0 if successful - * IDABAND_LMEM_FAIL = -1 if there was a memory allocation failure - * IDABAND_ILL_INPUT = -2 if the input was illegal or NVECTOR bad. - * - * NOTE: The band linear solver assumes a serial implementation - * of the NVECTOR package. Therefore, IDABand will first - * test for a compatible N_Vector internal representation - * by checking that the N_VGetArrayPointer function exists. - * ----------------------------------------------------------------- - */ - -int IDABand(void *ida_mem, long int Neq, long int mupper, long int mlower); - -/* - * ----------------------------------------------------------------- - * Optional inputs to the IDABAND linear solver - * ----------------------------------------------------------------- - * - * IDABandSetJacFn specifies the dense Jacobian approximation - * routine to be used. A user-supplied djac routine must - * be of type IDABandJacFn. - * By default, a difference quotient routine IDABandDQJac, - * supplied with this solver is used. - * IDABandSetJacData specifies a pointer to user data which is - * passed to the bjac routine every time it is called. - * - * The return value of IDABandSet* is one of: - * IDABAND_SUCCESS if successful - * IDABAND_MEM_NULL if the ida memory was NULL - * IDABAND_LMEM_NULL if the idaband memory was NULL - * ----------------------------------------------------------------- - */ - -int IDABandSetJacFn(void *ida_mem, IDABandJacFn bjac); -int IDABandSetJacData(void *ida_mem, void *jac_data); - -/* - * ----------------------------------------------------------------- - * Optional outputs from the IDABAND linear solver - * ----------------------------------------------------------------- - * - * IDABandGetWorkSpace returns the real and integer workspace used - * by IDABAND. - * IDABandGetNumJacEvals returns the number of calls made to the - * Jacobian evaluation routine bjac. - * IDABandGetNumResEvals returns the number of calls to the user - * res routine due to finite difference Jacobian evaluation. - * IDABandGetLastFlag returns the last error flag set by any of - * the IDABAND interface functions. - * - * The return value of IDABandGet* is one of: - * IDABAND_SUCCESS if successful - * IDABAND_MEM_NULL if the ida memory was NULL - * IDABAND_LMEM_NULL if the idaband memory was NULL - * ----------------------------------------------------------------- - */ - -int IDABandGetWorkSpace(void *ida_mem, long int *lenrwB, long int *leniwB); -int IDABandGetNumJacEvals(void *ida_mem, long int *njevalsB); -int IDABandGetNumResEvals(void *ida_mem, long int *nrevalsB); -int IDABandGetLastFlag(void *ida_mem, int *flag); - -/* IDABAND return values */ - -#define IDABAND_SUCCESS 0 -#define IDABAND_MEM_NULL -1 -#define IDABAND_LMEM_NULL -2 -#define IDABAND_ILL_INPUT -3 -#define IDABAND_MEM_FAIL -4 - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/ida/idaband_impl.h b/src/sundials/ida/idaband_impl.h deleted file mode 100755 index 5577483f17..0000000000 --- a/src/sundials/ida/idaband_impl.h +++ /dev/null @@ -1,97 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmers: Alan C. Hindmarsh, and Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California - * Produced at the Lawrence Livermore National Laboratory - * All rights reserved - * For details, see sundials/idas/LICENSE - * ----------------------------------------------------------------- - * This is the header file (private version) for the IDA/IDAS band - * linear solver module, IDABAND. It interfaces between the band - * module and the integrator when a banded linear solver is - * appropriate. - * ----------------------------------------------------------------- - */ - -#ifndef _IDABAND_IMPL_H -#define _IDABAND_IMPL_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include - -#include "idaband.h" - -#include "band.h" -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Types : IDABandMemRec, IDABandMem - * ----------------------------------------------------------------- - */ - -typedef struct { - - long int b_neq; /* Neq = problem size */ - - IDABandJacFn b_jac; /* jac = banded Jacobian routine to be called */ - - BandMat b_J; /* J = dF/dy + cj*dF/dy', banded approximation. */ - - long int b_mupper; /* mupper = upper bandwidth of Jacobian matrix. */ - - long int b_mlower; /* mlower = lower bandwidth of Jacobian matrix. */ - - long int b_storage_mu; /* storage_mu = upper bandwidth with storage for - factoring = min(Neq-1, mupper+mlower). */ - - long int *b_pivots; /* pivots = pivot array for PJ = LU */ - - long int b_nje; /* nje = no. of calls to jac */ - - long int b_nreB; /* nreB = no. of calls to res due to - difference quotient Jacobian evaluation */ - - void *b_jdata; /* jdata = data structure required by jac. */ - - int b_last_flag; /* last error return flag */ - -} IDABandMemRec, *IDABandMem; - -/* - * ----------------------------------------------------------------- - * Error Messages - * ----------------------------------------------------------------- - */ - -#define _IDABAND_ "IDABand-- " - -#define MSGB_IDAMEM_NULL _IDABAND_ "Integrator memory is NULL.\n\n" - -#define MSGB_BAD_SIZES1 _IDABAND_ "illegal bandwidth parameter(s) " -#define MSGB_BAD_SIZES2 "Must have 0 <= mlower, mupper <= N-1.\n\n" -#define MSGB_BAD_SIZES MSGB_BAD_SIZES1 MSGB_BAD_SIZES2 - -#define MSGB_MEM_FAIL _IDABAND_ "a memory request failed.\n\n" - -#define MSGB_BAD_NVECTOR _IDABAND_ "a required vector operation is not implemented.\n\n" - -#define MSGB_WRONG_NVEC _IDABAND_ "incompatible NVECTOR implementation.\n\n" - -#define MSGB_SETGET_IDAMEM_NULL "IDABandSet*/IDABandGet*-- integrator memory is NULL. \n\n" - -#define MSGB_SETGET_LMEM_NULL "IDABandSet*/IDABandGet*-- IDABAND memory is NULL. \n\n" - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/ida/idabbdpre.c b/src/sundials/ida/idabbdpre.c deleted file mode 100755 index 4f58cecad4..0000000000 --- a/src/sundials/ida/idabbdpre.c +++ /dev/null @@ -1,497 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmers: Alan C. Hindmarsh, and Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California - * Produced at the Lawrence Livermore National Laboratory - * All rights reserved - * For details, see sundials/ida/LICENSE - * ----------------------------------------------------------------- - * This file contains implementations of routines for a - * band-block-diagonal preconditioner, i.e. a block-diagonal - * matrix with banded blocks, for use with IDA and IDASpgmr. - * NOTE: with only one processor in use, a banded matrix results - * rather than a block-diagonal matrix with banded blocks. - * Diagonal blocking occurs at the processor level. - * ----------------------------------------------------------------- - */ - -#include -#include -#include - -#include "ida_impl.h" -#include "idabbdpre_impl.h" -#include "idaspgmr_impl.h" - -#include "sundialsmath.h" - - -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) -#define TWO RCONST(2.0) - -/* Prototype for difference quotient Jacobian calculation routine */ - -static int IBBDDQJac(IBBDPrecData pdata, realtype tt, realtype cj, - N_Vector yy, N_Vector yp, N_Vector gref, - N_Vector ytemp, N_Vector yptemp, N_Vector gtemp); - -/* Readability Replacements */ - -#define errfp (IDA_mem->ida_errfp) -#define uround (IDA_mem->ida_uround) -#define vec_tmpl (IDA_mem->ida_tempv1) - -/* - * ----------------------------------------------------------------- - * User-Callable Functions: malloc, reinit, and free - * ----------------------------------------------------------------- - */ - -void *IDABBDPrecAlloc(void *ida_mem, long int Nlocal, - long int mudq, long int mldq, - long int mukeep, long int mlkeep, - realtype dq_rel_yy, - IDABBDLocalFn Gres, IDABBDCommFn Gcomm) -{ - IDAMem IDA_mem; - IBBDPrecData pdata; - N_Vector tempv4; - long int muk, mlk, storage_mu; - - if (ida_mem == NULL) { - fprintf(stderr, MSGBBD_IDAMEM_NULL); - return(NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - /* Test if the NVECTOR package is compatible with BLOCK BAND preconditioner */ - if(vec_tmpl->ops->nvgetarraypointer == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGBBD_BAD_NVECTOR); - return(NULL); - } - - /* Allocate data memory. */ - pdata = (IBBDPrecData) malloc(sizeof *pdata); - if (pdata == NULL) return(NULL); - - /* Set pointers to glocal and gcomm; load half-bandwidths. */ - pdata->IDA_mem = IDA_mem; - pdata->glocal = Gres; - pdata->gcomm = Gcomm; - pdata->mudq = MIN( Nlocal-1, MAX(0,mudq) ); - pdata->mldq = MIN( Nlocal-1, MAX(0,mldq) ); - muk = MIN( Nlocal-1, MAX(0,mukeep) ); - mlk = MIN( Nlocal-1, MAX(0,mlkeep) ); - pdata->mukeep = muk; - pdata->mlkeep = mlk; - - /* Set extended upper half-bandwidth for PP (required for pivoting). */ - storage_mu = MIN(Nlocal-1, muk + mlk); - - /* Allocate memory for preconditioner matrix. */ - pdata->PP = BandAllocMat(Nlocal, muk, mlk, storage_mu); - if (pdata->PP == NULL) { free(pdata); return(NULL); } - - /* Allocate memory for pivots. */ - pdata->pivots = BandAllocPiv(Nlocal); - if (pdata->PP == NULL) { - BandFreeMat(pdata->PP); - free(pdata); - return(NULL); - } - - /* Allocate tempv4 for use by IBBDDQJac */ - tempv4 = N_VClone(vec_tmpl); - if (tempv4 == NULL){ - BandFreeMat(pdata->PP); - BandFreePiv(pdata->pivots); - free(pdata); - return(NULL); - } - pdata->tempv4 = tempv4; - - /* Set rel_yy based on input value dq_rel_yy (0 implies default). */ - pdata->rel_yy = (dq_rel_yy > ZERO) ? dq_rel_yy : RSqrt(uround); - - /* Store Nlocal to be used in IDABBDPrecSetup */ - pdata->n_local = Nlocal; - - /* Set work space sizes and initialize nge. */ - pdata->rpwsize = Nlocal*(mlk + storage_mu + 1); - pdata->ipwsize = Nlocal; - pdata->nge = 0; - - return((void *)pdata); -} - -int IDABBDSpgmr(void *ida_mem, int maxl, void *bbd_data) -{ - int flag; - - if ( bbd_data == NULL ) { - fprintf(stderr, MSGBBD_NO_PDATA); - return(IDA_PDATA_NULL); - } - - flag = IDASpgmr(ida_mem, maxl); - if(flag != IDASPGMR_SUCCESS) return(flag); - - flag = IDASpgmrSetPrecData(ida_mem, bbd_data); - if(flag != IDASPGMR_SUCCESS) return(flag); - - flag = IDASpgmrSetPrecSetupFn(ida_mem, IDABBDPrecSetup); - if(flag != IDASPGMR_SUCCESS) return(flag); - - flag = IDASpgmrSetPrecSolveFn(ida_mem, IDABBDPrecSolve); - if(flag != IDASPGMR_SUCCESS) return(flag); - - return(IDASPGMR_SUCCESS); -} - -int IDABBDPrecReInit(void *bbd_data, - long int mudq, long int mldq, - realtype dq_rel_yy, - IDABBDLocalFn Gres, IDABBDCommFn Gcomm) -{ - IBBDPrecData pdata; - IDAMem IDA_mem; - long int Nlocal; - - pdata =(IBBDPrecData) bbd_data; - IDA_mem = pdata->IDA_mem; - - Nlocal = pdata->n_local; - - /* Set pointers to res_data, glocal, and gcomm; load half-bandwidths. */ - pdata->mudq = MIN( Nlocal-1, MAX(0,mudq) ); - pdata->mldq = MIN( Nlocal-1, MAX(0,mldq) ); - pdata->glocal = Gres; - pdata->gcomm = Gcomm; - - /* Set rel_yy based on input value dq_rel_yy (0 implies default). */ - pdata->rel_yy = (dq_rel_yy > ZERO) ? dq_rel_yy : RSqrt(uround); - - /* Re-initialize nge */ - pdata->nge = 0; - - return(0); -} - - -void IDABBDPrecFree(void *bbd_data) -{ - IBBDPrecData pdata; - - if ( bbd_data != NULL ) { - pdata = (IBBDPrecData) bbd_data; - BandFreeMat(pdata->PP); - BandFreePiv(pdata->pivots); - N_VDestroy(pdata->tempv4); - free(pdata); - } -} - -int IDABBDPrecGetWorkSpace(void *bbd_data, long int *lenrwBBDP, long int *leniwBBDP) -{ - IBBDPrecData pdata; - - if ( bbd_data == NULL ) { - fprintf(stderr, MSGBBD_PDATA_NULL); - return(IDA_PDATA_NULL); - } - - pdata = (IBBDPrecData) bbd_data; - - *lenrwBBDP = pdata->rpwsize; - *leniwBBDP = pdata->ipwsize; - - return(IDA_SUCCESS); -} - -int IDABBDPrecGetNumGfnEvals(void *bbd_data, long int *ngevalsBBDP) -{ - IBBDPrecData pdata; - - if ( bbd_data == NULL ) { - fprintf(stderr, MSGBBD_PDATA_NULL); - return(IDA_PDATA_NULL); - } - - pdata = (IBBDPrecData) bbd_data; - - *ngevalsBBDP = pdata->nge; - - return(IDA_SUCCESS); -} - -/* Readability Replacements */ - -#define Nlocal (pdata->n_local) -#define mudq (pdata->mudq) -#define mldq (pdata->mldq) -#define mukeep (pdata->mukeep) -#define mlkeep (pdata->mlkeep) -#define glocal (pdata->glocal) -#define gcomm (pdata->gcomm) -#define pivots (pdata->pivots) -#define PP (pdata->PP) -#define nge (pdata->nge) -#define rel_yy (pdata->rel_yy) - -/* - * ----------------------------------------------------------------- - * Function : IDABBDPrecSetup - *---------------------------------------------------------------- - * IDABBDPrecSetup generates a band-block-diagonal preconditioner - * matrix, where the local block (on this processor) is a band - * matrix. Each local block is computed by a difference quotient - * scheme via calls to the user-supplied routines glocal, gcomm. - * After generating the block in the band matrix PP, this routine - * does an LU factorization in place in PP. - * - * The IDABBDPrecSetup parameters used here are as follows: - * - * tt is the current value of the independent variable t. - * - * yy is the current value of the dependent variable vector, - * namely the predicted value of y(t). - * - * yp is the current value of the derivative vector y', - * namely the predicted value of y'(t). - * - * c_j is the scalar in the system Jacobian, proportional to 1/hh. - * - * prec_data is a pointer to user preconditioner data - the same as - * the p_data parameter passed to IDASpgmr. - * - * tmp1, tmp2, tmp3 are pointers to vectors of type - * N_Vector, used for temporary storage or work space. - * - * The arguments Neq, rr, res, uround, and nrePtr are not used. - * - * Return value: - * The value returned by this IDABBDPrecSetup function is a int - * flag indicating whether it was successful. This value is - * 0 if successful, - * > 0 for a recoverable error (step will be retried). - * < 0 for a nonrecoverable error (step fails). - * - * ----------------------------------------------------------------- - */ - -int IDABBDPrecSetup(realtype tt, - N_Vector yy, N_Vector yp, N_Vector rr, - realtype c_j, void *prec_data, - N_Vector tempv1, N_Vector tempv2, N_Vector tempv3) -{ - long int retfac; - int retval; - IBBDPrecData pdata; - - pdata =(IBBDPrecData) prec_data; - - /* Call IBBDDQJac for a new Jacobian calculation and store in PP. */ - BandZero(PP); - retval = IBBDDQJac(pdata, tt, c_j, yy, yp, - tempv1, tempv2, tempv3, pdata->tempv4); - if (retval < 0) return(-1); - if (retval > 0) return(+1); - - /* Do LU factorization of preconditioner block in place (in PP). */ - retfac = BandFactor(PP, pivots); - - /* Return 0 if the LU was complete, or +1 otherwise. */ - if (retfac > 0) return(+1); - return(0); -} - - -/* - * ----------------------------------------------------------------- - * Function: IDABBDPrecSolve - *---------------------------------------------------------------- - * The function IDABBDPrecSolve computes a solution to the linear - * system P z = r, where P is the left preconditioner defined by - * the routine IDABBDPrecSetup. - * - * The IDABBDPrecSolve parameters used here are as follows: - * - * rvec is the input right-hand side vector r. - * - * zvec is the computed solution vector z. - * - * prec_data is a pointer to user preconditioner data - the same as - * the p_data parameter passed to IDASpgmr. - * - * The arguments tt, yy, yp, rr, c_j, delta, and tmp are NOT used. - * - * IDABBDPrecSolve always returns 0, indicating success. - * - * ----------------------------------------------------------------- - */ - -int IDABBDPrecSolve(realtype tt, - N_Vector yy, N_Vector yp, N_Vector rr, - N_Vector rvec, N_Vector zvec, - realtype c_j, realtype delta, void *prec_data, - N_Vector tmp) -{ - IBBDPrecData pdata; - realtype *zd; - - pdata = (IBBDPrecData) prec_data; - - /* Copy rvec to zvec, do the backsolve, and return. */ - N_VScale(ONE, rvec, zvec); - - zd = N_VGetArrayPointer(zvec); - - BandBacksolve(PP, pivots, zd); - - return(0); -} - -/* - * ----------------------------------------------------------------- - * IBBDDQJac - * ----------------------------------------------------------------- - * This routine generates a banded difference quotient approximation to - * the local block of the Jacobian of G(t,y,y'). It assumes that a - * band matrix of type BandMat is stored column-wise, and that elements - * within each column are contiguous. - * - * All matrix elements are generated as difference quotients, by way - * of calls to the user routine glocal. - * By virtue of the band structure, the number of these calls is - * bandwidth + 1, where bandwidth = mldq + mudq + 1. - * But the band matrix kept has bandwidth = mlkeep + mukeep + 1. - * This routine also assumes that the local elements of a vector are - * stored contiguously. - * - * Return values are: 0 (success), > 0 (recoverable error), - * or < 0 (nonrecoverable error). - * ----------------------------------------------------------------- - */ - -#define ewt (IDA_mem->ida_ewt) -#define res_data (IDA_mem->ida_rdata) -#define hh (IDA_mem->ida_hh) -#define constraints (IDA_mem->ida_constraints) - -static int IBBDDQJac(IBBDPrecData pdata, realtype tt, realtype cj, - N_Vector yy, N_Vector yp, N_Vector gref, - N_Vector ytemp, N_Vector yptemp, N_Vector gtemp) -{ - IDAMem IDA_mem; - realtype inc, inc_inv; - int retval; - long int group, i, j, width, ngroups, i1, i2; - realtype *ydata, *ypdata, *ytempdata, *yptempdata, *grefdata, *gtempdata; - realtype *cnsdata = NULL, *ewtdata; - realtype *col_j, conj, yj, ypj, ewtj; - - IDA_mem = pdata->IDA_mem; - - /* Initialize ytemp and yptemp. */ - - N_VScale(ONE, yy, ytemp); - N_VScale(ONE, yp, yptemp); - - /* Obtain pointers as required to the data array of vectors. */ - - ydata = N_VGetArrayPointer(yy); - ypdata = N_VGetArrayPointer(yp); - gtempdata = N_VGetArrayPointer(gtemp); - ewtdata = N_VGetArrayPointer(ewt); - if (constraints != NULL) - cnsdata = N_VGetArrayPointer(constraints); - ytempdata = N_VGetArrayPointer(ytemp); - yptempdata= N_VGetArrayPointer(yptemp); - grefdata = N_VGetArrayPointer(gref); - - /* Call gcomm and glocal to get base value of G(t,y,y'). */ - - if (gcomm != NULL) { - retval = gcomm(Nlocal, tt, yy, yp, res_data); - if (retval != 0) return(retval); - } - - retval = glocal(Nlocal, tt, yy, yp, gref, res_data); - nge++; - if (retval != 0) return(retval); - - - /* Set bandwidth and number of column groups for band differencing. */ - - width = mldq + mudq + 1; - ngroups = MIN(width, Nlocal); - - /* Loop over groups. */ - for(group = 1; group <= ngroups; group++) { - - /* Loop over the components in this group. */ - for(j = group-1; j < Nlocal; j += width) { - yj = ydata[j]; - ypj = ypdata[j]; - ewtj = ewtdata[j]; - - /* Set increment inc to yj based on rel_yy*abs(yj), with - adjustments using ypj and ewtj if this is small, and a further - adjustment to give it the same sign as hh*ypj. */ - inc = rel_yy*MAX(ABS(yj), MAX( ABS(hh*ypj), ONE/ewtj)); - if (hh*ypj < ZERO) inc = -inc; - inc = (yj + inc) - yj; - - /* Adjust sign(inc) again if yj has an inequality constraint. */ - if (constraints != NULL) { - conj = cnsdata[j]; - if (ABS(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} - else if (ABS(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} - } - - /* Increment yj and ypj. */ - ytempdata[j] += inc; - yptempdata[j] += cj*inc; - - } - - /* Evaluate G with incremented y and yp arguments. */ - - retval = glocal(Nlocal, tt, ytemp, yptemp, gtemp, res_data); - nge++; - if (retval != 0) return(retval); - - /* Loop over components of the group again; restore ytemp and yptemp. */ - for(j = group-1; j < Nlocal; j += width) { - yj = ytempdata[j] = ydata[j]; - ypj = yptempdata[j] = ypdata[j]; - ewtj = ewtdata[j]; - - /* Set increment inc as before .*/ - inc = rel_yy*MAX(ABS(yj), MAX( ABS(hh*ypj), ONE/ewtj)); - if (hh*ypj < ZERO) inc = -inc; - inc = (yj + inc) - yj; - if (constraints != NULL) { - conj = cnsdata[j]; - if (ABS(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} - else if (ABS(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} - } - - /* Form difference quotients and load into PP. */ - inc_inv = ONE/inc; - col_j = BAND_COL(PP,j); - i1 = MAX(0, j-mukeep); - i2 = MIN(j+mlkeep, Nlocal-1); - for(i = i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = - inc_inv * (gtempdata[i] - grefdata[i]); - } - } - - return(0); -} diff --git a/src/sundials/ida/idabbdpre.h b/src/sundials/ida/idabbdpre.h deleted file mode 100755 index cfc16bee3c..0000000000 --- a/src/sundials/ida/idabbdpre.h +++ /dev/null @@ -1,309 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmers: Alan C. Hindmarsh and Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California - * Produced at the Lawrence Livermore National Laboratory - * All rights reserved - * For details, see sundials/ida/LICENSE - * ----------------------------------------------------------------- - * This is the header file for the IDABBDPRE module, for a - * band-block-diagonal preconditioner, i.e. a block-diagonal - * matrix with banded blocks, for use with IDA/IDAS and IDASpgmr. - * - * Summary: - * - * These routines provide a preconditioner matrix that is - * block-diagonal with banded blocks. The blocking corresponds - * to the distribution of the dependent variable vector y among - * the processors. Each preconditioner block is generated from - * the Jacobian of the local part (on the current processor) of a - * given function G(t,y,y') approximating F(t,y,y'). The blocks - * are generated by a difference quotient scheme on each processor - * independently. This scheme utilizes an assumed banded - * structure with given half-bandwidths, mudq and mldq. - * However, the banded Jacobian block kept by the scheme has - * half-bandwiths mukeep and mlkeep, which may be smaller. - * - * The user's calling program should have the following form: - * - * #include "idabbdpre.h" - * #include "nvector_parallel.h" - * ... - * void *p_data; - * ... - * y0 = N_VNew_Parallel(...); - * yp0 = N_VNew_Parallel(...); - * ... - * ida_mem = IDACreate(...); - * ier = IDAMalloc(...); - * ... - * p_data = IDABBDPrecAlloc(ida_mem, Nlocal, mudq, mldq, - * mukeep, mlkeep, dq_rel_yy, Gres, Gcomm); - * flag = IDABBDSpgmr(ida_mem, maxl, p_data); - * ... - * ier = IDASolve(...); - * ... - * IDABBDFree(p_data); - * ... - * IDAFree(...); - * - * N_VDestroy(y0); - * N_VDestroy(yp0); - * - * The user-supplied routines required are: - * - * res is the function F(t,y,y') defining the DAE system to - * be solved: F(t,y,y') = 0. - * - * Gres is the function defining a local approximation - * G(t,y,y') to F, for the purposes of the preconditioner. - * - * Gcomm is the function performing communication needed - * for Glocal. - * - * - * Notes: - * - * 1) This header file is included by the user for the definition - * of the IBBDPrecData type and for needed function prototypes. - * - * 2) The IDABBDPrecAlloc call includes half-bandwidths mudq and - * mldq to be used in the approximate Jacobian. They need - * not be the true half-bandwidths of the Jacobian of the - * local block of G, when smaller values may provide a greater - * efficiency. Similarly, mukeep and mlkeep, specifying the - * bandwidth kept for the approximate Jacobian, need not be - * the true half-bandwidths. Also, mukeep, mlkeep, mudq, and - * mldq need not be the same on every processor. - * - * 3) The actual name of the user's res function is passed to - * IDAMalloc, and the names of the user's Gres and Gcomm - * functions are passed to IDABBDPrecAlloc. - * - * 4) The pointer to the user-defined data block res_data, which - * is set through IDASetRdata is also available to the user - * in glocal and gcomm. - * - * 5) Optional outputs specific to this module are available by - * way of routines listed below. These include work space sizes - * and the cumulative number of glocal calls. The costs - * associated with this module also include nsetups banded LU - * factorizations, nsetups gcomm calls, and nps banded - * backsolve calls, where nsetups and nps are integrator - * optional outputs. - * ----------------------------------------------------------------- - */ - -#ifndef _IBBDPRE_H -#define _IBBDPRE_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include "sundialstypes.h" -#include "nvector.h" -#include "band.h" - -/* - * ----------------------------------------------------------------- - * Type : IDABBDLocalFn - *----------------------------------------------------------------* - * The user must supply a function G(t,y,y') which approximates - * the function F for the system F(t,y,y') = 0, and which is - * computed locally (without inter-processor communication). - * (The case where G is mathematically identical to F is allowed.) - * The implementation of this function must have type IDABBDLocalFn. - * - * This function takes as input the independent variable value tt, - * the current solution vector yy, the current solution - * derivative vector yp, and a pointer to the user-defined data - * block res_data. It is to compute the local part of G(t,y,y') - * and store it in the vector gval. (Providing memory for yy and - * gval is handled within this preconditioner module.) It is - * expected that this routine will save communicated data in work - * space defined by the user, and made available to the - * preconditioner function for the problem. The res_data - * parameter is the same as that passed by the user to the - * IDAMalloc routine. - * - * An IDABBDLocalFn Gres is to return an int, defined in the same - * way as for the residual function: 0 (success), +1 or -1 (fail). - * ----------------------------------------------------------------- - */ - -typedef int (*IDABBDLocalFn)(long int Nlocal, realtype tt, - N_Vector yy, N_Vector yp, N_Vector gval, - void *res_data); - -/* - * ----------------------------------------------------------------- - * Type : IDABBDCommFn - *---------------------------------------------------------------- - * The user may supply a function of type IDABBDCommFn which - * performs all inter-processor communication necessary to - * evaluate the approximate system function described above. - * - * This function takes as input the solution vectors yy and yp, - * and a pointer to the user-defined data block res_data. The - * res_data parameter is the same as that passed by the user to - * the IDAMalloc routine. - * - * The IDABBDCommFn Gcomm is expected to save communicated data in - * space defined with the structure *res_data. - * - * A IDABBDCommFn Gcomm returns an int value equal to 0 (success), - * > 0 (recoverable error), or < 0 (unrecoverable error). - * - * Each call to the IDABBDCommFn is preceded by a call to the system - * function res with the same vectors yy and yp. Thus the - * IDABBDCommFn gcomm can omit any communications done by res if - * relevant to the evaluation of the local function glocal. - * A NULL communication function can be passed to IDABBDPrecAlloc - * if all necessary communication was done by res. - * ----------------------------------------------------------------- - */ - -typedef int (*IDABBDCommFn)(long int Nlocal, realtype tt, - N_Vector yy, N_Vector yp, - void *res_data); - -/* - * ----------------------------------------------------------------- - * Function : IDABBDPrecAlloc - *---------------------------------------------------------------- - * IDABBDPrecAlloc allocates and initializes an IBBDPrecData - * structure to be passed to IDASpgmr (and used by - * IDABBDPrecSetup and IDABBDPrecSol). - * - * The parameters of IDABBDPrecAlloc are as follows: - * - * ida_mem is a pointer to the memory blockreturned by IDACreate. - * - * Nlocal is the length of the local block of the vectors yy etc. - * on the current processor. - * - * mudq, mldq are the upper and lower half-bandwidths to be used - * in the computation of the local Jacobian blocks. - * - * mukeep, mlkeep are the upper and lower half-bandwidths to be - * used in saving the Jacobian elements in the local - * block of the preconditioner matrix PP. - * - * dq_rel_yy is an optional input. It is the relative increment - * to be used in the difference quotient routine for - * Jacobian calculation in the preconditioner. The - * default is sqrt(unit roundoff), and specified by - * passing dq_rel_yy = 0. - * - * Gres is the name of the user-supplied function G(t,y,y') - * that approximates F and whose local Jacobian blocks - * are to form the preconditioner. - * - * Gcomm is the name of the user-defined function that performs - * necessary inter-processor communication for the - * execution of glocal. - * - * IDABBDPrecAlloc returns the storage allocated (type *void), - * or NULL if the request for storage cannot be satisfied. - * ----------------------------------------------------------------- - */ - -void *IDABBDPrecAlloc(void *ida_mem, long int Nlocal, - long int mudq, long int mldq, - long int mukeep, long int mlkeep, - realtype dq_rel_yy, - IDABBDLocalFn Gres, IDABBDCommFn Gcomm); - -/* - * ----------------------------------------------------------------- - * Function : IDABBDSpgmr - *---------------------------------------------------------------- - * IDABBDSpgmr links the IDABBDPRE preconditioner to the IDASPGMR - * linear solver. It performs the following actions: - * 1) Calls the IDASPGMR specification routine and attaches the - * IDASPGMR linear solver to the IDA solver; - * 2) Sets the preconditioner data structure for IDASPGMR - * 3) Sets the preconditioner setup routine for IDASPGMR - * 4) Sets the preconditioner solve routine for IDASPGMR - * - * Its first 2 arguments are the same as for IDASpgmr (see - * idaspgmr.h). The last argument is the pointer to the IDABBDPRE - * memory block returned by IDABBDPrecAlloc. * - * Note that the user need not call IDASpgmr anymore. - * - * Possible return values are: - * IDASPGMR_SUCCESS if successful - * IDASPGMR_MEM_NULL if the ida memory was NULL - * IDASPGMR_MEM_FAIL if there was a memory allocation failure - * IDASPGMR_ILL_INPUT if there was illegal input. - * IDA_PDATA_NULL if p_data was NULL. - * ----------------------------------------------------------------- - */ - -int IDABBDSpgmr(void *ida_mem, int maxl, void *bbd_data); - -/* - * ----------------------------------------------------------------- - * Function : IDABBDPrecReInit - *---------------------------------------------------------------- - * IDABBDPrecReInit re-initializes the IDABBDPRE module when - * solving a sequence of problems of the same size with - * IDASPGMR/IDABBDPRE provided there is no change in Nlocal, - * mukeep, or mlkeep. After solving one problem, and after - * calling IDAReInit to re-initialize the integrator for a - * subsequent problem, call IDABBDPrecReInit. - * Then call IDAReInitSpgmr or IDASpgmr, if necessary, to - * re-initialize the Spgmr linear solver, depending on changes - * made in its input parameters, before calling IDASolve. - * - * The first argument to IDABBDPrecReInit must be the pointer - * bbd_data that was returned by IDABBDPrecAlloc. All other - * arguments have the same names and meanings as those of - * IDABBDPrecAlloc. - * - * The return value of IDABBDPrecReInit is 0, indicating success. - * ----------------------------------------------------------------- - */ - -int IDABBDPrecReInit(void *bbd_data, - long int mudq, long int mldq, - realtype dq_rel_yy, - IDABBDLocalFn Gres, IDABBDCommFn Gcomm); - -/* - * ----------------------------------------------------------------- - * Function : IDABBDPrecFree - *---------------------------------------------------------------- - * IDABBDPrecFree frees the memory block bbd_data allocated by the - * call to IDABBDPrecAlloc. - * ----------------------------------------------------------------- - */ - -void IDABBDPrecFree(void *bbd_data); - -/* - * ----------------------------------------------------------------- - * Optional outputs for IDABBDPRE - *---------------------------------------------------------------- - * - * IDABBDPrecGetWorkSpace returns the real and integer workspace for - * IBBDPRE. - * IDABBDPrecGetNumGfnEvals returns the number of calls to the - * uer Gres function. - * - * ----------------------------------------------------------------- - */ - -int IDABBDPrecGetWorkSpace(void *bbd_data, long int *lenrwBBDP, long int *leniwBBDP); -int IDABBDPrecGetNumGfnEvals(void *bbd_data, long int *ngevalsBBDP); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/ida/idabbdpre_impl.h b/src/sundials/ida/idabbdpre_impl.h deleted file mode 100755 index 0f8197b6a3..0000000000 --- a/src/sundials/ida/idabbdpre_impl.h +++ /dev/null @@ -1,103 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmers: Alan C. Hindmarsh and Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California - * Produced at the Lawrence Livermore National Laboratory - * All rights reserved - * For details, see sundials/ida/LICENSE - * ----------------------------------------------------------------- - * This is the header file (private version) for the IDABBDPRE - * module, for a band-block-diagonal preconditioner, i.e. a - * block-diagonal matrix with banded blocks, for use with IDA/IDAS - * and IDASpgmr. - * ----------------------------------------------------------------- - */ - -#ifndef _IBBDPRE_IMPL_H -#define _IBBDPRE_IMPL_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include "idabbdpre.h" - -#include "band.h" -#include "iterative.h" -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Prototypes of IDABBDPrecSetup and IDABBDPrecSolve - * ----------------------------------------------------------------- - */ - -int IDABBDPrecSetup(realtype tt, - N_Vector yy, N_Vector yp, N_Vector rr, - realtype c_j, void *prec_data, - N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); - -int IDABBDPrecSolve(realtype tt, - N_Vector yy, N_Vector yp, N_Vector rr, - N_Vector rvec, N_Vector zvec, - realtype c_j, realtype delta, void *prec_data, - N_Vector tmp); - -/* - * ----------------------------------------------------------------- - * Definition of IBBDPrecData - * ----------------------------------------------------------------- - */ - -typedef struct { - - /* passed by user to IDABBDPrecAlloc, used by - IDABBDPrecSetup/IDABBDPrecSolve functions: */ - long int mudq, mldq, mukeep, mlkeep; - realtype rel_yy; - IDABBDLocalFn glocal; - IDABBDCommFn gcomm; - - /* allocated for use by IDABBDPrecSetup */ - N_Vector tempv4; - - /* set by IDABBDPrecon and used by IDABBDPrecSolve: */ - BandMat PP; - long int *pivots; - - /* set by IDABBDPrecAlloc and used by IDABBDPrecSetup */ - long int n_local; - - /* available for optional output: */ - long int rpwsize; - long int ipwsize; - long int nge; - - /* Pointer to ida_mem */ - IDAMem IDA_mem; - -} *IBBDPrecData; - -/* - * ----------------------------------------------------------------- - * Error Messages - * ----------------------------------------------------------------- - */ - -#define MSGBBD_IDAMEM_NULL "IBBDPrecAlloc-- integrator memory is NULL.\n\n" -#define MSGBBD_BAD_NVECTOR "IBBDPrecAlloc-- a required vector operation is not implemented.\n\n" -#define MSGBBD_WRONG_NVEC "IBBDPrecAlloc-- incompatible NVECTOR implementation.\n\n" -#define MSGBBD_PDATA_NULL "IBBDPrecGet*-- BBDPrecData is NULL. \n\n" - -#define MSGBBD_NO_PDATA "IBBDSpgmr-- BBDPrecData is NULL. \n\n" - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/ida/idadense.c b/src/sundials/ida/idadense.c deleted file mode 100755 index 5e2b3c7dcc..0000000000 --- a/src/sundials/ida/idadense.c +++ /dev/null @@ -1,535 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/ida/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for the IDA dense linear - * solver module, IDADENSE. - * ----------------------------------------------------------------- - */ - -#include -#include -#include - -#include "ida_impl.h" -#include "idadense_impl.h" - -#include "sundialsmath.h" - -/* Constants */ - -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) -#define TWO RCONST(2.0) - -/* IDADENSE linit, lsetup, lsolve, and lfree routines */ - -static int IDADenseInit(IDAMem IDA_mem); - -static int IDADenseSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, - N_Vector rrp, N_Vector tmp1, - N_Vector tmp2, N_Vector tmp3); - -static int IDADenseSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, - N_Vector ycur, N_Vector ypcur, N_Vector rrcur); - -static int IDADenseFree(IDAMem IDA_mem); - -static int IDADenseDQJac(long int Neq, realtype tt, N_Vector yy, N_Vector yp, - N_Vector rr, realtype c_j, void *jac_data, DenseMat Jac, - N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); - -/* Readability Replacements */ - -#define res (IDA_mem->ida_res) -#define rdata (IDA_mem->ida_rdata) -#define uround (IDA_mem->ida_uround) -#define tn (IDA_mem->ida_tn) -#define hh (IDA_mem->ida_hh) -#define cj (IDA_mem->ida_cj) -#define cjratio (IDA_mem->ida_cjratio) -#define ewt (IDA_mem->ida_ewt) -#define constraints (IDA_mem->ida_constraints) -#define nre (IDA_mem->ida_nre) -#define errfp (IDA_mem->ida_errfp) -#define iopt (IDA_mem->ida_iopt) -#define linit (IDA_mem->ida_linit) -#define lsetup (IDA_mem->ida_lsetup) -#define lsolve (IDA_mem->ida_lsolve) -#define lperf (IDA_mem->ida_lperf) -#define lfree (IDA_mem->ida_lfree) -#define lmem (IDA_mem->ida_lmem) -#define setupNonNull (IDA_mem->ida_setupNonNull) -#define vec_tmpl (IDA_mem->ida_tempv1) - -#define neq (idadense_mem->d_neq) -#define jac (idadense_mem->d_jac) -#define JJ (idadense_mem->d_J) -#define pivots (idadense_mem->d_pivots) -#define nje (idadense_mem->d_nje) -#define nreD (idadense_mem->d_nreD) -#define jacdata (idadense_mem->d_jdata) -#define last_flag (idadense_mem->d_last_flag) - -/* - * ----------------------------------------------------------------- - * IDADense - * ----------------------------------------------------------------- - * This routine initializes the memory record and sets various function - * fields specific to the IDADENSE linear solver module. - * IDADense first calls the existing lfree routine if this is not NULL. - * Then it sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and - * ida_lfree fields in (*IDA_mem) to be IDADenseInit, IDADenseSetup, - * IDADenseSolve, NULL, and IDADenseFree, respectively. - * It allocates memory for a structure of type IDADenseMemRec and sets - * the ida_lmem field in (*IDA_mem) to the address of this structure. - * It sets setupNonNull in (*IDA_mem) to TRUE, sets the d_jdata field - * in the IDADenseMemRec structure to be the input parameter jdata, - * and sets the d_jac field to be: - * (1) the input parameter djac, if djac != NULL, or - * (2) IDADenseDQJac, if djac == NULL. - * Finally, it allocates memory for JJ and pivots. - * The return value is IDADENSE_SUCCESS = 0, IDADENSE_LMEM_FAIL = -1, - * or IDADENSE_ILL_INPUT = -2. - * - * NOTE: The dense linear solver assumes a serial implementation - * of the NVECTOR package. Therefore, IDADense will first - * test for a compatible N_Vector internal - * representation by checking that the functions N_VGetArrayPointer - * and N_VSetArrayPointer exist. - * ----------------------------------------------------------------- - */ - -int IDADense(void *ida_mem, long int Neq) -{ - IDAMem IDA_mem; - IDADenseMem idadense_mem; - int flag; - - /* Return immediately if ida_mem is NULL. */ - if (ida_mem == NULL) { - fprintf(stderr, MSGD_IDAMEM_NULL); - return(IDADENSE_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - /* Test if the NVECTOR package is compatible with the DENSE solver */ - if(vec_tmpl->ops->nvgetarraypointer == NULL || - vec_tmpl->ops->nvsetarraypointer == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGD_BAD_NVECTOR); - return(IDADENSE_ILL_INPUT); - } - - if (lfree != NULL) flag = lfree(IDA_mem); - - /* Set five main function fields in IDA_mem. */ - linit = IDADenseInit; - lsetup = IDADenseSetup; - lsolve = IDADenseSolve; - lperf = NULL; - lfree = IDADenseFree; - - /* Get memory for IDADenseMemRec. */ - idadense_mem = (IDADenseMem) malloc(sizeof(IDADenseMemRec)); - if (idadense_mem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGD_MEM_FAIL); - return(IDADENSE_MEM_FAIL); - } - - /* Set default Jacobian routine and Jacobian data */ - jac = IDADenseDQJac; - jacdata = IDA_mem; - last_flag = IDADENSE_SUCCESS; - - setupNonNull = TRUE; - - /* Store problem size */ - neq = Neq; - - /* Allocate memory for JJ and pivot array. */ - JJ = DenseAllocMat(Neq); - if (JJ == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGD_MEM_FAIL); - return(IDADENSE_MEM_FAIL); - } - pivots = DenseAllocPiv(Neq); - if (pivots == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGD_MEM_FAIL); - DenseFreeMat(JJ); - return(IDADENSE_MEM_FAIL); - } - - /* Attach linear solver memory to the integrator memory */ - lmem = idadense_mem; - - return(IDADENSE_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * IDADenseSet* and IDADenseGet* - * ----------------------------------------------------------------- - */ - -int IDADenseSetJacFn(void *ida_mem, IDADenseJacFn djac) -{ - IDAMem IDA_mem; - IDADenseMem idadense_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGD_SETGET_IDAMEM_NULL); - return(IDADENSE_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGD_SETGET_LMEM_NULL); - return(IDADENSE_LMEM_NULL); - } - idadense_mem = (IDADenseMem) lmem; - - jac = djac; - - return(IDADENSE_SUCCESS); -} - -int IDADenseSetJacData(void *ida_mem, void *jac_data) -{ - IDAMem IDA_mem; - IDADenseMem idadense_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGD_SETGET_IDAMEM_NULL); - return(IDADENSE_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGD_SETGET_LMEM_NULL); - return(IDADENSE_LMEM_NULL); - } - idadense_mem = (IDADenseMem) lmem; - - jacdata = jac_data; - - return(IDADENSE_SUCCESS); -} - -int IDADenseGetWorkSpace(void *ida_mem, long int *lenrwD, long int *leniwD) -{ - IDAMem IDA_mem; - IDADenseMem idadense_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGD_SETGET_IDAMEM_NULL); - return(IDADENSE_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGD_SETGET_LMEM_NULL); - return(IDADENSE_LMEM_NULL); - } - idadense_mem = (IDADenseMem) lmem; - - *lenrwD = neq*neq; - *leniwD = neq; - - return(IDADENSE_SUCCESS); -} - -int IDADenseGetNumJacEvals(void *ida_mem, long int *njevalsD) -{ - IDAMem IDA_mem; - IDADenseMem idadense_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGD_SETGET_IDAMEM_NULL); - return(IDADENSE_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGD_SETGET_LMEM_NULL); - return(IDADENSE_LMEM_NULL); - } - idadense_mem = (IDADenseMem) lmem; - - *njevalsD = nje; - - return(IDADENSE_SUCCESS); -} - -int IDADenseGetNumResEvals(void *ida_mem, long int *nrevalsD) -{ - IDAMem IDA_mem; - IDADenseMem idadense_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGD_SETGET_IDAMEM_NULL); - return(IDADENSE_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGD_SETGET_LMEM_NULL); - return(IDADENSE_LMEM_NULL); - } - idadense_mem = (IDADenseMem) lmem; - - *nrevalsD = nreD; - - return(IDADENSE_SUCCESS); -} - -int IDADenseGetLastFlag(void *ida_mem, int *flag) -{ - IDAMem IDA_mem; - IDADenseMem idadense_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGD_SETGET_IDAMEM_NULL); - return(IDADENSE_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGD_SETGET_LMEM_NULL); - return(IDADENSE_LMEM_NULL); - } - idadense_mem = (IDADenseMem) lmem; - - *flag = last_flag; - - return(IDADENSE_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * IDADENSE interface functions - * ----------------------------------------------------------------- - */ - -/* - This routine does remaining initializations specific to the IDADENSE - linear solver module. It returns 0. -*/ - -static int IDADenseInit(IDAMem IDA_mem) -{ - IDADenseMem idadense_mem; - - idadense_mem = (IDADenseMem) lmem; - - - nje = 0; - nreD = 0; - - if (jac == NULL) { - jac = IDADenseDQJac; - jacdata = IDA_mem; - } - - last_flag = 0; - return(0); -} - -/* - This routine does the setup operations for the IDADENSE linear - solver module. It calls the Jacobian evaluation routine, - updates counters, and calls the dense LU factorization routine. - The return value is either - IDADENSE_SUCCESS = 0 if successful, - +1 if the jac routine failed recoverably or the - LU factorization failed, or - -1 if the jac routine failed unrecoverably. -*/ - -static int IDADenseSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, - N_Vector rrp, N_Vector tmp1, N_Vector tmp2, - N_Vector tmp3) -{ - int retval; - long int retfac; - IDADenseMem idadense_mem; - - idadense_mem = (IDADenseMem) lmem; - - /* Increment nje counter. */ - nje++; - - /* Zero out JJ; call Jacobian routine jac; return if it failed. */ - DenseZero(JJ); - retval = jac(neq, tn, yyp, ypp, rrp, cj, jacdata, JJ, - tmp1, tmp2, tmp3); - last_flag = retval; - if (retval < 0) return(-1); - if (retval > 0) return(+1); - - /* Do LU factorization of JJ; return success or fail flag. */ - retfac = DenseFactor(JJ, pivots); - - if (retfac != 0) { - last_flag = 1; - return(+1); - } - last_flag = 0; - return(0); -} - -/* - This routine handles the solve operation for the IDADENSE linear - solver module. It calls the dense backsolve routine, scales the - solution vector according to cjratio, then returns IDADENSE_SUCCESS = 0. -*/ - -static int IDADenseSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, - N_Vector ycur, N_Vector ypcur, N_Vector rrcur) -{ - IDADenseMem idadense_mem; - realtype *bd; - - idadense_mem = (IDADenseMem) lmem; - - bd = N_VGetArrayPointer(b); - - DenseBacksolve(JJ, pivots, bd); - - /* Scale the correction to account for change in cj. */ - if (cjratio != ONE) N_VScale(TWO/(ONE + cjratio), b, b); - - last_flag = 0; - return(0); -} - -/* - This routine frees memory specific to the IDADENSE linear solver. -*/ - -static int IDADenseFree(IDAMem IDA_mem) -{ - IDADenseMem idadense_mem; - - idadense_mem = (IDADenseMem) lmem; - - DenseFreeMat(JJ); - DenseFreePiv(pivots); - free(lmem); - - return(0); -} - -/* - * ----------------------------------------------------------------- - * IDADENSE private routines - * ----------------------------------------------------------------- - */ - -/* - This routine generates a dense difference quotient approximation Jac to - the DAE system Jacobian J. It assumes that a dense matrix of type - DenseMat is stored column-wise, and that elements within each column - are contiguous. The address of the jth column of Jac is obtained via - the macro DENSE_COL and this pointer is associated with an N_Vector - using the N_VGetArrayPointer/N_VSetArrayPointer functions. - The jth column of the Jacobian is constructed using a call to the res - routine, and a call to N_VLinearSum. - The return value is either IDADENSE_SUCCESS = 0, or the nonzero value returned - by the res routine, if any. -*/ - -static int IDADenseDQJac(long int Neq, realtype tt, N_Vector yy, N_Vector yp, - N_Vector rr, realtype c_j, void *jac_data, DenseMat Jac, - N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) -{ - realtype inc, inc_inv, yj, ypj, srur, conj; - realtype *tmp2_data, *y_data, *yp_data, *ewt_data, *cns_data = NULL; - N_Vector rtemp, jthCol; - long int j; - int retval=0; - - IDAMem IDA_mem; - IDADenseMem idadense_mem; - - /* jac_data points to IDA_mem */ - IDA_mem = (IDAMem) jac_data; - idadense_mem = (IDADenseMem) lmem; - - /* Save pointer to the array in tmp2 */ - tmp2_data = N_VGetArrayPointer(tmp2); - - /* Rename work vectors for readibility */ - rtemp = tmp1; - jthCol = tmp2; - - /* Obtain pointers to the data for ewt, yy, yp. */ - ewt_data = N_VGetArrayPointer(ewt); - y_data = N_VGetArrayPointer(yy); - yp_data = N_VGetArrayPointer(yp); - if(constraints!=NULL) cns_data = N_VGetArrayPointer(constraints); - - srur = RSqrt(uround); - - for (j=0; j < Neq; j++) { - - /* Generate the jth col of J(tt,yy,yp) as delta(F)/delta(y_j). */ - - /* Set data address of jthCol, and save y_j and yp_j values. */ - N_VSetArrayPointer(DENSE_COL(Jac,j), jthCol); - yj = y_data[j]; - ypj = yp_data[j]; - - /* Set increment inc to y_j based on sqrt(uround)*abs(y_j), with - adjustments using yp_j and ewt_j if this is small, and a further - adjustment to give it the same sign as hh*yp_j. */ - - inc = srur*MAX(ABS(yj),MAX( ABS(hh*ypj), ONE/ewt_data[j])); - if (hh*ypj < ZERO) inc = -inc; - inc = (yj + inc) - yj; - - /* Adjust sign(inc) again if y_j has an inequality constraint. */ - if (constraints != NULL) { - conj = cns_data[j]; - if (ABS(conj) == ONE) {if((yj+inc)*conj < ZERO) inc = -inc;} - else if (ABS(conj) == TWO) {if((yj+inc)*conj <= ZERO) inc = -inc;} - } - - /* Increment y_j and yp_j, call res, and break on error return. */ - y_data[j] += inc; - yp_data[j] += c_j*inc; - - retval = res(tt, yy, yp, rtemp, rdata); - nreD++; - if (retval != IDADENSE_SUCCESS) break; - - /* Construct difference quotient in jthCol */ - inc_inv = ONE/inc; - N_VLinearSum(inc_inv, rtemp, -inc_inv, rr, jthCol); - - DENSE_COL(Jac,j) = N_VGetArrayPointer(jthCol); - - /* reset y_j, yp_j */ - y_data[j] = yj; - yp_data[j] = ypj; - } - - /* Restore original array pointer in tmp2 */ - N_VSetArrayPointer(tmp2_data, tmp2); - - return(retval); - -} diff --git a/src/sundials/ida/idadense.h b/src/sundials/ida/idadense.h deleted file mode 100755 index e6b7c4c983..0000000000 --- a/src/sundials/ida/idadense.h +++ /dev/null @@ -1,197 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/ida/LICENSE. - * ----------------------------------------------------------------- - * This is the header file for the IDA/IDAS dense linear solver - * module, IDADENSE. - * ----------------------------------------------------------------- - */ - -#ifndef _IDADENSE_H -#define _IDADENSE_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include - -#include "dense.h" -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Type : IDADenseJacFn - * ----------------------------------------------------------------- - * A dense Jacobian approximation function djac must have the - * prototype given below. Its parameters are: - * - * Neq is the problem size, and length of all vector arguments. - * - * tt is the current value of the independent variable t. - * - * yy is the current value of the dependent variable vector, - * namely the predicted value of y(t). - * - * yp is the current value of the derivative vector y', - * namely the predicted value of y'(t). - * - * rr is the residual vector F(tt,yy,yp). - * - * c_j is the scalar in the system Jacobian, proportional to 1/hh. - * - * jac_data is a pointer to user Jacobian data - the same as the - * jdata parameter passed to IDADense. - * - * Jac is the dense matrix (of type DenseMat) to be loaded by - * an IDADenseJacFn routine with an approximation to the - * system Jacobian matrix - * J = dF/dy + c_j*dF/dy' - * at the given point (t,y,y'), where the DAE system is - * given by F(t,y,y') = 0. Jac is preset to zero, so only - * the nonzero elements need to be loaded. See note below. - * - * tmp1, tmp2, tmp3 are pointers to memory allocated for - * N_Vectors which can be used by an IDADenseJacFn routine - * as temporary storage or work space. - * - * NOTE: The following are two efficient ways to load Jac: - * (1) (with macros - no explicit data structure references) - * for (j=0; j < Neq; j++) { - * col_j = DENSE_COL(Jac,j); - * for (i=0; i < Neq; i++) { - * generate J_ij = the (i,j)th Jacobian element - * col_j[i] = J_ij; - * } - * } - * (2) (without macros - explicit data structure references) - * for (j=0; j < Neq; j++) { - * col_j = (Jac->data)[j]; - * for (i=0; i < Neq; i++) { - * generate J_ij = the (i,j)th Jacobian element - * col_j[i] = J_ij; - * } - * } - * A third way, using the DENSE_ELEM(A,i,j) macro, is much less - * efficient in general. It is only appropriate for use in small - * problems in which efficiency of access is NOT a major concern. - * - * NOTE: If the user's Jacobian routine needs other quantities, - * they are accessible as follows: hcur (the current stepsize) - * and ewt (the error weight vector) are accessible through - * IDAGetCurrentStep and IDAGetErrWeights, respectively (see - * ida.h). The unit roundoff is available as - * UNIT_ROUNDOFF defined in sundialstypes.h - * - * The IDADenseJacFn should return - * 0 if successful, - * a positive int if a recoverable error occurred, or - * a negative int if a nonrecoverable error occurred. - * In the case of a recoverable error return, the integrator will - * attempt to recover by reducing the stepsize (which changes cj). - * ----------------------------------------------------------------- - */ - -typedef int (*IDADenseJacFn)(long int Neq, realtype tt, - N_Vector yy, N_Vector yp, N_Vector rr, - realtype c_j, void *jac_data, - DenseMat Jac, - N_Vector tmp1, N_Vector tmp2, - N_Vector tmp3); - -/* - * ----------------------------------------------------------------- - * Function : IDADense - * ----------------------------------------------------------------- - * A call to the IDADense function links the main integrator - * with the IDADENSE linear solver module. - * - * ida_mem is the pointer to integrator memory returned by - * IDACreate. - * - * Neq is the problem size - * - * IDADense returns: - * IDADENSE_SUCCESS = 0 if successful - * IDADENSE_LMEM_FAIL = -1 if there was a memory allocation failure - * IDADENSE_ILL_INPUT = -2 if NVECTOR found incompatible - * - * NOTE: The dense linear solver assumes a serial implementation - * of the NVECTOR package. Therefore, IDADense will first - * test for a compatible N_Vector internal representation - * by checking that the functions N_VGetArrayPointer and - * N_VSetArrayPointer exist. - * ----------------------------------------------------------------- - */ - -int IDADense(void *ida_mem, long int Neq); - -/* - * ----------------------------------------------------------------- - * Optional inputs to the IDADENSE linear solver - * ----------------------------------------------------------------- - * IDADenseSetJacFn specifies the dense Jacobian approximation - * routine to be used. A user-supplied djac routine must - * be of type IDADenseJacFn. - * By default, a difference quotient routine IDADenseDQJac, - * supplied with this solver is used. - * IDADenseSetJacData specifies a pointer to user data which is - * passed to the djac routine every time it is called. - * - * The return value of IDADenseSet* is one of: - * IDADENSE_SUCCESS if successful - * IDADENSE_MEM_NULL if the ida memory was NULL - * IDaDENSE_LMEM_NULL if the idadense memory was NULL - * ----------------------------------------------------------------- - */ - -int IDADenseSetJacFn(void *ida_mem, IDADenseJacFn djac); -int IDADenseSetJacData(void *ida_mem, void *jac_data); - -/* - * ----------------------------------------------------------------- - * Optional outputs from the IDADENSE linear solver - * ----------------------------------------------------------------- - * IDADenseGetWorkSpace returns the real and integer workspace used - * by IDADENSE. - * IDADenseGetNumJacEvals returns the number of calls made to the - * Jacobian evaluation routine djac. - * IDADenseGetNumResEvals returns the number of calls to the user - * res routine due to finite difference Jacobian evaluation. - * IDADenseGetLastFlag returns the last error flag set by any of - * the IDADENSE interface functions. - * - * The return value of IDADenseGet* is one of: - * IDADENSE_SUCCESS if successful - * IDADENSE_MEM_NULL if the ida memory was NULL - * IDaDENSE_LMEM_NULL if the idadense memory was NULL - * ----------------------------------------------------------------- - */ - -int IDADenseGetWorkSpace(void *ida_mem, long int *lenrwD, long int *leniwD); -int IDADenseGetNumJacEvals(void *ida_mem, long int *njevalsD); -int IDADenseGetNumResEvals(void *ida_mem, long int *nrevalsD); -int IDADenseGetLastFlag(void *ida_mem, int *flag); - -/* IDADENSE return values */ - -#define IDADENSE_SUCCESS 0 -#define IDADENSE_MEM_NULL -1 -#define IDADENSE_LMEM_NULL -2 -#define IDADENSE_ILL_INPUT -3 -#define IDADENSE_MEM_FAIL -4 - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/ida/idadense_impl.h b/src/sundials/ida/idadense_impl.h deleted file mode 100755 index bcca08205e..0000000000 --- a/src/sundials/ida/idadense_impl.h +++ /dev/null @@ -1,82 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmers: Alan C. Hindmarsh and Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California - * Produced at the Lawrence Livermore National Laboratory - * All rights reserved - * For details, see sundials/idas/LICENSE - * ----------------------------------------------------------------- - * This is the header file (private version) for the IDA/IDAS dense - * linear solver module, IDADENSE. - * ----------------------------------------------------------------- - */ - -#ifndef _IDADENSE_IMPL_H -#define _IDADENSE_IMPL_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include - -#include "idadense.h" - -#include "dense.h" -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Types : IDADenseMemRec, IDADenseMem - * ----------------------------------------------------------------- - */ - -typedef struct { - - long int d_neq; /* Neq = problem dimension */ - - IDADenseJacFn d_jac; /* jac = Jacobian routine to be called */ - - DenseMat d_J; /* J = dF/dy + cj*dF/dy' */ - - long int *d_pivots; /* pivots = pivot array for PJ = LU */ - - long int d_nje; /* nje = no. of calls to jac */ - - long int d_nreD; /* nreD = no. of calls to res due to - diff. quotient Jacobian evaluation */ - - void *d_jdata; /* jdata is passed to jac */ - - int d_last_flag; /* last error return flag */ - -} IDADenseMemRec, *IDADenseMem; - -/* - * ----------------------------------------------------------------- - * Error Messages - * ----------------------------------------------------------------- - */ - -#define MSGD_IDAMEM_NULL "IDADense-- integrator memory is NULL.\n\n" - -#define MSGD_MEM_FAIL "IDADense-- a memory request failed.\n\n" - -#define MSGD_BAD_NVECTOR "IDADense-- a required vector operation is not implemented.\n\n" - -#define MSGD_WRONG_NVEC "IDADense-- incompatible NVECTOR implementation.\n\n" - -#define MSGD_SETGET_IDAMEM_NULL "IDADenseSet*/IDADenseGet*-- integrator memory is NULL. \n\n" - -#define MSGD_SETGET_LMEM_NULL "IDADenseSet*/IDADenseGet*-- IDADENSE memory is NULL. \n\n" - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/ida/idaic.c b/src/sundials/ida/idaic.c deleted file mode 100755 index f48ed85a9c..0000000000 --- a/src/sundials/ida/idaic.c +++ /dev/null @@ -1,703 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmers: Alan C. Hindmarsh, and Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California - * Produced at the Lawrence Livermore National Laboratory - * All rights reserved - * For details, see sundials/ida/LICENSE - * ----------------------------------------------------------------- - * This is the implementation file for the IC calculation for IDA. - * It is independent of the linear solver in use. - * ----------------------------------------------------------------- - */ - -#include -#include -#include "ida_impl.h" -#include "sundialsmath.h" - -/* Macro: loop */ -#define loop for(;;) - -/* - * ================================================================= - * IDA Constants - * ================================================================= - */ - -/* Private Constants */ - -#define ZERO RCONST(0.0) /* real 0.0 */ -#define HALF RCONST(0.5) /* real 0.5 */ -#define ONE RCONST(1.0) /* real 1.0 */ -#define TWO RCONST(2.0) /* real 2.0 */ -#define PT99 RCONST(0.99) /* real 0.99 */ -#define PT1 RCONST(0.1) /* real 0.1 */ -#define PT001 RCONST(0.001) /* real 0.001 */ - -/* IDACalcIC control constants */ - -#define ICRATEMAX RCONST(0.9) /* max. Newton conv. rate */ -#define ALPHALS RCONST(0.0001) /* alpha in linesearch conv. test */ - -/* Return values for lower level routines used by IDACalcIC */ - -#define IC_FAIL_RECOV 1 -#define IC_CONSTR_FAILED 2 -#define IC_LINESRCH_FAILED 3 -#define IC_CONV_FAIL 4 -#define IC_SLOW_CONVRG 5 - -/* - * ================================================================= - * Private Helper Functions Prototypes - * ================================================================= - */ - -extern int IDAInitialSetup(IDAMem IDA_mem); -extern booleantype IDAEwtSet(IDAMem IDA_mem, N_Vector ycur); -extern realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w, - booleantype mask); - -static int IDAnlsIC (IDAMem IDA_mem); -static int IDANewtonIC (IDAMem IDA_mem); -static int IDALineSrch (IDAMem IDA_mem, realtype *delnorm, realtype *fnorm); -static int IDAfnorm (IDAMem IDA_mem, realtype *fnorm); -static int IDANewyyp (IDAMem IDA_mem, realtype lambda); -static int IDANewy (IDAMem IDA_mem); -static int IDAICFailFlag (IDAMem IDA_mem, int retval); - -/* - * ================================================================= - * Readibility Constants - * ================================================================= - */ - -#define errfp (IDA_mem->ida_errfp) -#define rdata (IDA_mem->ida_rdata) -#define res (IDA_mem->ida_res) -#define y0 (IDA_mem->ida_y0) -#define yp0 (IDA_mem->ida_yp0) -#define uround (IDA_mem->ida_uround) -#define phi (IDA_mem->ida_phi) -#define ewt (IDA_mem->ida_ewt) -#define delta (IDA_mem->ida_delta) -#define ee (IDA_mem->ida_ee) -#define savres (IDA_mem->ida_savres) -#define tempv2 (IDA_mem->ida_tempv2) -#define hh (IDA_mem->ida_hh) -#define tn (IDA_mem->ida_tn) -#define cj (IDA_mem->ida_cj) -#define cjratio (IDA_mem->ida_cjratio) -#define nbacktr (IDA_mem->ida_nbacktr) -#define nre (IDA_mem->ida_nre) -#define ncfn (IDA_mem->ida_ncfn) -#define nni (IDA_mem->ida_nni) -#define nsetups (IDA_mem->ida_nsetups) -#define ns (IDA_mem->ida_ns) -#define lsetup (IDA_mem->ida_lsetup) -#define lsolve (IDA_mem->ida_lsolve) -#define hused (IDA_mem->ida_hused) -#define epsNewt (IDA_mem->ida_epsNewt) -#define id (IDA_mem->ida_id) -#define setupNonNull (IDA_mem->ida_setupNonNull) -#define suppressalg (IDA_mem->ida_suppressalg) -#define constraints (IDA_mem->ida_constraints) -#define constraintsSet (IDA_mem->ida_constraintsSet) - -#define epiccon (IDA_mem->ida_epiccon) -#define maxnh (IDA_mem->ida_maxnh) -#define maxnj (IDA_mem->ida_maxnj) -#define maxnit (IDA_mem->ida_maxnit) -#define lsoff (IDA_mem->ida_lsoff) -#define steptol (IDA_mem->ida_steptol) - -/* - * ================================================================= - * EXPORTED FUNCTIONS IMPLEMENTATION - * ================================================================= - */ - -/* - * ----------------------------------------------------------------- - * IDACalcIC - * ----------------------------------------------------------------- - * IDACalcIC computes consistent initial conditions, given the - * user's initial guess for unknown components of y0 and/or yp0. - * - * The return value is IDA_SUCCESS = 0 if no error occurred. - * - * The error return values (fully described in ida.h) are: - * IDA_MEM_NULL ida_mem is NULL - * IDA_NO_MALLOC ida_mem was not allocated - * IDA_ILL_INPUT bad value for icopt, tout1, or id - * IDA_LINIT_FAIL the linear solver linit routine failed - * IDA_BAD_EWT zero value of some component of ewt - * IDA_RES_FAIL res had a non-recoverable error - * IDA_FIRST_RES_FAIL res failed recoverably on the first call - * IDA_LSETUP_FAIL lsetup had a non-recoverable error - * IDA_LSOLVE_FAIL lsolve had a non-recoverable error - * IDA_NO_RECOVERY res, lsetup, or lsolve had a recoverable - * error, but IDACalcIC could not recover - * IDA_CONSTR_FAIL the inequality constraints could not be met - * IDA_LINESEARCH_FAIL the linesearch failed (on steptol test) - * IDA_CONV_FAIL the Newton iterations failed to converge - * ----------------------------------------------------------------- - */ - -int IDACalcIC (void *ida_mem, int icopt, realtype tout1) -{ - booleantype ewtsetOK; - int ier, nwt, nh, mxnh, icret, retval=0; - realtype tdist, troundoff, minid, hic, ypnorm; - IDAMem IDA_mem; - - /* Check if IDA memory exists */ - - if (ida_mem == NULL) { - fprintf(stderr, MSG_IC_NO_MEM); - return(IDA_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - /* Check if problem was malloc'ed */ - - if (IDA_mem->ida_MallocDone == FALSE) { - if(errfp!=NULL) fprintf(errfp, MSG_IC_NO_MALLOC); - return(IDA_NO_MALLOC); - } - - /* Check inputs to IDA for correctness and consistency */ - - ier = IDAInitialSetup(IDA_mem); - if (ier != IDA_SUCCESS) return(IDA_ILL_INPUT); - IDA_mem->ida_SetupDone = TRUE; - - /* Check legality of input arguments, and set IDA memory copies. */ - - if (icopt < IDA_YA_YDP_INIT || icopt > IDA_Y_INIT) { - if(errfp!=NULL) fprintf(errfp, MSG_IC_BAD_ICOPT); - return(IDA_ILL_INPUT); - } - IDA_mem->ida_icopt = icopt; - - if (icopt == IDA_YA_YDP_INIT && (id == NULL)) { - if(errfp!=NULL) fprintf(errfp, MSG_IC_MISSING_ID); - return(IDA_ILL_INPUT); - } - - tdist = ABS(tout1 - tn); - troundoff = TWO*uround*(ABS(tn) + ABS(tout1)); - if (tdist < troundoff) { - if(errfp!=NULL) fprintf(errfp, MSG_IC_TOO_CLOSE); - return(IDA_ILL_INPUT); - } - - /* For use in the IDA_YA_YP_INIT case, set sysindex and tscale. */ - - IDA_mem->ida_sysindex = 1; - IDA_mem->ida_tscale = tdist; - if (icopt == IDA_YA_YDP_INIT) { - minid = N_VMin(id); - if (minid < ZERO) { - if(errfp!=NULL) fprintf(errfp, MSG_IC_BAD_ID); - return(IDA_ILL_INPUT); - } - if (minid > HALF) IDA_mem->ida_sysindex = 0; - } - - /* Set the test constant in the Newton convergence test */ - - IDA_mem->ida_epsNewt = epiccon; - - /* Initializations: - cjratio = 1 (for use in direct linear solvers); - set nbacktr = 0; */ - - cjratio = ONE; - nbacktr = 0; - - /* Set hic, hh, cj, and mxnh. */ - hic = PT001*tdist; - ypnorm = IDAWrmsNorm(IDA_mem, yp0, ewt, suppressalg); - if (ypnorm > HALF/hic) hic = HALF/ypnorm; - if( tout1 < tn) hic = -hic; - hh = hic; - if (icopt == IDA_YA_YDP_INIT) { - cj = ONE/hic; - mxnh = maxnh; - } - else { - cj = ZERO; - mxnh = 1; - } - - /* Loop over nwt = number of evaluations of ewt vector. */ - - for (nwt = 1; nwt <= 2; nwt++) { - - /* Loop over nh = number of h values. */ - for (nh = 1; nh <= mxnh; nh++) { - - /* Call the IC nonlinear solver function. */ - retval = IDAnlsIC(IDA_mem); - - /* Cut h and loop on recoverable IDA_YA_YDP_INIT failure; else break. */ - if (retval == IDA_SUCCESS) break; - ncfn++; - if (retval < 0) break; - if (nh == mxnh) break; - /* If looping to try again, reset y0 and yp0 if not converging. */ - if (retval != IC_SLOW_CONVRG) { - N_VScale (ONE, phi[0], y0); - N_VScale (ONE, phi[1], yp0); - } - hic *= PT1; - cj = ONE/hic; - hh = hic; - } /* End of nh loop */ - - /* Break on failure; else reset ewt, save y0,yp0 in phi, and loop. */ - if (retval != IDA_SUCCESS) break; - ewtsetOK = IDAEwtSet(IDA_mem, y0); - if (!ewtsetOK) { retval = IDA_BAD_EWT; break; } - N_VScale (ONE, y0, phi[0]); - N_VScale (ONE, yp0, phi[1]); - - } /* End of nwt loop */ - - - /* Load the optional outputs. */ - if (icopt == IDA_YA_YDP_INIT) hused = hic; - - /* On any failure, print message and return proper flag. */ - if (retval != IDA_SUCCESS) { - icret = IDAICFailFlag(IDA_mem, retval); - return(icret); - } - - /* Otherwise return success flag. */ - return(IDA_SUCCESS); - -} - -/* - * ================================================================= - * PRIVATE FUNCTIONS IMPLEMENTATION - * ================================================================= - */ - -#define icopt (IDA_mem->ida_icopt) -#define sysindex (IDA_mem->ida_sysindex) -#define tscale (IDA_mem->ida_tscale) -#define ynew (IDA_mem->ida_ynew) -#define ypnew (IDA_mem->ida_ypnew) -#define delnew (IDA_mem->ida_delnew) -#define dtemp (IDA_mem->ida_dtemp) - -/* - * ----------------------------------------------------------------- - * IDAnlsIC - * ----------------------------------------------------------------- - * IDAnlsIC solves a nonlinear system for consistent initial - * conditions. It calls IDANewtonIC to do most of the work. - * - * The return value is IDA_SUCCESS = 0 if no error occurred. - * The error return values (positive) considered recoverable are: - * IC_FAIL_RECOV if res, lsetup, or lsolve failed recoverably - * IC_CONSTR_FAILED if the constraints could not be met - * IC_LINESRCH_FAILED if the linesearch failed (on steptol test) - * IC_CONV_FAIL if the Newton iterations failed to converge - * IC_SLOW_CONVRG if the iterations are converging slowly - * (failed the convergence test, but showed - * norm reduction or convergence rate < 1) - * The error return values (negative) considered non-recoverable are: - * IDA_RES_FAIL if res had a non-recoverable error - * IDA_FIRST_RES_FAIL if res failed recoverably on the first call - * SETUP_FAILURE if lsetup had a non-recoverable error - * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error - * ----------------------------------------------------------------- - */ - -static int IDAnlsIC (IDAMem IDA_mem) -{ - int retval, nj; - N_Vector tv1, tv2, tv3; - - tv1 = ee; - tv2 = tempv2; - tv3 = phi[2]; - - retval = res(tn, y0, yp0, delta, rdata); - nre++; - if(retval < 0) return(IDA_RES_FAIL); - if(retval > 0) return(IDA_FIRST_RES_FAIL); - - N_VScale (ONE, delta, savres); - - /* Loop over nj = number of linear solve Jacobian setups. */ - - for (nj = 1; nj <= maxnj; nj++) { - - /* If there is a setup routine, call it. */ - if (setupNonNull) { - nsetups++; - retval = lsetup(IDA_mem, y0, yp0, delta, tv1, tv2, tv3); - if(retval < 0) return(IDA_LSETUP_FAIL); - if(retval > 0) return(IC_FAIL_RECOV); - } - - /* Call the Newton iteration routine, and return if successful. */ - retval = IDANewtonIC(IDA_mem); - if (retval == IDA_SUCCESS) return(IDA_SUCCESS); - - /* If converging slowly and lsetup is nontrivial, retry. */ - if (retval == IC_SLOW_CONVRG && setupNonNull) { - N_VScale (ONE, savres, delta); - continue; - } else { - return(retval); - } - - } /* End of nj loop */ - - /* No convergence after maxnj tries; return with retval=IC_SLOW_CONVRG */ - return(retval); - -} - -/* - * ----------------------------------------------------------------- - * IDANewtonIC - * ----------------------------------------------------------------- - * IDANewtonIC performs the Newton iteration to solve for consistent - * initial conditions. It calls IDALineSrch within each iteration. - * On return, savres contains the current residual vector. - * - * The return value is IDA_SUCCESS = 0 if no error occurred. - * The error return values (positive) considered recoverable are: - * IC_FAIL_RECOV if res or lsolve failed recoverably - * IC_CONSTR_FAILED if the constraints could not be met - * IC_LINESRCH_FAILED if the linesearch failed (on steptol test) - * IC_CONV_FAIL if the Newton iterations failed to converge - * IC_SLOW_CONVRG if the iterations appear to be converging slowly. - * They failed the convergence test, but showed - * an overall norm reduction (by a factor of < 0.1) - * or a convergence rate <= ICRATEMAX). - * The error return values (negative) considered non-recoverable are: - * IDA_RES_FAIL if res had a non-recoverable error - * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error - * ----------------------------------------------------------------- - */ - -static int IDANewtonIC (IDAMem IDA_mem) -{ - int retval, mnewt; - realtype delnorm, fnorm, fnorm0, oldfnrm, rate=0.0; - - /* Set pointer for vector delnew */ - delnew = phi[2]; - - /* Call the linear solve function to get the Newton step, delta. */ - retval = lsolve(IDA_mem, delta, ewt, y0, yp0, savres); - if(retval < 0) return(IDA_LSOLVE_FAIL); - if(retval > 0) return(IC_FAIL_RECOV); - - /* Compute the norm of the step; return now if this is small. */ - fnorm = IDAWrmsNorm(IDA_mem, delta, ewt, FALSE); - if (sysindex == 0) fnorm *= tscale*ABS(cj); - if (fnorm <= epsNewt) return(IDA_SUCCESS); - fnorm0 = fnorm; - - /* Newton iteration loop */ - - for (mnewt = 0; mnewt < maxnit; mnewt++) { - - nni++; - delnorm = fnorm; - oldfnrm = fnorm; - - /* Call the Linesearch function and return if it failed. */ - retval = IDALineSrch(IDA_mem, &delnorm, &fnorm); - if (retval != IDA_SUCCESS) return(retval); - - /* Set the observed convergence rate and test for convergence. */ - rate = fnorm/oldfnrm; - if (fnorm <= epsNewt) return(IDA_SUCCESS); - - /* If not converged, copy new step vector, and loop. */ - N_VScale(ONE, delnew, delta); - - } /* End of Newton iteration loop */ - - /* Return either IC_SLOW_CONVRG or recoverable fail flag. */ - if (rate <= ICRATEMAX || fnorm < PT1*fnorm0) return(IC_SLOW_CONVRG); - return(IC_CONV_FAIL); - -} - - -/* - * ----------------------------------------------------------------- - * IDALineSrch - * ----------------------------------------------------------------- - * IDALineSrch performs the Linesearch algorithm with the - * calculation of consistent initial conditions. - * - * On entry, y0 and yp0 are the current values of y and y', the - * Newton step is delta, the current residual vector F is savres, - * delnorm is WRMS-norm(delta), and fnorm is the norm of the vector - * J-inverse F. - * - * On a successful return, y0, yp0, and savres have been updated, - * delnew contains the current value of J-inverse F, and fnorm is - * WRMS-norm(delnew). - * - * The return value is IDA_SUCCESS = 0 if no error occurred. - * The error return values (positive) considered recoverable are: - * IC_FAIL_RECOV if res or lsolve failed recoverably - * IC_CONSTR_FAILED if the constraints could not be met - * IC_LINESRCH_FAILED if the linesearch failed (on steptol test) - * The error return values (negative) considered non-recoverable are: - * IDA_RES_FAIL if res had a non-recoverable error - * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error - * ----------------------------------------------------------------- - */ - -static int IDALineSrch (IDAMem IDA_mem, realtype *delnorm, realtype *fnorm) -{ - booleantype conOK; - int retval; - realtype f1norm, fnormp, f1normp, ratio, lambda, minlam, slpi; - N_Vector mc; - - /* Initialize work space pointers, f1norm, ratio. - (Use of mc in constraint check does not conflict with ypnew.) */ - mc = ee; - dtemp = phi[3]; - ynew = tempv2; - ypnew = ee; - f1norm = (*fnorm)*(*fnorm)*HALF; - ratio = ONE; - - /* If there are constraints, check and reduce step if necessary. */ - if (constraintsSet) { - - /* Update y and check constraints. */ - IDANewy(IDA_mem); - conOK = N_VConstrMask (constraints, ynew, mc); - - if (!conOK) { - /* Not satisfied. Compute scaled step to satisfy constraints. */ - N_VProd (mc, delta, dtemp); - ratio = PT99*N_VMinQuotient (y0, dtemp); - (*delnorm) *= ratio; - if ((*delnorm) <= steptol) return(IC_CONSTR_FAILED); - N_VScale (ratio, delta, delta); - } - - } /* End of constraints check */ - - slpi = -TWO*f1norm*ratio; - minlam = steptol/(*delnorm); - lambda = ONE; - - /* In IDA_Y_INIT case, set ypnew = yp0 (fixed) for linesearch. */ - if (icopt == IDA_Y_INIT) N_VScale (ONE, yp0, ypnew); - - /* Loop on linesearch variable lambda. */ - - loop { - - /* Get new (y,y') = (ynew,ypnew) and norm of new function value. */ - IDANewyyp(IDA_mem, lambda); - retval = IDAfnorm(IDA_mem, &fnormp); - if (retval != IDA_SUCCESS) return(retval); - - /* If lsoff option is on, break out. */ - if (lsoff) break; - - /* Do alpha-condition test. */ - f1normp = fnormp*fnormp*HALF; - if (f1normp <= f1norm + ALPHALS*slpi*lambda) break; - if (lambda < minlam) return(IC_LINESRCH_FAILED); - lambda /= TWO; - nbacktr++; - - } /* End of breakout linesearch loop */ - - /* Update y0, yp0, and fnorm, then return. */ - N_VScale (ONE, ynew, y0); - if (icopt == IDA_YA_YDP_INIT) N_VScale (ONE, ypnew, yp0); - *fnorm = fnormp; - return(IDA_SUCCESS); - -} - -/* - * ----------------------------------------------------------------- - * IDAfnorm - * ----------------------------------------------------------------- - * IDAfnorm computes the norm of the current function value, by - * evaluating the DAE residual function, calling the linear - * system solver, and computing a WRMS-norm. - * - * On return, savres contains the current residual vector F, and - * delnew contains J-inverse F. - * - * The return value is IDA_SUCCESS = 0 if no error occurred, or - * IC_FAIL_RECOV if res or lsolve failed recoverably, or - * IDA_RES_FAIL if res had a non-recoverable error, or - * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error. - * ----------------------------------------------------------------- - */ - -static int IDAfnorm (IDAMem IDA_mem, realtype *fnorm) -{ - - int retval; - - /* Get residual vector F, return if failed, and save F in savres. */ - retval = res(tn, ynew, ypnew, delnew, rdata); - nre++; - if(retval < 0) return(IDA_RES_FAIL); - if(retval > 0) return(IC_FAIL_RECOV); - - N_VScale (ONE, delnew, savres); - - /* Call the linear solve function to get J-inverse F; return if failed. */ - retval = lsolve(IDA_mem, delnew, ewt, ynew, ypnew, savres); - if(retval < 0) return(IDA_LSOLVE_FAIL); - if(retval > 0) return(IC_FAIL_RECOV); - - /* Compute the WRMS-norm; rescale if index = 0. */ - *fnorm = IDAWrmsNorm(IDA_mem, delnew, ewt, FALSE); - if (sysindex == 0) (*fnorm) *= tscale*ABS(cj); - - return(IDA_SUCCESS); - -} - -/* - * ----------------------------------------------------------------- - * IDANewyyp - * ----------------------------------------------------------------- - * IDANewyyp updates the vectors ynew and ypnew from y0 and yp0, - * using the current step vector lambda*delta, in a manner - * depending on icopt and the input id vector. - * - * The return value is always IDA_SUCCESS = 0. - * ----------------------------------------------------------------- - */ - -static int IDANewyyp (IDAMem IDA_mem, realtype lambda) -{ - - /* IDA_YA_YDP_INIT case: ynew = y0 - lambda*delta where id_i = 0 - ypnew = yp0 - cj*lambda*delta where id_i = 1. */ - if (icopt == IDA_YA_YDP_INIT) { - N_VProd (id, delta, dtemp); - N_VLinearSum (ONE, yp0, -cj*lambda, dtemp, ypnew); - N_VLinearSum (ONE, delta, -ONE, dtemp, dtemp); - N_VLinearSum (ONE, y0, -lambda, dtemp, ynew); - return(IDA_SUCCESS); - } - - /* IDA_Y_INIT case: ynew = y0 - lambda*delta. (ypnew = yp0 preset.) */ - N_VLinearSum (ONE, y0, -lambda, delta, ynew); - return(IDA_SUCCESS); - -} - -/* - * ----------------------------------------------------------------- - * IDANewy - * ----------------------------------------------------------------- - * IDANewy updates the vector ynew from y0, - * using the current step vector delta, in a manner - * depending on icopt and the input id vector. - * - * The return value is always IDA_SUCCESS = 0. - * ----------------------------------------------------------------- - */ - -static int IDANewy (IDAMem IDA_mem) -{ - - /* IDA_YA_YDP_INIT case: ynew = y0 - delta where id_i = 0. */ - if (icopt == IDA_YA_YDP_INIT) { - N_VProd (id, delta, dtemp); - N_VLinearSum (ONE, delta, -ONE, dtemp, dtemp); - N_VLinearSum (ONE, y0, -ONE, dtemp, ynew); - return(IDA_SUCCESS); - } - - /* IDA_Y_INIT case: ynew = y0 - delta. */ - N_VLinearSum (ONE, y0, -ONE, delta, ynew); - return(IDA_SUCCESS); - -} - -/* - * ----------------------------------------------------------------- - * IDAICFailFlag - * ----------------------------------------------------------------- - * IDAICFailFlag prints a message and sets the IDACalcIC return - * value appropriate to the flag retval returned by IDAnlsIC. - * ----------------------------------------------------------------- - */ - -static int IDAICFailFlag (IDAMem IDA_mem, int retval) -{ - - /* Depending on retval, print error message and return error flag. */ - switch (retval) { - - case IDA_RES_FAIL: - if(errfp!=NULL) fprintf(errfp, MSG_IC_RES_NONREC); - return(IDA_RES_FAIL); - - case IDA_FIRST_RES_FAIL: - if(errfp!=NULL) fprintf(errfp, MSG_IC_RES_FAIL); - return(IDA_FIRST_RES_FAIL); - - case IDA_LSETUP_FAIL: - if(errfp!=NULL) fprintf(errfp, MSG_IC_SETUP_FAIL); - return(IDA_LSETUP_FAIL); - - case IDA_LSOLVE_FAIL: - if(errfp!=NULL) fprintf(errfp, MSG_IC_SOLVE_FAIL); - return(IDA_LSOLVE_FAIL); - - case IC_FAIL_RECOV: - if(errfp!=NULL) fprintf(errfp, MSG_IC_NO_RECOVERY); - return(IDA_NO_RECOVERY); - - case IC_CONSTR_FAILED: - if(errfp!=NULL) fprintf(errfp, MSG_IC_FAIL_CONSTR); - return(IDA_CONSTR_FAIL); - - case IC_LINESRCH_FAILED: - if(errfp!=NULL) fprintf(errfp, MSG_IC_FAILED_LINS); - return(IDA_LINESEARCH_FAIL); - - case IC_CONV_FAIL: - if(errfp!=NULL) fprintf(errfp, MSG_IC_CONV_FAILED); - return(IDA_CONV_FAIL); - - case IC_SLOW_CONVRG: - if(errfp!=NULL) fprintf(errfp, MSG_IC_CONV_FAILED); - return(IDA_CONV_FAIL); - - case IDA_BAD_EWT: - if(errfp!=NULL) fprintf(errfp, MSG_IC_BAD_EWT); - return(IDA_BAD_EWT); - - } - return -99; -} - diff --git a/src/sundials/ida/idaio.c b/src/sundials/ida/idaio.c deleted file mode 100755 index 357d81a444..0000000000 --- a/src/sundials/ida/idaio.c +++ /dev/null @@ -1,863 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmers: Alan C. Hindmarsh, and Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California - * Produced at the Lawrence Livermore National Laboratory - * All rights reserved - * For details, see sundials/ida/LICENSE - * ----------------------------------------------------------------- - * This is the implementation file for the optional inputs and - * outputs for the IDA solver. - * ----------------------------------------------------------------- - */ - -#include -#include -#include "ida_impl.h" - -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) - -/* - * ================================================================= - * IDA optional input functions - * ================================================================= - */ - -int IDASetErrFile(void *ida_mem, FILE *errfp) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - IDA_mem->ida_errfp = errfp; - - return(IDA_SUCCESS); -} - -#define errfp (IDA_mem->ida_errfp) - -/*-----------------------------------------------------------------*/ - -int IDASetRdata(void *ida_mem, void *res_data) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - IDA_mem->ida_rdata = res_data; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetMaxOrd(void *ida_mem, int maxord) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - if (maxord <= 0) { - if(errfp!=NULL) fprintf(errfp, MSG_IDAS_NEG_MAXORD); - return(IDA_ILL_INPUT); - } - - if (maxord > IDA_mem->ida_maxord) { - if(errfp!=NULL) fprintf(errfp, MSG_IDAS_BAD_MAXORD); - return(IDA_ILL_INPUT); - } - - IDA_mem->ida_maxord = maxord; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetMaxNumSteps(void *ida_mem, long int mxsteps) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - if (mxsteps <= 0) { - if(errfp!=NULL) fprintf(errfp, MSG_IDAS_NEG_MXSTEPS); - return(IDA_ILL_INPUT); - } - - IDA_mem->ida_mxstep = mxsteps; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetInitStep(void *ida_mem, realtype hin) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - IDA_mem->ida_hin = hin; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetMaxStep(void *ida_mem, realtype hmax) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - if (hmax <= 0) { - if(errfp!=NULL) fprintf(errfp, MSG_IDAS_NEG_HMAX); - return(IDA_ILL_INPUT); - } - - IDA_mem->ida_hmax_inv = ONE/hmax; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetStopTime(void *ida_mem, realtype tstop) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - IDA_mem->ida_tstop = tstop; - IDA_mem->ida_tstopset = TRUE; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetNonlinConvCoef(void *ida_mem, realtype epcon) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - if (epcon < ZERO) { - if(errfp!=NULL) fprintf(errfp, MSG_IDAS_NEG_EPCON); - return(IDA_ILL_INPUT); - } - - IDA_mem->ida_epcon = epcon; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetMaxErrTestFails(void *ida_mem, int maxnef) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return (IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - IDA_mem->ida_maxnef = maxnef; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetMaxConvFails(void *ida_mem, int maxncf) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return (IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - IDA_mem->ida_maxncf = maxncf; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetMaxNonlinIters(void *ida_mem, int maxcor) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return (IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - IDA_mem->ida_maxcor = maxcor; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetSuppressAlg(void *ida_mem, booleantype suppressalg) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - IDA_mem->ida_suppressalg = suppressalg; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetId(void *ida_mem, N_Vector id) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - IDA_mem->ida_id = id; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetConstraints(void *ida_mem, N_Vector constraints) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - IDA_mem->ida_constraints = constraints; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetTolerances(void *ida_mem, - int itol, realtype *rtol, void *atol) -{ - IDAMem IDA_mem; - booleantype neg_atol; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - if ((itol != IDA_SS) && (itol != IDA_SV)) { - if(errfp!=NULL) fprintf(errfp, MSG_IDAS_BAD_ITOL); - return(IDA_ILL_INPUT); - } - - if (rtol == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_IDAS_RTOL_NULL); - return(IDA_ILL_INPUT); - } - - if (*rtol < ZERO) { - if(errfp!=NULL) fprintf(errfp, MSG_IDAS_BAD_RTOL); - return(IDA_ILL_INPUT); - } - - if (atol == NULL) { - if(errfp!=NULL) fprintf(errfp, MSG_IDAS_ATOL_NULL); - return(IDA_ILL_INPUT); - } - - /* Test absolute tolerances */ - if (itol == IDA_SS) { - neg_atol = (*((realtype *)atol) < ZERO); - } else { - neg_atol = (N_VMin((N_Vector)atol) < ZERO); - } - if (neg_atol) { - if(errfp!=NULL) fprintf(errfp, MSG_IDAS_BAD_ATOL); - return(IDA_ILL_INPUT); - } - - IDA_mem->ida_itol = itol; - IDA_mem->ida_rtol = rtol; - IDA_mem->ida_atol = atol; - - return(IDA_SUCCESS); -} - -/* - * ================================================================= - * IDA IC optional input functions - * ================================================================= - */ - -int IDASetNonlinConvCoefIC(void *ida_mem, realtype epiccon) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - if (epiccon < ZERO) { - if(errfp!=NULL) fprintf(errfp, MSG_IDAS_BAD_EPICCON); - return(IDA_ILL_INPUT); - } - - IDA_mem->ida_epiccon = epiccon; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetMaxNumStepsIC(void *ida_mem, int maxnh) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - if (maxnh < 0) { - if(errfp!=NULL) fprintf(errfp, MSG_IDAS_BAD_MAXNH); - return(IDA_ILL_INPUT); - } - - IDA_mem->ida_maxnh = maxnh; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetMaxNumJacsIC(void *ida_mem, int maxnj) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - if (maxnj < 0) { - if(errfp!=NULL) fprintf(errfp, MSG_IDAS_BAD_MAXNJ); - return(IDA_ILL_INPUT); - } - - IDA_mem->ida_maxnj = maxnj; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetMaxNumItersIC(void *ida_mem, int maxnit) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - if (maxnit < 0) { - if(errfp!=NULL) fprintf(errfp, MSG_IDAS_BAD_MAXNIT); - return(IDA_ILL_INPUT); - } - - IDA_mem->ida_maxnit = maxnit; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetLineSearchOffIC(void *ida_mem, booleantype lsoff) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - IDA_mem->ida_lsoff = lsoff; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDASetStepToleranceIC(void *ida_mem, realtype steptol) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAS_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - if (steptol < ZERO) { - if(errfp!=NULL) fprintf(errfp, MSG_IDAS_BAD_STEPTOL); - return(IDA_ILL_INPUT); - } - - IDA_mem->ida_steptol = steptol; - - return(IDA_SUCCESS); -} - -/* - * ================================================================= - * Readability constants - * ================================================================= - */ - -#define ewt (IDA_mem->ida_ewt) -#define kk (IDA_mem->ida_kk) -#define hh (IDA_mem->ida_hh) -#define h0u (IDA_mem->ida_h0u) -#define tn (IDA_mem->ida_tn) -#define nbacktr (IDA_mem->ida_nbacktr) -#define nst (IDA_mem->ida_nst) -#define nre (IDA_mem->ida_nre) -#define ncfn (IDA_mem->ida_ncfn) -#define netf (IDA_mem->ida_netf) -#define nni (IDA_mem->ida_nni) -#define nsetups (IDA_mem->ida_nsetups) -#define lrw (IDA_mem->ida_lrw) -#define liw (IDA_mem->ida_liw) -#define kused (IDA_mem->ida_kused) -#define hused (IDA_mem->ida_hused) -#define tolsf (IDA_mem->ida_tolsf) - -/* - * ================================================================= - * IDA optional input functions - * ================================================================= - */ - -int IDAGetNumSteps(void *ida_mem, long int *nsteps) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *nsteps = nst; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetNumResEvals(void *ida_mem, long int *nrevals) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *nrevals = nre; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetNumLinSolvSetups(void *ida_mem, long int *nlinsetups) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *nlinsetups = nsetups; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetNumErrTestFails(void *ida_mem, long int *netfails) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *netfails = netf; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetNumBacktrackOps(void *ida_mem, long int *nbacktracks) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *nbacktracks = nbacktr; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetLastOrder(void *ida_mem, int *klast) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *klast = kused; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetCurrentOrder(void *ida_mem, int *kcur) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *kcur = kk; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetActualInitStep(void *ida_mem, realtype *hinused) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *hinused = h0u; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetLastStep(void *ida_mem, realtype *hlast) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *hlast = hused; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetCurrentStep(void *ida_mem, realtype *hcur) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *hcur = hh; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetCurrentTime(void *ida_mem, realtype *tcur) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *tcur = tn; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetTolScaleFactor(void *ida_mem, realtype *tolsfact) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *tolsfact = tolsf; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetErrWeights(void *ida_mem, N_Vector *eweight) -{ - IDAMem IDA_mem; - - if (ida_mem == NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return (IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *eweight = ewt; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetWorkSpace(void *ida_mem, long int *lenrw, long int *leniw) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *leniw = liw; - *lenrw = lrw; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetIntegratorStats(void *ida_mem, long int *nsteps, long int *nrevals, - long int *nlinsetups, long int *netfails, - int *klast, int *kcur, realtype *hlast, - realtype *hcur, realtype *tcur) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *nsteps = nst; - *nrevals = nre; - *nlinsetups = nsetups; - *netfails = netf; - *klast = kused; - *kcur = kk; - *hlast = hused; - *hcur = hh; - *tcur = tn; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetNumNonlinSolvIters(void *ida_mem, long int *nniters) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *nniters = nni; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetNumNonlinSolvConvFails(void *ida_mem, long int *nncfails) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *nncfails = ncfn; - - return(IDA_SUCCESS); -} - -/*-----------------------------------------------------------------*/ - -int IDAGetNonlinSolvStats(void *ida_mem, long int *nniters, long int *nncfails) -{ - IDAMem IDA_mem; - - if (ida_mem==NULL) { - fprintf(stderr, MSG_IDAG_NO_MEM); - return(IDA_MEM_NULL); - } - - IDA_mem = (IDAMem) ida_mem; - - *nniters = nni; - *nncfails = ncfn; - - return(IDA_SUCCESS); -} - diff --git a/src/sundials/ida/idaspgmr.c b/src/sundials/ida/idaspgmr.c deleted file mode 100755 index 1bc82da402..0000000000 --- a/src/sundials/ida/idaspgmr.c +++ /dev/null @@ -1,957 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmers: Alan C. Hindmarsh, and Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California - * Produced at the Lawrence Livermore National Laboratory - * All rights reserved - * For details, see sundials/ida/LICENSE - * ----------------------------------------------------------------- - * This is the implementation file for the IDA Scaled - * Preconditioned GMRES linear solver module, IDASPGMR. - * ----------------------------------------------------------------- - */ - -#include -#include - -#include "ida_impl.h" -#include "idaspgmr_impl.h" - -#include "sundialsmath.h" - -/* Constants */ - -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) -#define PT9 RCONST(0.9) -#define PT05 RCONST(0.05) - -#define IDA_SPGMR_MAXL 5 -#define IDA_SPGMR_MAXRS 5 - -/* IDASPGMR linit, lsetup, lsolve, lperf, and lfree routines */ - -static int IDASpgmrInit(IDAMem IDA_mem); - -static int IDASpgmrSetup(IDAMem IDA_mem, - N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, - N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); - -static int IDASpgmrSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, - N_Vector yy_now, N_Vector yp_now, N_Vector rr_now); - -static int IDASpgmrPerf(IDAMem IDA_mem, int perftask); - -static int IDASpgmrFree(IDAMem IDA_mem); - -/* IDASPGMR Atimes and PSolve routines called by generic SPGMR solver */ - -static int IDASpgmrAtimes(void *ida_mem, N_Vector v, N_Vector z); - -static int IDASpgmrPSolve(void *ida_mem, N_Vector r, N_Vector z, int lr); - -/* Difference quotient approximation for Jac times vector */ - -static int IDASpgmrDQJtimes(realtype tt, - N_Vector yy, N_Vector yp, N_Vector rr, - N_Vector v, N_Vector Jv, - realtype c_j, void *jac_data, - N_Vector work1, N_Vector work2); - -/* Readability Replacements */ - -#define lrw1 (IDA_mem->ida_lrw1) -#define liw1 (IDA_mem->ida_liw1) -#define nst (IDA_mem->ida_nst) -#define tn (IDA_mem->ida_tn) -#define cj (IDA_mem->ida_cj) -#define epsNewt (IDA_mem->ida_epsNewt) -#define nre (IDA_mem->ida_nre) -#define res (IDA_mem->ida_res) -#define rdata (IDA_mem->ida_rdata) -#define ewt (IDA_mem->ida_ewt) -#define errfp (IDA_mem->ida_errfp) -#define iopt (IDA_mem->ida_iopt) -#define linit (IDA_mem->ida_linit) -#define lsetup (IDA_mem->ida_lsetup) -#define lsolve (IDA_mem->ida_lsolve) -#define lperf (IDA_mem->ida_lperf) -#define lfree (IDA_mem->ida_lfree) -#define lmem (IDA_mem->ida_lmem) -#define nni (IDA_mem->ida_nni) -#define ncfn (IDA_mem->ida_ncfn) -#define setupNonNull (IDA_mem->ida_setupNonNull) -#define vec_tmpl (IDA_mem->ida_tempv1) - -#define sqrtN (idaspgmr_mem->g_sqrtN) -#define epslin (idaspgmr_mem->g_epslin) -#define ytemp (idaspgmr_mem->g_ytemp) -#define yptemp (idaspgmr_mem->g_yptemp) -#define xx (idaspgmr_mem->g_xx) -#define ycur (idaspgmr_mem->g_ycur) -#define ypcur (idaspgmr_mem->g_ypcur) -#define rcur (idaspgmr_mem->g_rcur) -#define resflag (idaspgmr_mem->g_resflag) -#define npe (idaspgmr_mem->g_npe) -#define nli (idaspgmr_mem->g_nli) -#define nps (idaspgmr_mem->g_nps) -#define ncfl (idaspgmr_mem->g_ncfl) -#define nst0 (idaspgmr_mem->g_nst0) -#define nni0 (idaspgmr_mem->g_nni0) -#define nli0 (idaspgmr_mem->g_nli0) -#define ncfn0 (idaspgmr_mem->g_ncfn0) -#define ncfl0 (idaspgmr_mem->g_ncfl0) -#define nwarn (idaspgmr_mem->g_nwarn) -#define njtimes (idaspgmr_mem->g_njtimes) -#define nreSG (idaspgmr_mem->g_nreSG) - -#define spgmr_mem (idaspgmr_mem->g_spgmr_mem) -#define last_flag (idaspgmr_mem->g_last_flag) - -/* - * ----------------------------------------------------------------- - * IDASpgmr - * ----------------------------------------------------------------- - * - * This routine initializes the memory record and sets various function - * fields specific to the IDASPGMR linear solver module. - * - * IDASpgmr first calls the existing lfree routine if this is not NULL. - * It then sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and - * ida_lfree fields in (*IDA_mem) to be IDASpgmrInit, IDASpgmrSetup, - * IDASpgmrSolve, IDASpgmrPerf, and IDASpgmrFree, respectively. - * It allocates memory for a structure of type IDASpgmrMemRec and sets - * the ida_lmem field in (*IDA_mem) to the address of this structure. - * It sets setupNonNull in (*IDA_mem). It then sets the following - * fields in the IDASpgmrMemRec structure: - * g_gstype = gstype - * g_maxl = MIN(Neq,IDA_SPGMR_MAXL) if maxl <= 0, else MIN(Neq,maxl) - * g_maxrs = 0 if maxrs < 0, MIN(5,Neq/g_maxl) if maxrs = 0, and - * MIN(maxrs,Neq/g_maxl) if maxrs > 0. - * g_eplifac = 0.05 if eplifac = 0.0, else eplifac - * g_dqincfac = 1.0 if dqincfac = 0.0, else dqincfac - * g_pdata = NULL - * g_pset = NULL - * g_psolve = NULL - * g_jtimes = NULL - * g_jdata = NULL - * Finally, IDASpgmr allocates memory for ytemp, yptemp, and xx, and - * calls SpgmrMalloc to allocate memory for the Spgmr solver. - * - * The return value of IDASpgmr is: - * IDASPGMR_SUCCESS = 0 if successful - * IDASPGMR_MEM_FAIL = -1 if IDA_mem is NULL or a memory allocation failed - * IDASPGMR_ILL_INPUT = -2 if the gstype argument is illegal. - * - * ----------------------------------------------------------------- - */ - -int IDASpgmr(void *ida_mem, int maxl) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - int flag, maxl1; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - /* Check if N_VDotProd is present */ - if(vec_tmpl->ops->nvdotprod == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_BAD_NVECTOR); - return(IDASPGMR_ILL_INPUT); - } - - if (lfree != NULL) flag = lfree((IDAMem) ida_mem); - - /* Set five main function fields in ida_mem */ - linit = IDASpgmrInit; - lsetup = IDASpgmrSetup; - lsolve = IDASpgmrSolve; - lperf = IDASpgmrPerf; - lfree = IDASpgmrFree; - - /* Get memory for IDASpgmrMemRec */ - idaspgmr_mem = (IDASpgmrMem) malloc(sizeof(IDASpgmrMemRec)); - if (idaspgmr_mem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_MEM_FAIL); - return(IDASPGMR_MEM_FAIL); - } - - /* Set SPGMR parameters that were passed in call sequence */ - maxl1 = (maxl <= 0) ? IDA_SPGMR_MAXL : maxl; - idaspgmr_mem->g_maxl = maxl1; - - /* Set default values for the rest of the Spgmr parameters */ - idaspgmr_mem->g_gstype = MODIFIED_GS; - idaspgmr_mem->g_maxrs = IDA_SPGMR_MAXRS; - idaspgmr_mem->g_eplifac = PT05; - idaspgmr_mem->g_dqincfac = ONE; - idaspgmr_mem->g_pset = NULL; - idaspgmr_mem->g_psolve = NULL; - idaspgmr_mem->g_pdata = NULL; - idaspgmr_mem->g_jtimes = IDASpgmrDQJtimes; - idaspgmr_mem->g_jdata = ida_mem; - idaspgmr_mem->g_last_flag = IDASPGMR_SUCCESS; - - /* Set setupNonNull to FALSE */ - setupNonNull = FALSE; - - /* Allocate memory for ytemp, yptemp, and xx */ - ytemp = N_VClone(vec_tmpl); - if (ytemp == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_MEM_FAIL); - return(IDASPGMR_MEM_FAIL); - } - yptemp = N_VClone(vec_tmpl); - if (yptemp == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_MEM_FAIL); - N_VDestroy(ytemp); - return(IDASPGMR_MEM_FAIL); - } - xx = N_VClone(vec_tmpl); - if (xx == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_MEM_FAIL); - N_VDestroy(ytemp); - N_VDestroy(yptemp); - return(IDASPGMR_MEM_FAIL); - } - - /* Compute sqrtN from a dot product */ - N_VConst(ONE, ytemp); - sqrtN = RSqrt( N_VDotProd(ytemp, ytemp) ); - - /* Call SpgmrMalloc to allocate workspace for Spgmr */ - spgmr_mem = SpgmrMalloc(maxl1, vec_tmpl); - if (spgmr_mem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_MEM_FAIL); - N_VDestroy(ytemp); - N_VDestroy(yptemp); - N_VDestroy(xx); - return(IDASPGMR_MEM_FAIL); - } - - /* Attach linear solver memory to the integrator memory */ - lmem = idaspgmr_mem; - - return(IDASPGMR_SUCCESS); -} - -/* - * ----------------------------------------------------------------- - * IDASpgmrSet* and IDASpgmrGet* - * ----------------------------------------------------------------- - */ - -int IDASpgmrSetGSType(void *ida_mem, int gstype) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - /* Check for legal gstype */ - if ((gstype != MODIFIED_GS) && (gstype != CLASSICAL_GS)) { - if(errfp!=NULL) fprintf(errfp, MSGS_BAD_GSTYPE); - return(IDASPGMR_ILL_INPUT); - } - - idaspgmr_mem->g_gstype = gstype; - - return(IDASPGMR_SUCCESS); -} - -int IDASpgmrSetMaxRestarts(void *ida_mem, int maxrs) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - /* Check for legal maxrs */ - if (maxrs < 0) { - if(errfp!=NULL) fprintf(errfp, MSGS_IDAS_NEG_MAXRS); - return(IDASPGMR_ILL_INPUT); - } - - idaspgmr_mem->g_maxrs = maxrs; - - return(IDASPGMR_SUCCESS); -} - -int IDASpgmrSetEpsLin(void *ida_mem, realtype eplifac) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - /* Check for legal maxrs */ - if (eplifac < ZERO) { - if(errfp!=NULL) fprintf(errfp, MSGS_IDAS_NEG_EPLIFAC); - return(IDASPGMR_ILL_INPUT); - } - - if (eplifac == 0) - idaspgmr_mem->g_eplifac = PT05; - else - idaspgmr_mem->g_eplifac = eplifac; - - return(IDASPGMR_SUCCESS); -} - -int IDASpgmrSetIncrementFactor(void *ida_mem, realtype dqincfac) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - /* Check for legal maxrs */ - if (dqincfac <= ZERO) { - if(errfp!=NULL) fprintf(errfp, MSGS_IDAS_NEG_DQINCFAC); - return(IDASPGMR_ILL_INPUT); - } - - idaspgmr_mem->g_dqincfac = dqincfac; - - return(IDASPGMR_SUCCESS); -} - -int IDASpgmrSetPrecSetupFn(void *ida_mem, IDASpgmrPrecSetupFn pset) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - idaspgmr_mem->g_pset = pset; - - return(IDASPGMR_SUCCESS); -} - -int IDASpgmrSetPrecSolveFn(void *ida_mem, IDASpgmrPrecSolveFn psolve) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - idaspgmr_mem->g_psolve = psolve; - - return(IDASPGMR_SUCCESS); -} - -int IDASpgmrSetPrecData(void *ida_mem, void *prec_data) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - idaspgmr_mem->g_pdata = prec_data; - - return(IDASPGMR_SUCCESS); -} - -int IDASpgmrSetJacTimesVecFn(void *ida_mem, IDASpgmrJacTimesVecFn jtimes) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - idaspgmr_mem->g_jtimes = jtimes; - - return(IDASPGMR_SUCCESS); -} - -int IDASpgmrSetJacData(void *ida_mem, void *jac_data) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - idaspgmr_mem->g_jdata = jac_data; - - return(IDASPGMR_SUCCESS); -} - -int IDASpgmrGetWorkSpace(void *ida_mem, long int *lenrwSG, long int *leniwSG) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - int maxl; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - maxl = idaspgmr_mem->g_maxl; - *lenrwSG = lrw1*(maxl + 6) + maxl*(maxl + 4) + 1; - *leniwSG = liw1*(maxl + 6); - - return(IDASPGMR_SUCCESS); -} - -int IDASpgmrGetNumPrecEvals(void *ida_mem, long int *npevals) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - *npevals = npe; - - return(IDASPGMR_SUCCESS); -} - -int IDASpgmrGetNumPrecSolves(void *ida_mem, long int *npsolves) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - *npsolves = nps; - - return(IDASPGMR_SUCCESS); -} - -int IDASpgmrGetNumLinIters(void *ida_mem, long int *nliters) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - *nliters = nli; - - return(IDASPGMR_SUCCESS); -} - -int IDASpgmrGetNumConvFails(void *ida_mem, long int *nlcfails) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - *nlcfails = ncfl; - - return(IDASPGMR_SUCCESS); -} - -int IDASpgmrGetNumJtimesEvals(void *ida_mem, long int *njvevals) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - *njvevals = njtimes; - - return(IDASPGMR_SUCCESS); -} - -int IDASpgmrGetNumResEvals(void *ida_mem, long int *nrevalsSG) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - *nrevalsSG = nreSG; - - return(IDASPGMR_SUCCESS); -} - -int IDASpgmrGetLastFlag(void *ida_mem, int *flag) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - - /* Return immediately if ida_mem is NULL */ - if (ida_mem == NULL) { - fprintf(stderr, MSGS_SETGET_IDAMEM_NULL); - return(IDASPGMR_MEM_NULL); - } - IDA_mem = (IDAMem) ida_mem; - - if (lmem == NULL) { - if(errfp!=NULL) fprintf(errfp, MSGS_SETGET_LMEM_NULL); - return(IDASPGMR_LMEM_NULL); - } - idaspgmr_mem = (IDASpgmrMem) lmem; - - *flag = last_flag; - - return(IDASPGMR_SUCCESS); -} - - -/* - * ----------------------------------------------------------------- - * IDASPGMR interface routines - * ----------------------------------------------------------------- - */ - -/* Additional readability Replacements */ - -#define gstype (idaspgmr_mem->g_gstype) -#define maxl (idaspgmr_mem->g_maxl) -#define maxrs (idaspgmr_mem->g_maxrs) -#define eplifac (idaspgmr_mem->g_eplifac) -#define dqincfac (idaspgmr_mem->g_dqincfac) -#define psolve (idaspgmr_mem->g_psolve) -#define pset (idaspgmr_mem->g_pset) -#define pdata (idaspgmr_mem->g_pdata) -#define jtimes (idaspgmr_mem->g_jtimes) -#define jdata (idaspgmr_mem->g_jdata) - -static int IDASpgmrInit(IDAMem IDA_mem) -{ - IDASpgmrMem idaspgmr_mem; - - idaspgmr_mem = (IDASpgmrMem) lmem; - - /* Initialize counters */ - npe = nli = nps = ncfl = 0; - njtimes = nreSG = 0; - - /* Set setupNonNull to TRUE iff there is preconditioning with setup */ - setupNonNull = (psolve != NULL) && (pset != NULL); - - /* If jtimes is NULL at this time, set it to DQ */ - if (jtimes == NULL) { - jtimes = IDASpgmrDQJtimes; - jdata = IDA_mem; - } - - last_flag = IDASPGMR_SUCCESS; - return(0); -} - -static int IDASpgmrSetup(IDAMem IDA_mem, - N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, - N_Vector tmp1, N_Vector tmp2, - N_Vector tmp3) -{ - int retval; - IDASpgmrMem idaspgmr_mem; - - idaspgmr_mem = (IDASpgmrMem) lmem; - - /* Call user setup routine pset and update counter npe. */ - retval = pset(tn, yy_p, yp_p, rr_p, cj, pdata, - tmp1, tmp2, tmp3); - npe++; - - last_flag = retval; - /* Return flag showing success or failure of pset. */ - if (retval < 0) return(-1); - if (retval > 0) return(+1); - return(0); -} - - -/* - * The x-scaling and b-scaling arrays are both equal to weight. - * - * We set the initial guess, x = 0, then call SpgmrSolve. - * We copy the solution x into b, and update the counters nli, nps, ncfl. - * If SpgmrSolve returned nli_inc = 0 (hence x = 0), we take the SPGMR - * vtemp vector (= P_inverse F) as the correction vector instead. - * Finally, we set the return value according to the success of SpgmrSolve. - */ - -static int IDASpgmrSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, - N_Vector yy_now, N_Vector yp_now, N_Vector rr_now) -{ - IDASpgmrMem idaspgmr_mem; - int pretype, nli_inc, nps_inc, retval; - realtype res_norm; - - idaspgmr_mem = (IDASpgmrMem) lmem; - - - /* Set SpgmrSolve convergence test constant epslin, in terms of the - Newton convergence test constant epsNewt and safety factors. The factor - sqrt(Neq) assures that the GMRES convergence test is applied to the - WRMS norm of the residual vector, rather than the weighted L2 norm. */ - epslin = sqrtN*eplifac*epsNewt; - - /* Set vectors ycur, ypcur, and rcur for use by the Atimes and Psolve */ - ycur = yy_now; - ypcur = yp_now; - rcur = rr_now; - - /* Set SpgmrSolve inputs pretype and initial guess xx = 0. */ - pretype = (psolve == NULL) ? PREC_NONE : PREC_LEFT; - N_VConst(ZERO, xx); - - /* Call SpgmrSolve and copy xx to bb. */ - retval = SpgmrSolve(spgmr_mem, IDA_mem, xx, bb, pretype, gstype, epslin, - maxrs, IDA_mem, weight, weight, IDASpgmrAtimes, - IDASpgmrPSolve, &res_norm, &nli_inc, &nps_inc); - last_flag = retval; - if (nli_inc == 0) N_VScale(ONE, SPGMR_VTEMP(spgmr_mem), bb); - else N_VScale(ONE, xx, bb); - - /* Increment counters nli, nps, and return if successful. */ - nli += nli_inc; - nps += nps_inc; - - if (retval == 0) return(0); - - /* If not successful, increment ncfl and return appropriate flag. */ - ncfl++; - - if (retval > 0) return(+1); - if (retval != -2) return(-1); - if (resflag > 0) return(+1); - return(-1); - -} - -/* - * This routine handles performance monitoring specific to the IDASPGMR - * linear solver. When perftask = 0, it saves values of various counters. - * When perftask = 1, it examines difference quotients in these counters, - * and depending on their values, it prints up to three warning messages. - * Messages are printed up to a maximum of 10 times. - */ - -static int IDASpgmrPerf(IDAMem IDA_mem, int perftask) -{ - IDASpgmrMem idaspgmr_mem; - realtype avdim, rcfn, rcfl; - long int nstd, nnid; - booleantype lavd, lcfn, lcfl; - - idaspgmr_mem = (IDASpgmrMem) lmem; - - if (perftask == 0) { - nst0 = nst; nni0 = nni; nli0 = nli; - ncfn0 = ncfn; ncfl0 = ncfl; - nwarn = 0; - return(0); - } - - nstd = nst - nst0; nnid = nni - nni0; - if (nstd == 0 || nnid == 0) return(0); - avdim = (nli - nli0)/( (realtype) nnid); - rcfn = (ncfn - ncfn0)/( (realtype) nstd); - rcfl = (ncfl - ncfl0)/( (realtype) nnid); - lavd = (avdim > ( (realtype) maxl ) ); - lcfn = (rcfn > PT9); - lcfl = (rcfl > PT9); - if (!(lavd || lcfn || lcfl)) return(0); - nwarn++; - if (nwarn > 10) return(1); - if (lavd) if(errfp!=NULL) fprintf(errfp, MSGS_AVD_WARN, tn, avdim); - if (lcfn) if(errfp!=NULL) fprintf(errfp, MSGS_CFN_WARN, tn, rcfn); - if (lcfl) if(errfp!=NULL) fprintf(errfp, MSGS_CFL_WARN, tn, rcfl); - - return(0); -} - -static int IDASpgmrFree(IDAMem IDA_mem) -{ - IDASpgmrMem idaspgmr_mem; - - idaspgmr_mem = (IDASpgmrMem) lmem; - - N_VDestroy(ytemp); - N_VDestroy(xx); - SpgmrFree(spgmr_mem); - free(lmem); - - return(0); -} - -/* - * ----------------------------------------------------------------- - * IDASPGMR private functions - * ----------------------------------------------------------------- - */ - - -/* - * This routine generates the matrix-vector product z = Jv, where - * J is the system Jacobian, by calling either the user provided - * routine or the internal DQ routine. - */ - -static int IDASpgmrAtimes(void *ida_mem, N_Vector v, N_Vector z) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - int jtflag; - - IDA_mem = (IDAMem) ida_mem; - idaspgmr_mem = (IDASpgmrMem) lmem; - - jtflag = jtimes(tn, ycur, ypcur, rcur, v, z, cj, jdata, ytemp, yptemp); - njtimes++; - - return(jtflag); -} - -/* - * This routine interfaces between the generic SpgmrSolve routine and - * the user's psolve routine. It passes to psolve all required state - * information from ida_mem. Its return value is the same as that - * returned by psolve. Note that the generic SPGMR solver guarantees - * that IDASpgmrPSolve will not be called in the case psolve = NULL. - */ - -static int IDASpgmrPSolve(void *ida_mem, N_Vector r, N_Vector z, int lr) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - int retval; - - IDA_mem = (IDAMem) ida_mem; - idaspgmr_mem = (IDASpgmrMem) lmem; - - retval = psolve(tn, ycur, ypcur, rcur, r, z, cj, epslin, pdata, ytemp); - - /* This call is counted in nps within the IDASpgmrSolve routine */ - - return(retval); - -} - -/* - * This routine generates the matrix-vector product z = Jv, where - * J is the system Jacobian, by using a difference quotient approximation. - * The approximation is - * Jv = [F(t,y1,yp1) - F(t,y,yp)]/sigma, where - * y1 = y + sigma*v, yp1 = yp + cj*sigma*v, - * sigma = sqrt(Neq)*dqincfac. - * The return value from the call to res is saved in order to set the - * return flag from IDASpgmrSolve. - */ - -static int IDASpgmrDQJtimes(realtype tt, - N_Vector yy, N_Vector yp, N_Vector rr, - N_Vector v, N_Vector Jv, - realtype c_j, void *jac_data, - N_Vector tmp1, N_Vector tmp2) -{ - IDAMem IDA_mem; - IDASpgmrMem idaspgmr_mem; - N_Vector y_tmp, yp_tmp; - realtype sig, siginv; - int ires; - - /* jac_data is ida_mem */ - IDA_mem = (IDAMem) jac_data; - idaspgmr_mem = (IDASpgmrMem) lmem; - - sig = sqrtN*dqincfac; - - /* Rename tmp1 and tmp2 for readibility */ - y_tmp = tmp1; - yp_tmp = tmp2; - - /* Set y_tmp = yy + sig*v, yp_tmp = yp + cj*sig*v. */ - N_VLinearSum(sig, v, ONE, yy, ytemp); - N_VLinearSum(c_j*sig, v, ONE, yp, yptemp); - - /* Call res for Jv = F(t, y_tmp, yp_tmp), and return if it failed. */ - ires = res(tt, y_tmp, yp_tmp, Jv, rdata); - nreSG++; - resflag = ires; - if (ires != 0) return(ires); - - /* Set Jv to [Jv - rr]/sig and return. */ - siginv = ONE/sig; - N_VLinearSum(siginv, Jv, -siginv, rr, Jv); - - return(0); - -} diff --git a/src/sundials/ida/idaspgmr.h b/src/sundials/ida/idaspgmr.h deleted file mode 100755 index b5bd492b75..0000000000 --- a/src/sundials/ida/idaspgmr.h +++ /dev/null @@ -1,341 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmers: Alan C. Hindmarsh and Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California - * Produced at the Lawrence Livermore National Laboratory - * All rights reserved - * For details, see sundials/ida/LICENSE - * ----------------------------------------------------------------- - * This is the header file for the Scaled Preconditioned GMRES - * linear solver module, IDASPGMR. - * ----------------------------------------------------------------- - */ - -#ifndef _IDASPGMR_H -#define _IDASPGMR_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include -#include "sundialstypes.h" -#include "spgmr.h" -#include "nvector.h" - -/* - * ----------------------------------------------------------------- - * - * Type : IDASpgmrPrecSetupFn - *---------------------------------------------------------------- - * The optional user-supplied functions PrecSetup and PrecSolve - * together must define the left preconditoner matrix P - * approximating the system Jacobian matrix - * J = dF/dy + c_j*dF/dy' - * (where the DAE system is F(t,y,y') = 0), and solve the linear - * systems P z = r. PrecSetup is to do any necessary setup - * operations, and PrecSolve is to compute the solution of - * P z = r. - * - * The preconditioner setup function PrecSetup is to evaluate and - * preprocess any Jacobian-related data needed by the - * preconditioner solve function PrecSolve. This might include - * forming a crude approximate Jacobian, and performing an LU - * factorization on it. This function will not be called in - * advance of every call to PrecSolve, but instead will be called - * only as often as necessary to achieve convergence within the - * Newton iteration. If the PrecSolve function needs no - * preparation, the PrecSetup function can be NULL. - * - * Each call to the PrecSetup function is preceded by a call to - * the system function res with the same (t,y,y') arguments. - * Thus the PrecSetup function can use any auxiliary data that is - * computed and saved by the res function and made accessible - * to PrecSetup. - * - * A preconditioner setup function PrecSetup must have the - * prototype given below. Its parameters are as follows: - * - * tt is the current value of the independent variable t. - * - * yy is the current value of the dependent variable vector, - * namely the predicted value of y(t). - * - * yp is the current value of the derivative vector y', - * namely the predicted value of y'(t). - * - * rr is the current value of the residual vector F(t,y,y'). - * - * c_j is the scalar in the system Jacobian, proportional to 1/hh. - * - * prec_data is a pointer to user preconditioner data - the same as - * the pdata parameter passed to IDASpgmr. - * - * tmp1, tmp2, tmp3 are pointers to vectors of type N_Vector - * which can be used by an IDASpgmrPrecSetupFn routine - * as temporary storage or work space. - * - * NOTE: If the user's preconditioner needs other quantities, - * they are accessible as follows: hcur (the current stepsize) - * and ewt (the error weight vector) are accessible through - * IDAGetCurrentStep and IDAGetErrWeights, respectively (see - * ida.h). The unit roundoff is available as - * UNIT_ROUNDOFF defined in sundialstypes.h - * - * The IDASpgmrPrecSetupFn should return - * 0 if successful, - * a positive int if a recoverable error occurred, or - * a negative int if a nonrecoverable error occurred. - * In the case of a recoverable error return, the integrator will - * attempt to recover by reducing the stepsize (which changes cj). - * ----------------------------------------------------------------- - */ - -typedef int (*IDASpgmrPrecSetupFn)(realtype tt, - N_Vector yy, N_Vector yp, N_Vector rr, - realtype c_j, void *prec_data, - N_Vector tmp1, N_Vector tmp2, - N_Vector tmp3); - -/* - * ----------------------------------------------------------------- - * - * Type : IDASpgmrPrecSolveFn - *---------------------------------------------------------------- - * The optional user-supplied function PrecSolve must compute a - * solution to the linear system P z = r, where P is the left - * preconditioner defined by the user. If no preconditioning - * is desired, pass NULL for PrecSolve to IDASpgmr. - * - * A preconditioner solve function PrecSolve must have the - * prototype given below. Its parameters are as follows: - * - * tt is the current value of the independent variable t. - * - * yy is the current value of the dependent variable vector y. - * - * yp is the current value of the derivative vector y'. - * - * rr is the current value of the residual vector F(t,y,y'). - * - * rvec is the input right-hand side vector r. - * - * zvec is the computed solution vector z. - * - * c_j is the scalar in the system Jacobian, proportional to 1/hh. - * - * delta is an input tolerance for use by PrecSolve if it uses an - * iterative method in its solution. In that case, the - * the residual vector r - P z of the system should be - * made less than delta in weighted L2 norm, i.e., - * sqrt [ Sum (Res[i]*ewt[i])^2 ] < delta . - * Note: the error weight vector ewt can be obtained - * through a call to the routine IDAGetErrWeights. - * - * prec_data is a pointer to user preconditioner data - the same as - * the pdata parameter passed to IDASpgmr. - * - * tmp is an N_Vector which can be used by the PrecSolve - * routine as temporary storage or work space. - * - * - * The IDASpgmrPrecSolveFn should return - * 0 if successful, - * a positive int if a recoverable error occurred, or - * a negative int if a nonrecoverable error occurred. - * Following a recoverable error, the integrator will attempt to - * recover by updating the preconditioner and/or reducing the - * stepsize. - * - * ----------------------------------------------------------------- - */ - -typedef int (*IDASpgmrPrecSolveFn)(realtype tt, - N_Vector yy, N_Vector yp, N_Vector rr, - N_Vector rvec, N_Vector zvec, - realtype c_j, realtype delta, void *prec_data, - N_Vector tmp); - -/* - * ----------------------------------------------------------------- - * - * Type : IDASpgmrJacTimesVecFn - *---------------------------------------------------------------- - * The user-supplied function jtimes is to generate the product - * J*v for given v, where J is the Jacobian matrix - * J = dF/dy + c_j*dF/dy' - * or an approximation to it, and v is a given vector. - * It should return 0 if successful and a nonzero int otherwise. - * - * A function jtimes must have the prototype given below. Its - * parameters are as follows: - * - * tt is the current value of the independent variable. - * - * yy is the current value of the dependent variable vector, - * namely the predicted value of y(t). - * - * yp is the current value of the derivative vector y', - * namely the predicted value of y'(t). - * - * rr is the current value of the residual vector F(t,y,y'). - * - * v is the N_Vector to be multiplied by J. - * - * Jv is the output N_Vector containing J*v. - * - * c_j is the scalar in the system Jacobian, proportional - * to 1/hh. - * - * jac_data is a pointer to user Jacobian data, the same as the - * pointer passed to CVSpgmr. - * - * tmp1, tmp2 are two N_Vectors which can be used by Jtimes for - * work space. - * - * ----------------------------------------------------------------- - */ - -typedef int (*IDASpgmrJacTimesVecFn)(realtype tt, - N_Vector yy, N_Vector yp, N_Vector rr, - N_Vector v, N_Vector Jv, - realtype c_j, void *jac_data, - N_Vector tmp1, N_Vector tmp2); - -/* - * ----------------------------------------------------------------- - * - * Function : IDASpgmr - *---------------------------------------------------------------- - * A call to the IDASpgmr function links the main integrator with - * the IDASPGMR linear solver module. Its parameters are as - * follows: - * - * IDA_mem is the pointer to memory block returned by IDACreate. - * - * maxl is the maximum Krylov subspace dimension, an - * optional input. Pass 0 to use the default value, - * MIN(Neq, 5). Otherwise pass a positive integer. - * - * The return values of IDASpgmr are: - * IDASPGMR_SUCCESS if successful - * IDASPGMR_MEM_NULL if the ida memory was NULL - * IDASPGMR_MEM_FAIL if there was a memory allocation failure - * IDASPGMR_ILL_INPUT if there was illegal input. - * - * ----------------------------------------------------------------- - */ - -int IDASpgmr(void *ida_mem, int maxl); - -/* - * ----------------------------------------------------------------- - * Optional inputs to the IDASPGMR linear solver - *---------------------------------------------------------------- - * - * IDASpgmrSetPrecSolveFn specifies the PrecSolve function. - * Default is NULL. - * IDASpgmrSetPrecSetupFn specifies the PrecSetup function. - * Default is NULL. - * IDASpgmrSetPrecData specifies a pointer to user preconditioner - * data. This pointer is passed to PrecSetup and - * PrecSolve every time these routines are called. - * Default is NULL. - * IDASpgmrSetJacTimesVecFn specifies the jtimes function. - * Default is to use an internal finite difference - * approximation routine. - * IDASpgmrSetJacData specifies a pointer to user Jacobian data. - * This pointer is passed to jtimes every time this - * routine is called. - * Default is NULL. - * IDASpgmrSetGSType specifies the type of Gram-Schmidt - * orthogonalization to be used. This must be one of - * the two enumeration constants MODIFIED_GS or - * CLASSICAL_GS defined in iterativ.h. These correspond - * to using modified Gram-Schmidt and classical - * Gram-Schmidt, respectively. - * Default value is MODIFIED_GS. - * IDASpgmrSetMaxRestarts specifies the maximum number of restarts - * to be used in the GMRES algorithm. maxrs must be a - * non-negative integer. Pass 0 to specify no restarts. - * Default is 5. - * IDASpgmrSetEpsLin specifies the factor in the linear iteration - * convergence test constant. - * Default is 0.05 - * IDASpgmrSetIncrementFactor specifies a factor in the increments - * to yy used in the difference quotient approximations - * to matrix-vector products Jv. - * Default is 1.0 - * - * The return value of IDASpgmrSet* is one of: - * IDASPGMR_SUCCESS if successful - * IDASPGMR_MEM_NULL if the ida memory was NULL - * IDASPGMR_LMEM_NULL if the idaspgmr memory was NULL - * ----------------------------------------------------------------- - */ - -int IDASpgmrSetPrecSolveFn(void *ida_mem, IDASpgmrPrecSolveFn psolve); -int IDASpgmrSetPrecSetupFn(void *ida_mem, IDASpgmrPrecSetupFn pset); -int IDASpgmrSetPrecData(void *ida_mem, void *prec_data); -int IDASpgmrSetJacTimesVecFn(void *ida_mem, IDASpgmrJacTimesVecFn jtimes); -int IDASpgmrSetJacData(void *ida_mem, void *jac_data); -int IDASpgmrSetGSType(void *ida_mem, int gstype); -int IDASpgmrSetMaxRestarts(void *ida_mem, int maxrs); -int IDASpgmrSetEpsLin(void *ida_mem, realtype eplifac); -int IDASpgmrSetIncrementFactor(void *ida_mem, realtype dqincfac); - -/* - * ----------------------------------------------------------------- - * Optional outputs from the IDASPGMR linear solver - *---------------------------------------------------------------- - * - * IDASpgmrGetWorkSpace returns the real and integer workspace used - * by IDASPGMR. - * IDASpgmrGetNumPrecEvals returns the number of preconditioner - * evaluations, i.e. the number of calls made to PrecSetup - * with jok==FALSE. - * IDASpgmrGetNumPrecSolves returns the number of calls made to - * PrecSolve. - * IDASpgmrGetNumLinIters returns the number of linear iterations. - * IDASpgmrGetNumConvFails returns the number of linear - * convergence failures. - * IDASpgmrGetNumJtimesEvals returns the number of calls to jtimes - * IDASpgmrGetNumResEvals returns the number of calls to the user - * res routine due to finite difference Jacobian times vector - * evaluation. - * IDASpgmrGetLastFlag returns the last error flag set by any of - * the IDASPGMR interface functions. - * - * The return value of IDASpgmrGet* is one of: - * IDASPGMR_SUCCESS if successful - * IDASPGMR_MEM_NULL if the ida memory was NULL - * IDASPGMR_LMEM_NULL if the idaspgmr memory was NULL - * ----------------------------------------------------------------- - */ - -int IDASpgmrGetWorkSpace(void *ida_mem, long int *lenrwSG, long int *leniwSG); -int IDASpgmrGetNumPrecEvals(void *ida_mem, long int *npevals); -int IDASpgmrGetNumPrecSolves(void *ida_mem, long int *npsolves); -int IDASpgmrGetNumLinIters(void *ida_mem, long int *nliters); -int IDASpgmrGetNumConvFails(void *ida_mem, long int *nlcfails); -int IDASpgmrGetNumJtimesEvals(void *ida_mem, long int *njvevals); -int IDASpgmrGetNumResEvals(void *ida_mem, long int *nrevalsSG); -int IDASpgmrGetLastFlag(void *ida_mem, int *flag); - -/* IDASPGMR return values */ - -#define IDASPGMR_SUCCESS 0 -#define IDASPGMR_MEM_NULL -1 -#define IDASPGMR_LMEM_NULL -2 -#define IDASPGMR_ILL_INPUT -3 -#define IDASPGMR_MEM_FAIL -4 - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/ida/idaspgmr_impl.h b/src/sundials/ida/idaspgmr_impl.h deleted file mode 100755 index 2d984d6a18..0000000000 --- a/src/sundials/ida/idaspgmr_impl.h +++ /dev/null @@ -1,175 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmers: Alan C. Hindmarsh and Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/idas/LICENSE. - * ----------------------------------------------------------------- - * This is the header file (private version) for the Scaled - * Preconditioned GMRES linear solver module, IDASPGMR. - * ----------------------------------------------------------------- - */ - -#ifndef _IDASPGMR_IMPL_H -#define _IDASPGMR_IMPL_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include - -#include "idaspgmr.h" - -#include "spgmr.h" -#include "iterative.h" -#include "sundialstypes.h" -#include "nvector.h" - -/* - * ----------------------------------------------------------------- - * Types : IDASpgmrMemRec, IDASpgmrMem - * ----------------------------------------------------------------- - */ - -typedef struct { - - int g_gstype; /* type of Gram-Schmidt orthogonalization */ - realtype g_sqrtN; /* sqrt(N) */ - int g_maxl; /* maxl = maximum dimension of the Krylov space */ - int g_maxrs; /* maxrs = max. number of GMRES restarts */ - realtype g_eplifac; /* eplifac = linear convergence factor */ - realtype g_dqincfac; /* dqincfac = optional increment factor in Jv */ - realtype g_epslin; /* SpgrmSolve tolerance parameter */ - - int g_resflag; /* flag from last res call */ - long int g_npe; /* npe = total number of precond calls */ - long int g_nli; /* nli = total number of linear iterations */ - long int g_nps; /* nps = total number of psolve calls */ - long int g_ncfl; /* ncfl = total number of convergence failures */ - long int g_nreSG; /* nreSG = total number of calls to res */ - long int g_njtimes; /* njtimes = total number of calls to jtimes */ - - long int g_nst0; /* nst0 = saved nst (for performance monitor) */ - long int g_nni0; /* nni0 = saved nni (for performance monitor) */ - long int g_nli0; /* nli0 = saved nli (for performance monitor) */ - long int g_ncfn0; /* ncfn0 = saved ncfn (for performance monitor) */ - long int g_ncfl0; /* ncfl0 = saved ncfl (for performance monitor) */ - long int g_nwarn; /* nwarn = no. of warnings (for perf. monitor) */ - - N_Vector g_ytemp; /* temp vector used by IDAAtimesDQ */ - N_Vector g_yptemp; /* temp vector used by IDAAtimesDQ */ - N_Vector g_xx; /* temp vector used by IDASpgmrSolve */ - N_Vector g_ycur; /* current y vector in Newton iteration */ - N_Vector g_ypcur; /* current yp vector in Newton iteration */ - N_Vector g_rcur; /* rcur = F(tn, ycur, ypcur) */ - - IDASpgmrPrecSetupFn g_pset; /* pset = user-supplied routine */ - /* to compute a preconditioner */ - - IDASpgmrPrecSolveFn g_psolve; /* psolve = user-supplied routine to */ - /* solve preconditioner linear system*/ - - void *g_pdata; /* pdata passed to psolve and precond*/ - SpgmrMem g_spgmr_mem; /* spgmr_mem is memory used by the */ - /* generic Spgmr solver */ - - IDASpgmrJacTimesVecFn g_jtimes; /* Jacobian*vector routine */ - void *g_jdata; /* data passed to Jtimes */ - - int g_last_flag; /* last error return flag */ - -} IDASpgmrMemRec, *IDASpgmrMem; - - -/* - * ----------------------------------------------------------------- - * Error and Warning Messages - * ----------------------------------------------------------------- - */ - -#if defined(SUNDIALS_EXTENDED_PRECISION) - -#define MSGS_TIME "at t = %Lg, " - -#elif defined(SUNDIALS_DOUBLE_PRECISION) - -#define MSGS_TIME "at t = %lg, " - -#else - -#define MSGS_TIME "at t = %g, " - -#endif - - -/* Error Messages */ - -#define MSGS_IDAMEM_NULL "IDASpgmr-- integrator memory is NULL.\n\n" - -#define MSGS_MEM_FAIL "IDASpgmr-- a memory request failed.\n\n" - -#define MSGS_BAD_NVECTOR "IDASpgmr-- a required vector operation is not implemented.\n\n" - -#define MSGS_SETGET_IDAMEM_NULL "IDASpgmrSet*/IDASpgmrGet*-- integrator memory is NULL. \n\n" - -#define MSGS_SETGET_LMEM_NULL "IDASpgmrSet*/IDASpgmrGet*-- IDASPGMR memory is NULL. \n\n" - -#define MSGS_BAD_GSTYPE "IDASpgmrSetGSType-- gstype has an illegal value.\n" - -#define MSGS_IDAS_NEG_MAXRS "IDASpgmrSetMaxRestarts-- maxrs < 0 illegal. \n\n" - -#define MSGS_IDAS_NEG_EPLIFAC "IDASpgmrSetEpsLin-- eplifac < 0.0 illegal. \n\n" - -#define MSGS_IDAS_NEG_DQINCFAC "IDASpgmrSetIncrementFactor-- dqincfac < 0.0 illegal. \n\n" - -/* Warning Messages */ - -#define MSGS_WARN1 "Warning. Poor iterative algorithm performance\n" -#define MSGS_WARN "IDASpgmrPerf-- " MSGS_TIME MSGS_WARN1 - -#if defined(SUNDIALS_EXTENDED_PRECISION) - -#define MSGS_AVD_WARN1 "Average number of linear iterations is %Le.\n\n" -#define MSGS_AVD_WARN MSGS_WARN MSGS_AVD_WARN1 - -#define MSGS_CFN_WARN1 "Nonlinear convergence failure rate is %Le.\n\n" -#define MSGS_CFN_WARN MSGS_WARN MSGS_CFN_WARN1 - -#define MSGS_CFL_WARN1 "Linear convergence failure rate is %Le.\n\n" -#define MSGS_CFL_WARN MSGS_WARN MSGS_CFL_WARN1 - -#elif defined(SUNDIALS_DOUBLE_PRECISION) - -#define MSGS_AVD_WARN1 "Average number of linear iterations is %le.\n\n" -#define MSGS_AVD_WARN MSGS_WARN MSGS_AVD_WARN1 - -#define MSGS_CFN_WARN1 "Nonlinear convergence failure rate is %le.\n\n" -#define MSGS_CFN_WARN MSGS_WARN MSGS_CFN_WARN1 - -#define MSGS_CFL_WARN1 "Linear convergence failure rate is %le.\n\n" -#define MSGS_CFL_WARN MSGS_WARN MSGS_CFL_WARN1 - -#else - -#define MSGS_AVD_WARN1 "Average number of linear iterations is %e.\n\n" -#define MSGS_AVD_WARN MSGS_WARN MSGS_AVD_WARN1 - -#define MSGS_CFN_WARN1 "Nonlinear convergence failure rate is %e.\n\n" -#define MSGS_CFN_WARN MSGS_WARN MSGS_CFN_WARN1 - -#define MSGS_CFL_WARN1 "Linear convergence failure rate is %e.\n\n" -#define MSGS_CFL_WARN MSGS_WARN MSGS_CFL_WARN1 - -#endif - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/shared/band.c b/src/sundials/shared/band.c deleted file mode 100755 index ccba6f36ab..0000000000 --- a/src/sundials/shared/band.c +++ /dev/null @@ -1,365 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for a generic BAND linear - * solver package. - * ----------------------------------------------------------------- - */ - -#include -#include - -#include "band.h" -#include "sundialsmath.h" -#include "sundialstypes.h" - -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) - -#define ROW(i,j,smu) (i-j+smu) - -/* Implementation */ - -BandMat BandAllocMat(long int N, long int mu, long int ml, long int smu) -{ - BandMat A; - - if (N <= 0) return(NULL); - - A = (BandMat) malloc(sizeof *A); - if (A == NULL) return (NULL); - - A->data = bandalloc(N, smu, ml); - if (A->data == NULL) { - free(A); - return(NULL); - } - - A->size = N; - A->mu = mu; - A->ml = ml; - A->smu = smu; - - return(A); -} - -long int *BandAllocPiv(long int N) -{ - if (N <= 0) return(NULL); - - return((long int *) malloc(N * sizeof(long int))); -} - -long int BandFactor(BandMat A, long int *p) -{ - return(gbfa(A->data, A->size, A->mu, A->ml, A->smu, p)); -} - -void BandBacksolve(BandMat A, long int *p, realtype *b) -{ - gbsl(A->data, A->size, A->smu, A->ml, p, b); -} - -void BandZero(BandMat A) -{ - bandzero(A->data, A->size, A->mu, A->ml, A->smu); -} - -void BandCopy(BandMat A, BandMat B, long int copymu, - long int copyml) -{ - bandcopy(A->data, B->data, A->size, A->smu, B->smu, copymu, copyml); -} - -void BandScale(realtype c, BandMat A) -{ - bandscale(c, A->data, A->size, A->mu, A->ml, A->smu); -} - -void BandAddI(BandMat A) -{ - bandaddI(A->data, A->size, A->smu); -} - -void BandFreeMat(BandMat A) -{ - bandfree(A->data); - free(A); -} - -void BandFreePiv(long int *p) -{ - free(p); -} - -void BandPrint(BandMat A) -{ - bandprint(A->data, A->size, A->mu, A->ml, A->smu); -} - -realtype **bandalloc(long int n, long int smu, long int ml) -{ - realtype **a; - long int j, colSize; - - if (n <= 0) return(NULL); - - a = (realtype **) malloc(n * sizeof(realtype *)); - if (a == NULL) return(NULL); - - colSize = smu + ml + 1; - a[0] = (realtype *) malloc(n * colSize * sizeof(realtype)); - if (a[0] == NULL) { - free(a); - return(NULL); - } - - for (j=1; j < n; j++) a[j] = a[0] + j * colSize; - - return(a); -} - -long int *bandallocpiv(long int n) -{ - if (n <= 0) return(NULL); - - return((long int *) malloc(n * sizeof(long int))); -} - -long int gbfa(realtype **a, long int n, long int mu, long int ml, - long int smu, long int *p) -{ - long int c, r, num_rows; - long int i, j, k, l, storage_l, storage_k, last_col_k, last_row_k; - realtype *a_c, *col_k, *diag_k, *sub_diag_k, *col_j, *kptr, *jptr; - realtype max, temp, mult, a_kj; - booleantype swap; - - /* zero out the first smu - mu rows of the rectangular array a */ - - num_rows = smu - mu; - if (num_rows > 0) { - for (c=0; c < n; c++) { - a_c = a[c]; - for (r=0; r < num_rows; r++) { - a_c[r] = ZERO; - } - } - } - - /* k = elimination step number */ - - for (k=0; k < n-1; k++, p++) { - - col_k = a[k]; - diag_k = col_k + smu; - sub_diag_k = diag_k + 1; - last_row_k = MIN(n-1,k+ml); - - /* find l = pivot row number */ - - l=k; - max = ABS(*diag_k); - for (i=k+1, kptr=sub_diag_k; i <= last_row_k; i++, kptr++) { - if (ABS(*kptr) > max) { - l=i; - max = ABS(*kptr); - } - } - storage_l = ROW(l, k, smu); - *p = l; - - /* check for zero pivot element */ - - if (col_k[storage_l] == ZERO) return(k+1); - - /* swap a(l,k) and a(k,k) if necessary */ - - if ( (swap = (l != k) )) { - temp = col_k[storage_l]; - col_k[storage_l] = *diag_k; - *diag_k = temp; - } - - /* Scale the elements below the diagonal in */ - /* column k by -1.0 / a(k,k). After the above swap, */ - /* a(k,k) holds the pivot element. This scaling */ - /* stores the pivot row multipliers -a(i,k)/a(k,k) */ - /* in a(i,k), i=k+1, ..., MIN(n-1,k+ml). */ - - mult = -ONE / (*diag_k); - for (i=k+1, kptr = sub_diag_k; i <= last_row_k; i++, kptr++) - (*kptr) *= mult; - - /* row_i = row_i - [a(i,k)/a(k,k)] row_k, i=k+1, ..., MIN(n-1,k+ml) */ - /* row k is the pivot row after swapping with row l. */ - /* The computation is done one column at a time, */ - /* column j=k+1, ..., MIN(k+smu,n-1). */ - - last_col_k = MIN(k+smu,n-1); - for (j=k+1; j <= last_col_k; j++) { - - col_j = a[j]; - storage_l = ROW(l,j,smu); - storage_k = ROW(k,j,smu); - a_kj = col_j[storage_l]; - - /* Swap the elements a(k,j) and a(k,l) if l!=k. */ - - if (swap) { - col_j[storage_l] = col_j[storage_k]; - col_j[storage_k] = a_kj; - } - - /* a(i,j) = a(i,j) - [a(i,k)/a(k,k)]*a(k,j) */ - /* a_kj = a(k,j), *kptr = - a(i,k)/a(k,k), *jptr = a(i,j) */ - - if (a_kj != ZERO) { - for (i=k+1, kptr=sub_diag_k, jptr=col_j+ROW(k+1,j,smu); - i <= last_row_k; - i++, kptr++, jptr++) - (*jptr) += a_kj * (*kptr); - } - } - } - - /* set the last pivot row to be n-1 and check for a zero pivot */ - - *p = n-1; - if (a[n-1][smu] == ZERO) return(n); - - /* return 0 to indicate success */ - - return(0); -} - -void gbsl(realtype **a, long int n, long int smu, long int ml, - long int *p, realtype *b) -{ - long int k, l, i, first_row_k, last_row_k; - realtype mult, *diag_k; - - /* Solve Ly = Pb, store solution y in b */ - - for (k=0; k < n-1; k++) { - l = p[k]; - mult = b[l]; - if (l != k) { - b[l] = b[k]; - b[k] = mult; - } - diag_k = a[k]+smu; - last_row_k = MIN(n-1,k+ml); - for (i=k+1; i <= last_row_k; i++) - b[i] += mult * diag_k[i-k]; - } - - /* Solve Ux = y, store solution x in b */ - - for (k=n-1; k >= 0; k--) { - diag_k = a[k]+smu; - first_row_k = MAX(0,k-smu); - b[k] /= (*diag_k); - mult = -b[k]; - for (i=first_row_k; i <= k-1; i++) - b[i] += mult*diag_k[i-k]; - } -} - -void bandzero(realtype **a, long int n, long int mu, long int ml, - long int smu) -{ - long int i, j, colSize; - realtype *col_j; - - colSize = mu + ml + 1; - for (j=0; j < n; j++) { - col_j = a[j]+smu-mu; - for (i=0; i < colSize; i++) - col_j[i] = ZERO; - } -} - -void bandcopy(realtype **a, realtype **b, long int n, long int a_smu, - long int b_smu, long int copymu, long int copyml) -{ - long int i, j, copySize; - realtype *a_col_j, *b_col_j; - - copySize = copymu + copyml + 1; - - for (j=0; j < n; j++) { - a_col_j = a[j]+a_smu-copymu; - b_col_j = b[j]+b_smu-copymu; - for (i=0; i < copySize; i++) - b_col_j[i] = a_col_j[i]; - } -} - -void bandscale(realtype c, realtype **a, long int n, long int mu, - long int ml, long int smu) -{ - long int i, j, colSize; - realtype *col_j; - - colSize = mu + ml + 1; - - for(j=0; j < n; j++) { - col_j = a[j]+smu-mu; - for (i=0; i < colSize; i++) - col_j[i] *= c; - } -} - -void bandaddI(realtype **a, long int n, long int smu) -{ - long int j; - - for(j=0; j < n; j++) - a[j][smu] += ONE; -} - -void bandfreepiv(long int *p) -{ - free(p); -} - -void bandfree(realtype **a) -{ - free(a[0]); - free(a); -} - -void bandprint(realtype **a, long int n, long int mu, long int ml, - long int smu) -{ - long int i, j, start, finish; - - printf("\n"); - for (i=0; i < n; i++) { - start = MAX(0,i-ml); - finish = MIN(n-1,i+mu); - for (j=0; j < start; j++) printf("%10s",""); - for (j=start; j <= finish; j++) { -#if defined(SUNDIALS_EXTENDED_PRECISION) - printf("%10Lg", a[j][i-j+smu]); -#elif defined(SUNDIALS_DOUBLE_PRECISION) - printf("%10lg", a[j][i-j+smu]); -#else - printf("%10g", a[j][i-j+smu]); -#endif - } - printf("\n"); - } - printf("\n"); -} diff --git a/src/sundials/shared/band.h b/src/sundials/shared/band.h deleted file mode 100755 index 247c4cc7e5..0000000000 --- a/src/sundials/shared/band.h +++ /dev/null @@ -1,606 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This is the header file for a generic BAND linear solver - * package. There are two sets of band solver routines listed in - * this file: one set uses type BandMat defined below and the - * other set uses the type realtype ** for band matrix arguments. - * The two sets of band solver routines make it easy to work - * with two types of band matrices: - * - * (1) The BandMat type is intended for use with large - * band matrices whose elements/columns may be stored in - * non-contiguous memory locations or even distributed across - * different process memory spaces. This type may be modified - * to include such distribution information. If this is done, - * then all the routines that use BandMat must be modified to - * reflect the new data structure. - * - * (2) The set of routines that use realtype ** (and NOT the - * BandMat type) is intended for use with small matrices - * which can easily be allocated within a contiguous block of - * memory for a single process. - * - * Routines that work with the type BandMat begin with "Band". - * The BandAllocMat function allocates a band matrix for use in - * the other matrix routines listed in this file. Matrix storage - * details are given in the documentation for the type BandMat. - * The BandAllocPiv function allocates memory for pivot - * information. The storage allocated by BandAllocMat and - * BandAllocPiv is deallocated by the routines BandFreeMat and - * BandFreePiv, respectively. The BandFactor and BandBacksolve - * routines perform the actual solution of a band linear system. - * - * Routines that work with realtype ** begin with "band" (except - * for the factor and solve routines which are called gbfa and - * gbsl, respectively). The underlying matrix storage is - * described in the documentation for bandalloc. - * ----------------------------------------------------------------- - */ - -#ifndef _BAND_H -#define _BAND_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Type: BandMat - * ----------------------------------------------------------------- - * The type BandMat is the type of a large (possibly distributed) - * band matrix. It is defined to be a pointer to a structure - * with the following fields: - * - * size is the number of columns (== number of rows) - * - * mu is the upper bandwidth, 0 <= mu <= size-1 - * - * ml is the lower bandwidth, 0 <= ml <= size-1 - * - * smu is the storage upper bandwidth, mu <= smu <= size-1. - * The BandFactor routine writes the LU factors - * into the storage for A. The upper triangular factor U, - * however, may have an upper bandwidth as big as - * MIN(size-1,mu+ml) because of partial pivoting. The smu - * field holds the upper bandwidth allocated for A. - * - * data is a two dimensional array used for component storage. - * The elements of a band matrix of type BandMat are - * stored columnwise (i.e. columns are stored one on top - * of the other in memory). Only elements within the - * specified bandwidths are stored. - * - * If we number rows and columns in the band matrix starting - * from 0, then - * - * data[0] is a pointer to (smu+ml+1)*size contiguous locations - * which hold the elements within the band of A - * - * data[j] is a pointer to the uppermost element within the band - * in the jth column. This pointer may be treated as - * an array indexed from smu-mu (to access the - * uppermost element within the band in the jth - * column) to smu+ml (to access the lowest element - * within the band in the jth column). (Indices from 0 - * to smu-mu-1 give access to extra storage elements - * required by BandFactor.) - * - * data[j][i-j+smu] is the (i,j)th element, j-mu <= i <= j+ml. - * - * The macros below allow a user to access individual matrix - * elements without writing out explicit data structure - * references and without knowing too much about the underlying - * element storage. The only storage assumption needed is that - * elements are stored columnwise and that a pointer into the jth - * column of elements can be obtained via the BAND_COL macro. The - * BAND_COL_ELEM macro selects an element from a column which has - * already been isolated via BAND_COL. BAND_COL_ELEM allows the - * user to avoid the translation from the matrix location (i,j) - * to the index in the array returned by BAND_COL at which the - * (i,j)th element is stored. See the documentation for BAND_COL - * and BAND_COL_ELEM for usage details. Users should use these - * macros whenever possible. - * ----------------------------------------------------------------- - */ - -typedef struct _BandMat { - long int size; - long int mu, ml, smu; - realtype **data; -} *BandMat; - -/* BandMat accessor macros */ - -/* - * ----------------------------------------------------------------- - * Macro : BAND_ELEM - * ----------------------------------------------------------------- - * Usage : BAND_ELEM(A,i,j) = a_ij; OR - * a_ij = BAND_ELEM(A,i,j); - * ----------------------------------------------------------------- - * BAND_ELEM(A,i,j) references the (i,j)th element of the - * N by N band matrix A, where 0 <= i,j <= N-1. The location - * (i,j) should further satisfy j-(A->mu) <= i <= j+(A->ml). - * ----------------------------------------------------------------- - */ - -#define BAND_ELEM(A,i,j) ((A->data)[j][i-j+(A->smu)]) - -/* - * ----------------------------------------------------------------- - * Macro : BAND_COL - * ----------------------------------------------------------------- - * Usage : col_j = BAND_COL(A,j); - * ----------------------------------------------------------------- - * BAND_COL(A,j) references the diagonal element of the jth - * column of the N by N band matrix A, 0 <= j <= N-1. The type of - * the expression BAND_COL(A,j) is realtype *. The pointer - * returned by the call BAND_COL(A,j) can be treated as an array - * which is indexed from -(A->mu) to (A->ml). - * ----------------------------------------------------------------- - */ - -#define BAND_COL(A,j) (((A->data)[j])+(A->smu)) - -/* - * ----------------------------------------------------------------- - * Macro : BAND_COL_ELEM - * ----------------------------------------------------------------- - * Usage : col_j = BAND_COL(A,j); - * BAND_COL_ELEM(col_j,i,j) = a_ij; OR - * a_ij = BAND_COL_ELEM(col_j,i,j); - * ----------------------------------------------------------------- - * This macro references the (i,j)th entry of the band matrix A - * when used in conjunction with BAND_COL as shown above. The - * index (i,j) should satisfy j-(A->mu) <= i <= j+(A->ml). - * ----------------------------------------------------------------- - */ - -#define BAND_COL_ELEM(col_j,i,j) (col_j[i-j]) - -/* Functions that use the BandMat representation for a band matrix */ - -/* - * ----------------------------------------------------------------- - * Function : BandAllocMat - * ----------------------------------------------------------------- - * Usage : A = BandAllocMat(N, mu, ml, smu); - * if (A == NULL) ... memory request failed - * ----------------------------------------------------------------- - * BandAllocMat allocates memory for an N by N band matrix with - * upper bandwidth mu, lower bandwidth ml, and storage upper - * bandwidth smu. Pass smu as follows depending on whether A will - * be factored by BandFactor: - * - * (1) Pass smu = mu if A will not be factored. - * - * (2) Pass smu = MIN(N-1,mu+ml) if A will be factored. - * - * BandAllocMat returns the storage allocated (type BandMat) or - * NULL if the request for matrix storage cannot be satisfied. - * See the documentation for the type BandMat for matrix storage - * details. - * ----------------------------------------------------------------- - */ - -BandMat BandAllocMat(long int N, long int mu, long int ml, - long int smu); - -/* - * ----------------------------------------------------------------- - * Function : BandAllocPiv - * ----------------------------------------------------------------- - * Usage : p = BandAllocPiv(N); - * if (p == NULL) ... memory request failed - * ----------------------------------------------------------------- - * BandAllocPiv allocates memory for pivot information to be - * filled in by the BandFactor routine during the factorization - * of an N by N band matrix. The underlying type for pivot - * information is an array of N integers and this routine returns - * the pointer to the memory it allocates. If the request for - * pivot storage cannot be satisfied, BandAllocPiv returns NULL. - * ----------------------------------------------------------------- - */ - -long int *BandAllocPiv(long int N); - -/* - * ----------------------------------------------------------------- - * Function : BandFactor - * ----------------------------------------------------------------- - * Usage : ier = BandFactor(A, p); - * if (ier != 0) ... A is singular - * ----------------------------------------------------------------- - * BandFactor performs the LU factorization of the N by N band - * matrix A. This is done using standard Gaussian elimination - * with partial pivoting. - * - * A successful LU factorization leaves the "matrix" A and the - * pivot array p with the following information: - * - * (1) p[k] contains the row number of the pivot element chosen - * at the beginning of elimination step k, k=0, 1, ..., N-1. - * - * (2) If the unique LU factorization of A is given by PA = LU, - * where P is a permutation matrix, L is a lower triangular - * matrix with all 1's on the diagonal, and U is an upper - * triangular matrix, then the upper triangular part of A - * (including its diagonal) contains U and the strictly lower - * triangular part of A contains the multipliers, I-L. - * - * BandFactor returns 0 if successful. Otherwise it encountered - * a zero diagonal element during the factorization. In this case - * it returns the column index (numbered from one) at which - * it encountered the zero. - * - * Important Note: A must be allocated to accommodate the increase - * in upper bandwidth that occurs during factorization. If - * mathematically, A is a band matrix with upper bandwidth mu and - * lower bandwidth ml, then the upper triangular factor U can - * have upper bandwidth as big as smu = MIN(n-1,mu+ml). The lower - * triangular factor L has lower bandwidth ml. Allocate A with - * call A = BandAllocMat(N,mu,ml,smu), where mu, ml, and smu are - * as defined above. The user does not have to zero the "extra" - * storage allocated for the purpose of factorization. This will - * handled by the BandFactor routine. - * ----------------------------------------------------------------- - */ - -long int BandFactor(BandMat A, long int *p); - -/* - * ----------------------------------------------------------------- - * Function : BandBacksolve - * ----------------------------------------------------------------- - * Usage : BandBacksolve(A, p, b); - * ----------------------------------------------------------------- - * BandBacksolve solves the N-dimensional system A x = b using - * the LU factorization in A and the pivot information in p - * computed in BandFactor. The solution x is returned in b. This - * routine cannot fail if the corresponding call to BandFactor - * did not fail. - * ----------------------------------------------------------------- - */ - -void BandBacksolve(BandMat A, long int *p, realtype *b); - -/* - * ----------------------------------------------------------------- - * Function : BandZero - * ----------------------------------------------------------------- - * Usage : BandZero(A); - * ----------------------------------------------------------------- - * A(i,j) <- 0.0, j-(A->mu) <= i <= j+(A->ml). - * ----------------------------------------------------------------- - */ - -void BandZero(BandMat A); - -/* - * ----------------------------------------------------------------- - * Function : BandCopy - * ----------------------------------------------------------------- - * Usage : BandCopy(A, B, copymu, copyml); - * ----------------------------------------------------------------- - * BandCopy copies the submatrix with upper and lower bandwidths - * copymu, copyml of the N by N band matrix A into the N by N - * band matrix B. - * ----------------------------------------------------------------- - */ - -void BandCopy(BandMat A, BandMat B, long int copymu, long int copyml); - -/* - * ----------------------------------------------------------------- - * Function: BandScale - * ----------------------------------------------------------------- - * Usage : BandScale(c, A); - * ----------------------------------------------------------------- - * A(i,j) <- c*A(i,j), j-(A->mu) <= i <= j+(A->ml). - * ----------------------------------------------------------------- - */ - -void BandScale(realtype c, BandMat A); - -/* - * ----------------------------------------------------------------- - * Function : BandAddI - * ----------------------------------------------------------------- - * Usage : BandAddI(A); - * ----------------------------------------------------------------- - * A(j,j) <- A(j,j)+1.0, 0 <= j <= (A->size)-1. - * ----------------------------------------------------------------- - */ - -void BandAddI(BandMat A); - -/* - * ----------------------------------------------------------------- - * Function : BandFreeMat - * ----------------------------------------------------------------- - * Usage : BandFreeMat(A); - * ----------------------------------------------------------------- - * BandFreeMat frees the memory allocated by BandAllocMat for - * the band matrix A. - * ----------------------------------------------------------------- - */ - -void BandFreeMat(BandMat A); - -/* - * ----------------------------------------------------------------- - * Function : BandFreePiv - * ----------------------------------------------------------------- - * Usage : BandFreePiv(p); - * ----------------------------------------------------------------- - * BandFreePiv frees the memory allocated by BandAllocPiv for - * the pivot information array p. - * ----------------------------------------------------------------- - */ - -void BandFreePiv(long int *p); - -/* - * ----------------------------------------------------------------- - * Function : BandPrint - * ----------------------------------------------------------------- - * Usage : BandPrint(A); - * ----------------------------------------------------------------- - * This routine prints the N by N band matrix A (upper and lower - * bandwidths A->mu and A->ml, respectively) to standard output - * as it would normally appear on paper. It is intended as a - * debugging tool with small values of N. The elements are - * printed using the %g/lg/Lg option. A blank line is printed - * before and after the matrix. - * ----------------------------------------------------------------- - */ - -void BandPrint(BandMat A); - -/* Functions that use the realtype ** representation for a band matrix */ - -/* - * ----------------------------------------------------------------- - * Function : bandalloc - * ----------------------------------------------------------------- - * Usage : realtype **a; - * a = bandalloc(n, smu, ml); - * if (a == NULL) ... memory request failed - * ----------------------------------------------------------------- - * bandalloc(n, smu, ml) allocates storage for an n by n band - * matrix A with storage upper bandwidth smu and lower bandwidth - * ml. It returns a pointer to the newly allocated storage if - * successful. If the memory request cannot be satisfied, then - * bandalloc returns NULL. If, mathematically, A has upper and - * lower bandwidths mu and ml, respectively, then the value - * passed to bandalloc for smu may need to be greater than mu. - * The gbfa routine writes the LU factors into the storage (named - * "a" in the above usage documentation) for A (thus destroying - * the original elements of A). The upper triangular factor U, - * however, may have a larger upper bandwidth than the upper - * bandwidth mu of A. Thus some "extra" storage for A must be - * allocated if A is to be factored by gbfa. Pass smu as follows: - * - * (1) Pass smu = mu if A will not be factored. - * - * (2) Pass smu = MIN(n-1,mu+ml) if A will be factored. - * - * The underlying type of the band matrix returned is realtype**. - * If we allocate a band matrix A in realtype **a by - * a = bandalloc(n,smu,ml), then a[0] is a pointer to - * n * (smu + ml + 1) contiguous storage locations and a[j] is a - * pointer to the uppermost element in the storage for the jth - * column. The expression a[j][i-j+smu] references the (i,j)th - * element of A, where 0 <= i,j <= n-1 and j-mu <= i <= j+ml. - * (The elements a[j][0], a[j][1], ..., a[j][smu-mu-1] are used - * by gbfa and gbsl.) - * ----------------------------------------------------------------- - */ - -realtype **bandalloc(long int n, long int smu, long int ml); - -/* - * ----------------------------------------------------------------- - * Function : bandallocpiv - * ----------------------------------------------------------------- - * Usage : long int *pivot; - * pivot = bandallocpiv(n); - * if (pivot == NULL) ... memory request failed - * ----------------------------------------------------------------- - * bandallocpiv(n) allocates an array of n integers. It returns a - * pointer to the first element in the array if successful. It - * returns NULL if the memory request could not be satisfied. - * ----------------------------------------------------------------- - */ - -long int *bandallocpiv(long int n); - -/* - * ----------------------------------------------------------------- - * Function : gbfa - * ----------------------------------------------------------------- - * Usage : long int ier; - * ier = gbfa(a,n,mu,ml,smu,p); - * if (ier > 0) ... zero element encountered during - * the factorization - * ----------------------------------------------------------------- - * gbfa(a,n,mu,ml,smu,p) factors the n by n band matrix A (upper - * and lower bandwidths mu and ml, storage upper bandwidth smu) - * stored in "a". It overwrites the elements of A with the LU - * factors and it keeps track of the pivot rows chosen in the - * pivot array p. - * - * A successful LU factorization leaves a and pivot array p with - * the following information: - * - * (1) p[k] contains the row number of the pivot element chosen - * at the beginning of elimination step k, k=0, 1, ..., n-1. - * - * (2) If the unique LU factorization of A is given by PA = LU, - * where P is a permutation matrix, L is a lower triangular - * matrix with all 1's on the diagonal, and U is an upper - * triangular matrix, then the upper triangular part of A - * (including its diagonal) contains U and the strictly lower - * triangular part of A contains the multipliers, I-L. - * - * gbfa returns 0 if successful. Otherwise it encountered a zero - * diagonal element during the factorization. In this case it - * returns the column index (numbered from one) at which it - * encountered the zero. - * - * IMPORTANT NOTE: Suppose A is a band matrix with upper - * bandwidth mu and lower bandwidth ml, then the upper triangular - * factor U can have upper bandwidth as big as MIN(n-1,mu+ml) - * because of partial pivoting. The lower triangular factor L has - * lower bandwidth ml. Thus, if A is to be factored and - * backsolved using gbfa and gbsl, then it should be allocated - * as a = bandalloc(n,smu,ml), where smu = MIN(n-1,mu+ml). The - * call to gbfa is ier = gbfa(a,n,mu,ml,smu,p). The corresponding - * call to gbsl is gbsl(a,n,smu,ml,p,b). The user does not need - * to zero the "extra" storage allocated for the purpose of - * factorization. This is handled by the gbfa routine. If A is - * not going to be factored and backsolved, then it can be - * allocated as a = bandalloc(n,smu,ml). In either case, all - * routines in this section use the parameter name smu for a - * parameter which must be the "storage upper bandwidth" which - * was passed to bandalloc. - * ----------------------------------------------------------------- - */ - -long int gbfa(realtype **a, long int n, long int mu, long int ml, - long int smu, long int *p); - -/* - * ----------------------------------------------------------------- - * Function : gbsl - * ----------------------------------------------------------------- - * Usage : realtype *b; - * ier = gbfa(a,n,mu,ml,smu,p); - * if (ier == 0) gbsl(a,n,smu,ml,p,b); - * ----------------------------------------------------------------- - * gbsl(a,n,smu,ml,p,b) solves the n by n linear system - * Ax = b, where A is band matrix stored in "a" with storage - * upper bandwidth smu and lower bandwidth ml. It assumes that A - * has been LU factored and the pivot array p has been set by a - * successful call gbfa(a,n,mu,ml,smu,p). The solution x is - * written into the b array. - * ----------------------------------------------------------------- - */ - -void gbsl(realtype **a, long int n, long int smu, - long int ml, long int *p, realtype *b); - -/* - * ----------------------------------------------------------------- - * Function : bandzero - * ----------------------------------------------------------------- - * Usage : bandzero(a,n,mu,ml,smu); - * ----------------------------------------------------------------- - * a(i,j) <- 0.0, 0 <= i,j <= n-1, j-mu <= i <= j+ml. - * ----------------------------------------------------------------- - */ - -void bandzero(realtype **a, long int n, long int mu, - long int ml, long int smu); - -/* - * ----------------------------------------------------------------- - * Function : bandcopy - * ----------------------------------------------------------------- - * Usage : bandcopy(a,b,n,a_smu,b_smu,copymu,copyml); - * ----------------------------------------------------------------- - * b(i,j) <- a(i,j), 0 <= i,j <= n-1, j-copymu <= i <= j+copyml. - * ----------------------------------------------------------------- - */ - -void bandcopy(realtype **a, realtype **b, long int n, - long int a_smu, long int b_smu, - long int copymu, long int copyml); - -/* - * ----------------------------------------------------------------- - * Function : bandscale - * ----------------------------------------------------------------- - * Usage : bandscale(c,a,n,mu,ml); - * ----------------------------------------------------------------- - * a(i,j) <- c*a(i,j), 0 <= i,j <= n-1, j-mu <= i <= j+ml. - * ----------------------------------------------------------------- - */ - -void bandscale(realtype c, realtype **a, long int n, - long int mu, long int ml, long int smu); - -/* - * ----------------------------------------------------------------- - * Function : bandaddI - * ----------------------------------------------------------------- - * Usage : bandaddI(a,n,smu); - * ----------------------------------------------------------------- - * a(j,j) <- a(j,j)+1.0, 0 <= j <= n-1. - * ----------------------------------------------------------------- - */ - -void bandaddI(realtype **a, long int n, long int smu); - -/* - * ----------------------------------------------------------------- - * Function : bandfreepiv - * ----------------------------------------------------------------- - * Usage : bandfreepiv(p); - * ----------------------------------------------------------------- - * bandfreepiv(p) frees the pivot array p allocated by - * bandallocpiv. - * ----------------------------------------------------------------- - */ - -void bandfreepiv(long int *p); - -/* - * ----------------------------------------------------------------- - * Function : bandfree - * ----------------------------------------------------------------- - * Usage : bandfree(a); - * ----------------------------------------------------------------- - * bandfree(a) frees the band matrix a allocated by bandalloc. - * ----------------------------------------------------------------- - */ - -void bandfree(realtype **a); - -/* - * ----------------------------------------------------------------- - * Function : bandprint - * ----------------------------------------------------------------- - * Usage : bandprint(a,n,mu,ml,smu); - * ----------------------------------------------------------------- - * bandprint(a,n,mu,ml,smu) prints the n by n band matrix stored - * in a (with upper bandwidth mu and lower bandwidth ml) to - * standard output as it would normally appear on paper. It is - * intended as a debugging tool with small values of n. The - * elements are printed using the %g/lg/Lg option. A blank line - * is printed before and after the matrix. - * ----------------------------------------------------------------- - */ - -void bandprint(realtype **a, long int n, long int mu, long int ml, - long int smu); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/shared/dense.c b/src/sundials/shared/dense.c deleted file mode 100755 index 2116712ff5..0000000000 --- a/src/sundials/shared/dense.c +++ /dev/null @@ -1,103 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for a generic DENSE linear - * solver package. - * ----------------------------------------------------------------- - */ - -#include -#include - -#include "dense.h" -#include "smalldense.h" -#include "sundialsmath.h" -#include "sundialstypes.h" - -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) - -/* Implementation */ - -DenseMat DenseAllocMat(long int N) -{ - DenseMat A; - - if (N <= 0) return(NULL); - - A = (DenseMat) malloc(sizeof *A); - if (A==NULL) return (NULL); - - A->data = denalloc(N); - if (A->data == NULL) { - free(A); - return(NULL); - } - - A->size = N; - - return(A); -} - -long int *DenseAllocPiv(long int N) -{ - if (N <= 0) return(NULL); - - return((long int *) malloc(N * sizeof(long int))); -} - -long int DenseFactor(DenseMat A, long int *p) -{ - return(gefa(A->data, A->size, p)); -} - -void DenseBacksolve(DenseMat A, long int *p, realtype *b) -{ - gesl(A->data, A->size, p, b); -} - -void DenseZero(DenseMat A) -{ - denzero(A->data, A->size); -} - -void DenseCopy(DenseMat A, DenseMat B) -{ - dencopy(A->data, B->data, A->size); -} - -void DenseScale(realtype c, DenseMat A) -{ - denscale(c, A->data, A->size); -} - -void DenseAddI(DenseMat A) -{ - denaddI(A->data, A->size); -} - -void DenseFreeMat(DenseMat A) -{ - denfree(A->data); - free(A); -} - -void DenseFreePiv(long int *p) -{ - free(p); -} - -void DensePrint(DenseMat A) -{ - denprint(A->data, A->size); -} diff --git a/src/sundials/shared/dense.h b/src/sundials/shared/dense.h deleted file mode 100755 index bdf4b1a0c4..0000000000 --- a/src/sundials/shared/dense.h +++ /dev/null @@ -1,293 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This is the header file for a generic DENSE linear solver - * package. The routines listed in this file all use type - * DenseMat, defined below, for matrices. These routines in turn - * call routines in the smalldense.h/smalldense.c module, which - * use the type realtype** for matrices. This separation allows - * for possible modifications in which matrices of type DenseMat - * may not be stored contiguously, while small matrices can still - * be treated with the routines in smalldense. - * - * Routines that work with the type DenseMat begin with "Dense". - * The DenseAllocMat function allocates a dense matrix for use in - * the other DenseMat routines listed in this file. Matrix - * storage details are given in the documentation for the type - * DenseMat. The DenseAllocPiv function allocates memory for - * pivot information. The storage allocated by DenseAllocMat and - * DenseAllocPiv is deallocated by the routines DenseFreeMat and - * DenseFreePiv, respectively. The DenseFactor and DenseBacksolve - * routines perform the actual solution of a dense linear system. - * - * Routines that work with realtype** begin with "den" (except for - * the factor and solve routines which are called gefa and gesl, - * respectively). The underlying matrix storage is described in - * the documentation for denalloc in smalldense.h - * ----------------------------------------------------------------- - */ - -#ifndef _DENSE_H -#define _DENSE_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include "sundialstypes.h" -#include "smalldense.h" - -/* - * ----------------------------------------------------------------- - * Type : DenseMat - * ----------------------------------------------------------------- - * The type DenseMat is defined to be a pointer to a structure - * with a size and a data field. The size field indicates the - * number of columns (== number of rows) of a dense matrix, while - * the data field is a two dimensional array used for component - * storage. The elements of a dense matrix are stored columnwise - * (i.e columns are stored one on top of the other in memory). If - * A is of type DenseMat, then the (i,j)th element of A (with - * 0 <= i,j <= size-1) is given by the expression (A->data)[j][i] - * or by the expression (A->data)[0][j*n+i]. The macros below - * allow a user to access efficiently individual matrix - * elements without writing out explicit data structure - * references and without knowing too much about the underlying - * element storage. The only storage assumption needed is that - * elements are stored columnwise and that a pointer to the jth - * column of elements can be obtained via the DENSE_COL macro. - * Users should use these macros whenever possible. - * ----------------------------------------------------------------- - */ - -typedef struct _DenseMat { - long int size; - realtype **data; -} *DenseMat; - -/* DenseMat accessor macros */ - -/* - * ----------------------------------------------------------------- - * Macro : DENSE_ELEM - * ----------------------------------------------------------------- - * Usage : DENSE_ELEM(A,i,j) = a_ij; OR - * a_ij = DENSE_ELEM(A,i,j); - * ----------------------------------------------------------------- - * DENSE_ELEM(A,i,j) references the (i,j)th element of the N by N - * DenseMat A, 0 <= i,j <= N-1. - * ----------------------------------------------------------------- - */ - -#define DENSE_ELEM(A,i,j) ((A->data)[j][i]) - -/* - * ----------------------------------------------------------------- - * Macro : DENSE_COL - * ----------------------------------------------------------------- - * Usage : col_j = DENSE_COL(A,j); - * ----------------------------------------------------------------- - * DENSE_COL(A,j) references the jth column of the N by N - * DenseMat A, 0 <= j <= N-1. The type of the expression - * DENSE_COL(A,j) is realtype *. After the assignment in the usage - * above, col_j may be treated as an array indexed from 0 to N-1. - * The (i,j)th element of A is referenced by col_j[i]. - * ----------------------------------------------------------------- - */ - -#define DENSE_COL(A,j) ((A->data)[j]) - -/* Functions that use the DenseMat representation for a dense matrix */ - -/* - * ----------------------------------------------------------------- - * Function : DenseAllocMat - * ----------------------------------------------------------------- - * Usage : A = DenseAllocMat(N); - * if (A == NULL) ... memory request failed - * ----------------------------------------------------------------- - * DenseAllocMat allocates memory for an N by N dense matrix and - * returns the storage allocated (type DenseMat). DenseAllocMat - * returns NULL if the request for matrix storage cannot be - * satisfied. See the above documentation for the type DenseMat - * for matrix storage details. - * ----------------------------------------------------------------- - */ - -DenseMat DenseAllocMat(long int N); - -/* - * ----------------------------------------------------------------- - * Function : DenseAllocPiv - * ----------------------------------------------------------------- - * Usage : p = DenseAllocPiv(N); - * if (p == NULL) ... memory request failed - * ----------------------------------------------------------------- - * DenseAllocPiv allocates memory for pivot information to be - * filled in by the DenseFactor routine during the factorization - * of an N by N dense matrix. The underlying type for pivot - * information is an array of N integers and this routine returns - * the pointer to the memory it allocates. If the request for - * pivot storage cannot be satisfied, DenseAllocPiv returns NULL. - * ----------------------------------------------------------------- - */ - -long int *DenseAllocPiv(long int N); - -/* - * ----------------------------------------------------------------- - * Function : DenseFactor - * ----------------------------------------------------------------- - * Usage : ier = DenseFactor(A, p); - * if (ier != 0) ... A is singular - * ----------------------------------------------------------------- - * DenseFactor performs the LU factorization of the N by N dense - * matrix A. This is done using standard Gaussian elimination - * with partial pivoting. - * - * A successful LU factorization leaves the matrix A and the - * pivot array p with the following information: - * - * (1) p[k] contains the row number of the pivot element chosen - * at the beginning of elimination step k, k=0, 1, ..., N-1. - * - * (2) If the unique LU factorization of A is given by PA = LU, - * where P is a permutation matrix, L is a lower triangular - * matrix with all 1's on the diagonal, and U is an upper - * triangular matrix, then the upper triangular part of A - * (including its diagonal) contains U and the strictly lower - * triangular part of A contains the multipliers, I-L. - * - * DenseFactor returns 0 if successful. Otherwise it encountered - * a zero diagonal element during the factorization. In this case - * it returns the column index (numbered from one) at which - * it encountered the zero. - * ----------------------------------------------------------------- - */ - -long int DenseFactor(DenseMat A, long int *p); - -/* - * ----------------------------------------------------------------- - * Function : DenseBacksolve - * ----------------------------------------------------------------- - * Usage : DenseBacksolve(A, p, b); - * ----------------------------------------------------------------- - * DenseBacksolve solves the N-dimensional system A x = b using - * the LU factorization in A and the pivot information in p - * computed in DenseFactor. The solution x is returned in b. This - * routine cannot fail if the corresponding call to DenseFactor - * did not fail. - * ----------------------------------------------------------------- - */ - -void DenseBacksolve(DenseMat A, long int *p, realtype *b); - -/* - * ----------------------------------------------------------------- - * Function : DenseZero - * ----------------------------------------------------------------- - * Usage : DenseZero(A); - * ----------------------------------------------------------------- - * DenseZero sets all the elements of the N by N matrix A to 0.0. - * ----------------------------------------------------------------- - */ - -void DenseZero(DenseMat A); - -/* - * ----------------------------------------------------------------- - * Function : DenseCopy - * ----------------------------------------------------------------- - * Usage : DenseCopy(A, B); - * ----------------------------------------------------------------- - * DenseCopy copies the contents of the N by N matrix A into the - * N by N matrix B. - * ----------------------------------------------------------------- - */ - -void DenseCopy(DenseMat A, DenseMat B); - -/* - * ----------------------------------------------------------------- - * Function: DenseScale - * ----------------------------------------------------------------- - * Usage : DenseScale(c, A); - * ----------------------------------------------------------------- - * DenseScale scales the elements of the N by N matrix A by the - * constant c and stores the result back in A. - * ----------------------------------------------------------------- - */ - -void DenseScale(realtype c, DenseMat A); - -/* - * ----------------------------------------------------------------- - * Function : DenseAddI - * ----------------------------------------------------------------- - * Usage : DenseAddI(A); - * ----------------------------------------------------------------- - * DenseAddI adds the identity matrix to A and stores the result - * back in A. - * ----------------------------------------------------------------- - */ - -void DenseAddI(DenseMat A); - -/* - * ----------------------------------------------------------------- - * Function : DenseFreeMat - * ----------------------------------------------------------------- - * Usage : DenseFreeMat(A); - * ----------------------------------------------------------------- - * DenseFreeMat frees the memory allocated by DenseAllocMat for - * the N by N matrix A. - * ----------------------------------------------------------------- - */ - -void DenseFreeMat(DenseMat A); - -/* - * ----------------------------------------------------------------- - * Function : DenseFreePiv - * ----------------------------------------------------------------- - * Usage : DenseFreePiv(p); - * ----------------------------------------------------------------- - * DenseFreePiv frees the memory allocated by DenseAllocPiv for - * the pivot information array p. - * ----------------------------------------------------------------- - */ - -void DenseFreePiv(long int *p); - -/* - * ----------------------------------------------------------------- - * Function : DensePrint - * ----------------------------------------------------------------- - * Usage : DensePrint(A); - * ----------------------------------------------------------------- - * This routine prints the N by N dense matrix A to standard - * output as it would normally appear on paper. It is intended - * as a debugging tool with small values of N. The elements are - * printed using the %g/lg/Lg option. A blank line is printed - * before and after the matrix. - * ----------------------------------------------------------------- - */ - -void DensePrint(DenseMat A); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/shared/fnvector_parallel.c b/src/sundials/shared/fnvector_parallel.c deleted file mode 100755 index 877b1bafc5..0000000000 --- a/src/sundials/shared/fnvector_parallel.c +++ /dev/null @@ -1,48 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This file (companion of nvector_serial.h) contains the - * implementation needed for the Fortran initialization of parallel - * vector operations. - * ----------------------------------------------------------------- - */ - -#include -#include - -#include "fnvector_parallel.h" -#include "mpi.h" -#include "nvector_parallel.h" -#include "sundialstypes.h" - -/* Define global variable F2C_vec */ -N_Vector F2C_vec; - -/* Fortran callable interfaces */ - -void FNV_INITP(long int *nlocal, long int *nglobal, int *ier) -{ - /* Call N_VNew_Parallel: - the first slot is for the communicator. - (From Fortran, only MPI_COMM_WORLD is allowed) - *nlocal is the local vector length - *nglobal is the global vector length */ - - F2C_vec = N_VNew_Parallel(MPI_COMM_WORLD, *nlocal, *nglobal); - - *ier = (F2C_vec == NULL) ? -1 : 0 ; -} - -void FNV_FREEP(void) -{ - N_VDestroy_Parallel(F2C_vec); -} diff --git a/src/sundials/shared/fnvector_parallel.h b/src/sundials/shared/fnvector_parallel.h deleted file mode 100755 index 85c9b1b63a..0000000000 --- a/src/sundials/shared/fnvector_parallel.h +++ /dev/null @@ -1,64 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Radu Serban and Aaron Collier @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This file (companion of nvector_serial.h) contains the - * definitions needed for the initialization of parallel - * vector operations in Fortran. - * ----------------------------------------------------------------- - */ - -#ifndef _FNVECTOR_PARALLEL_H -#define _FNVECTOR_PARALLEL_H - -#ifndef _SUNDIALS_CONFIG_H -#define _SUNDIALS_CONFIG_H -#include "sundials_config.h" -#endif - -#if defined(F77_FUNC) - -#define FNV_INITP F77_FUNC(fnvinitp, FNVINITP) -#define FNV_FREEP F77_FUNC(fnvfreep, FNVFREEP) - -#elif defined(SUNDIALS_UNDERSCORE_NONE) && defined(SUNDIALS_CASE_LOWER) - -#define FNV_INITP fnvinitp -#define FNV_FREEP fnvfreep - -#elif defined(SUNDIALS_UNDERSCORE_NONE) && defined(SUNDIALS_CASE_UPPER) - -#define FNV_INITP FNVINITP -#define FNV_FREEP FNVFREEP - -#elif defined(SUNDIALS_UNDERSCORE_ONE) && defined(SUNDIALS_CASE_LOWER) - -#define FNV_INITP fnvinitp_ -#define FNV_FREEP fnvfreep_ - -#elif defined(SUNDIALS_UNDERSCORE_ONE) && defined(SUNDIALS_CASE_UPPER) - -#define FNV_INITP FNVINITP_ -#define FNV_FREEP FNVFREEP_ - -#elif defined(SUNDIALS_UNDERSCORE_TWO) && defined(SUNDIALS_CASE_LOWER) - -#define FNV_INITP fnvinitp__ -#define FNV_FREEP fnvfreep__ - -#elif defined(SUNDIALS_UNDERSCORE_TWO) && defined(SUNDIALS_CASE_UPPER) - -#define FNV_INITP FNVINITP__ -#define FNV_FREEP FNVFREEP__ - -#endif - -#endif diff --git a/src/sundials/shared/fnvector_serial.c b/src/sundials/shared/fnvector_serial.c deleted file mode 100755 index 065f26532d..0000000000 --- a/src/sundials/shared/fnvector_serial.c +++ /dev/null @@ -1,42 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This file (companion of nvector_serial.h) contains the - * implementation needed for the Fortran initialization of serial - * vector operations. - * ----------------------------------------------------------------- - */ - -#include -#include - -#include "fnvector_serial.h" -#include "nvector_serial.h" -#include "sundialstypes.h" - -/* Define global variable F2C_vec */ -N_Vector F2C_vec; - -/* Fortran callable interfaces */ - -void FNV_INITS(long int *neq, int *ier) -{ - F2C_vec = N_VNew_Serial(*neq); - - *ier = (F2C_vec == NULL) ? -1 : 0 ; -} - -void FNV_FREES(void) -{ - N_VDestroy_Serial(F2C_vec); -} - diff --git a/src/sundials/shared/fnvector_serial.h b/src/sundials/shared/fnvector_serial.h deleted file mode 100755 index 6403cf0e38..0000000000 --- a/src/sundials/shared/fnvector_serial.h +++ /dev/null @@ -1,64 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Radu Serban and Aaron Collier @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This file (companion of nvector_serial.h) contains the - * definitions needed for the initialization of serial - * vector operations in Fortran. - * ----------------------------------------------------------------- - */ - -#ifndef _FNVECTOR_SERIAL_H -#define _FNVECTOR_SERIAL_H - -#ifndef _SUNDIALS_CONFIG_H -#define _SUNDIALS_CONFIG_H -#include "sundials_config.h" -#endif - -#if defined(F77_FUNC) - -#define FNV_INITS F77_FUNC(fnvinits, FNVINITS) -#define FNV_FREES F77_FUNC(fnvfrees, FNVFREES) - -#elif defined(SUNDIALS_UNDERSCORE_NONE) && defined(SUNDIALS_CASE_LOWER) - -#define FNV_INITS fnvinits -#define FNV_FREES fnvfrees - -#elif defined(SUNDIALS_UNDERSCORE_NONE) && defined(SUNDIALS_CASE_UPPER) - -#define FNV_INITS FNVINITS -#define FNV_FREES FNVFREES - -#elif defined(SUNDIALS_UNDERSCORE_ONE) && defined(SUNDIALS_CASE_LOWER) - -#define FNV_INITS fnvinits_ -#define FNV_FREES fnvfrees_ - -#elif defined(SUNDIALS_UNDERSCORE_ONE) && defined(SUNDIALS_CASE_UPPER) - -#define FNV_INITS FNVINITS_ -#define FNV_FREES FNVFREES_ - -#elif defined(SUNDIALS_UNDERSCORE_TWO) && defined(SUNDIALS_CASE_LOWER) - -#define FNV_INITS fnvinits__ -#define FNV_FREES fnvfrees__ - -#elif defined(SUNDIALS_UNDERSCORE_TWO) && defined(SUNDIALS_CASE_UPPER) - -#define FNV_INITS FNVINITS__ -#define FNV_FREES FNVFREES__ - -#endif - -#endif diff --git a/src/sundials/shared/iterative.c b/src/sundials/shared/iterative.c deleted file mode 100755 index da70df04cb..0000000000 --- a/src/sundials/shared/iterative.c +++ /dev/null @@ -1,290 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for the iterative.h header - * file. It contains the implementation of functions that may be - * useful for many different iterative solvers of A x = b. - * ----------------------------------------------------------------- - */ - -#include - -#include "iterative.h" -#include "nvector.h" -#include "sundialsmath.h" -#include "sundialstypes.h" - -#define FACTOR RCONST(1000.0) -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) - -/* - * ----------------------------------------------------------------- - * Function : ModifiedGS - * ----------------------------------------------------------------- - * This implementation of ModifiedGS is a slight modification of a - * previous modified Gram-Schmidt routine (called mgs) written by - * Milo Dorr. - * ----------------------------------------------------------------- - */ - -int ModifiedGS(N_Vector *v, realtype **h, int k, int p, - realtype *new_vk_norm) -{ - int i, k_minus_1, i0; - realtype new_norm_2, new_product, vk_norm, temp; - - vk_norm = RSqrt(N_VDotProd(v[k],v[k])); - k_minus_1 = k - 1; - i0 = MAX(k-p, 0); - - /* Perform modified Gram-Schmidt */ - - for (i=i0; i < k; i++) { - h[i][k_minus_1] = N_VDotProd(v[i], v[k]); - N_VLinearSum(ONE, v[k], -h[i][k_minus_1], v[i], v[k]); - } - - /* Compute the norm of the new vector at v[k] */ - - *new_vk_norm = RSqrt(N_VDotProd(v[k], v[k])); - - /* If the norm of the new vector at v[k] is less than - FACTOR (== 1000) times unit roundoff times the norm of the - input vector v[k], then the vector will be reorthogonalized - in order to ensure that nonorthogonality is not being masked - by a very small vector length. */ - - temp = FACTOR * vk_norm; - if ((temp + (*new_vk_norm)) != temp) return(0); - - new_norm_2 = ZERO; - - for (i=i0; i < k; i++) { - new_product = N_VDotProd(v[i], v[k]); - temp = FACTOR * h[i][k_minus_1]; - if ((temp + new_product) == temp) continue; - h[i][k_minus_1] += new_product; - N_VLinearSum(ONE, v[k],-new_product, v[i], v[k]); - new_norm_2 += SQR(new_product); - } - - if (new_norm_2 != ZERO) { - new_product = SQR(*new_vk_norm) - new_norm_2; - *new_vk_norm = (new_product > ZERO) ? RSqrt(new_product) : ZERO; - } - - return(0); -} - -/* - * ----------------------------------------------------------------- - * Function : ClassicalGS - * ----------------------------------------------------------------- - * This implementation of ClassicalGS was contributed by Homer Walker - * and Peter Brown. - * ----------------------------------------------------------------- - */ - -int ClassicalGS(N_Vector *v, realtype **h, int k, int p, - realtype *new_vk_norm, N_Vector temp, realtype *s) -{ - int i, k_minus_1, i0; - realtype vk_norm; - - k_minus_1 = k - 1; - - /* Perform Classical Gram-Schmidt */ - - vk_norm = RSqrt(N_VDotProd(v[k], v[k])); - - i0 = MAX(k-p, 0); - for (i=i0; i < k; i++) { - h[i][k_minus_1] = N_VDotProd(v[i], v[k]); - } - - for (i=i0; i < k; i++) { - N_VLinearSum(ONE, v[k], -h[i][k_minus_1], v[i], v[k]); - } - - /* Compute the norm of the new vector at v[k] */ - - *new_vk_norm = RSqrt(N_VDotProd(v[k], v[k])); - - /* Reorthogonalize if necessary */ - - if ((FACTOR * (*new_vk_norm)) < vk_norm) { - - for (i=i0; i < k; i++) { - s[i] = N_VDotProd(v[i], v[k]); - } - - if (i0 < k) { - N_VScale(s[i0], v[i0], temp); - h[i0][k_minus_1] += s[i0]; - } - for (i=i0+1; i < k; i++) { - N_VLinearSum(s[i], v[i], ONE, temp, temp); - h[i][k_minus_1] += s[i]; - } - N_VLinearSum(ONE, v[k], -ONE, temp, v[k]); - - *new_vk_norm = RSqrt(N_VDotProd(v[k],v[k])); - } - - return(0); -} - -/* - * ----------------------------------------------------------------- - * Function : QRfact - * ----------------------------------------------------------------- - * This implementation of QRfact is a slight modification of a - * previous routine (called qrfact) written by Milo Dorr. - * ----------------------------------------------------------------- - */ - -int QRfact(int n, realtype **h, realtype *q, int job) -{ - realtype c, s, temp1, temp2, temp3; - int i, j, k, q_ptr, n_minus_1, code=0; - - switch (job) { - case 0: - - /* Compute a new factorization of H */ - - code = 0; - for (k=0; k < n; k++) { - - /* Multiply column k by the previous k-1 Givens rotations */ - - for (j=0; j < k-1; j++) { - i = 2*j; - temp1 = h[j][k]; - temp2 = h[j+1][k]; - c = q[i]; - s = q[i+1]; - h[j][k] = c*temp1 - s*temp2; - h[j+1][k] = s*temp1 + c*temp2; - } - - /* Compute the Givens rotation components c and s */ - - q_ptr = 2*k; - temp1 = h[k][k]; - temp2 = h[k+1][k]; - if( temp2 == ZERO) { - c = ONE; - s = ZERO; - } else if (ABS(temp2) >= ABS(temp1)) { - temp3 = temp1/temp2; - s = -ONE/RSqrt(ONE+SQR(temp3)); - c = -s*temp3; - } else { - temp3 = temp2/temp1; - c = ONE/RSqrt(ONE+SQR(temp3)); - s = -c*temp3; - } - q[q_ptr] = c; - q[q_ptr+1] = s; - if( (h[k][k] = c*temp1 - s*temp2) == ZERO) code = k+1; - } - break; - - default: - - /* Update the factored H to which a new column has been added */ - - n_minus_1 = n - 1; - code = 0; - - /* Multiply the new column by the previous n-1 Givens rotations */ - - for (k=0; k < n_minus_1; k++) { - i = 2*k; - temp1 = h[k][n_minus_1]; - temp2 = h[k+1][n_minus_1]; - c = q[i]; - s = q[i+1]; - h[k][n_minus_1] = c*temp1 - s*temp2; - h[k+1][n_minus_1] = s*temp1 + c*temp2; - } - - /* Compute new Givens rotation and multiply it times the last two - entries in the new column of H. Note that the second entry of - this product will be 0, so it is not necessary to compute it. */ - - temp1 = h[n_minus_1][n_minus_1]; - temp2 = h[n][n_minus_1]; - if (temp2 == ZERO) { - c = ONE; - s = ZERO; - } else if (ABS(temp2) >= ABS(temp1)) { - temp3 = temp1/temp2; - s = -ONE/RSqrt(ONE+SQR(temp3)); - c = -s*temp3; - } else { - temp3 = temp2/temp1; - c = ONE/RSqrt(ONE+SQR(temp3)); - s = -c*temp3; - } - q_ptr = 2*n_minus_1; - q[q_ptr] = c; - q[q_ptr+1] = s; - if ((h[n_minus_1][n_minus_1] = c*temp1 - s*temp2) == ZERO) - code = n; - } - - return (code); -} - -/* - * ----------------------------------------------------------------- - * Function : QRsol - * ----------------------------------------------------------------- - * This implementation of QRsol is a slight modification of a - * previous routine (called qrsol) written by Milo Dorr. - * ----------------------------------------------------------------- - */ - -int QRsol(int n, realtype **h, realtype *q, realtype *b) -{ - realtype c, s, temp1, temp2; - int i, k, q_ptr, code=0; - - /* Compute Q*b */ - - for (k=0; k < n; k++) { - q_ptr = 2*k; - c = q[q_ptr]; - s = q[q_ptr+1]; - temp1 = b[k]; - temp2 = b[k+1]; - b[k] = c*temp1 - s*temp2; - b[k+1] = s*temp1 + c*temp2; - } - - /* Solve R*x = Q*b */ - - for (k=n-1; k >= 0; k--) { - if (h[k][k] == ZERO) { - code = k + 1; - break; - } - b[k] /= h[k][k]; - for (i=0; i < k; i++) b[i] -= b[k]*h[i][k]; - } - - return (code); -} diff --git a/src/sundials/shared/iterative.h b/src/sundials/shared/iterative.h deleted file mode 100755 index 363aa6ce47..0000000000 --- a/src/sundials/shared/iterative.h +++ /dev/null @@ -1,242 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen and Alan C. Hindmarsh @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This header file contains declarations intended for use by - * generic iterative solvers of Ax = b. The enumeration gives - * symbolic names for the type of preconditioning to be used. - * The function type declarations give the prototypes for the - * functions to be called within an iterative linear solver, that - * are responsible for - * multiplying A by a given vector v (ATimesFn), and - * solving the preconditioner equation Pz = r (PSolveFn). - * ----------------------------------------------------------------- - */ - -#ifndef _ITERATIVE_H -#define _ITERATIVE_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include "sundialstypes.h" -#include "nvector.h" - -/* - * ----------------------------------------------------------------- - * enum : types of preconditioning - * ----------------------------------------------------------------- - * PREC_NONE : The iterative linear solver should not use - * preconditioning. - * - * PREC_LEFT : The iterative linear solver uses preconditioning on - * the left only. - * - * PREC_RIGHT : The iterative linear solver uses preconditioning on - * the right only. - * - * PREC_BOTH : The iterative linear solver uses preconditioning on - * both the left and the right. - * ----------------------------------------------------------------- - */ - -enum { PREC_NONE, PREC_LEFT, PREC_RIGHT, PREC_BOTH }; - -/* - * ----------------------------------------------------------------- - * enum : types of Gram-Schmidt routines - * ----------------------------------------------------------------- - * MODIFIED_GS : The iterative solver uses the modified - * Gram-Schmidt routine ModifiedGS listed in this - * file. - * - * CLASSICAL_GS : The iterative solver uses the classical - * Gram-Schmidt routine ClassicalGS listed in this - * file. - * ----------------------------------------------------------------- - */ - -enum { MODIFIED_GS = 1, CLASSICAL_GS = 2 }; - -/* - * ----------------------------------------------------------------- - * Type: ATimesFn - * ----------------------------------------------------------------- - * An ATimesFn multiplies Av and stores the result in z. The - * caller is responsible for allocating memory for the z vector. - * The parameter A_data is a pointer to any information about A - * which the function needs in order to do its job. The vector v - * is unchanged. An ATimesFn returns 0 if successful and a - * non-zero value if unsuccessful. - * ----------------------------------------------------------------- - */ - -typedef int (*ATimesFn)(void *A_data, N_Vector v, N_Vector z); - -/* - * ----------------------------------------------------------------- - * Type: PSolveFn - * ----------------------------------------------------------------- - * A PSolveFn solves the preconditioner equation Pz = r for the - * vector z. The caller is responsible for allocating memory for - * the z vector. The parameter P_data is a pointer to any - * information about P which the function needs in order to do - * its job. The parameter lr is input, and indicates whether P - * is to be taken as the left preconditioner or the right - * preconditioner: lr = 1 for left and lr = 2 for right. - * If preconditioning is on one side only, lr can be ignored. - * The vector r is unchanged. - * A PSolveFn returns 0 if successful and a non-zero value if - * unsuccessful. On a failure, a negative return value indicates - * an unrecoverable condition, while a positive value indicates - * a recoverable one, in which the calling routine may reattempt - * the solution after updating preconditioner data. - * ----------------------------------------------------------------- - */ - -typedef int (*PSolveFn)(void *P_data, N_Vector r, N_Vector z, int lr); - -/* - * ----------------------------------------------------------------- - * Function: ModifiedGS - * ----------------------------------------------------------------- - * ModifiedGS performs a modified Gram-Schmidt orthogonalization - * of the N_Vector v[k] against the p unit N_Vectors at - * v[k-1], v[k-2], ..., v[k-p]. - * - * v is an array of (k+1) N_Vectors v[i], i=0, 1, ..., k. - * v[k-1], v[k-2], ..., v[k-p] are assumed to have L2-norm - * equal to 1. - * - * h is the output k by k Hessenberg matrix of inner products. - * This matrix must be allocated row-wise so that the (i,j)th - * entry is h[i][j]. The inner products (v[i],v[k]), - * i=i0, i0+1, ..., k-1, are stored at h[i][k-1]. Here - * i0=MAX(0,k-p). - * - * k is the index of the vector in the v array that needs to be - * orthogonalized against previous vectors in the v array. - * - * p is the number of previous vectors in the v array against - * which v[k] is to be orthogonalized. - * - * new_vk_norm is a pointer to memory allocated by the caller to - * hold the Euclidean norm of the orthogonalized vector v[k]. - * - * If (k-p) < 0, then ModifiedGS uses p=k. The orthogonalized - * v[k] is NOT normalized and is stored over the old v[k]. Once - * the orthogonalization has been performed, the Euclidean norm - * of v[k] is stored in (*new_vk_norm). - * - * ModifiedGS returns 0 to indicate success. It cannot fail. - * ----------------------------------------------------------------- - */ - -int ModifiedGS(N_Vector *v, realtype **h, int k, int p, - realtype *new_vk_norm); - -/* - * ----------------------------------------------------------------- - * Function: ClassicalGS - * ----------------------------------------------------------------- - * ClassicalGS performs a classical Gram-Schmidt - * orthogonalization of the N_Vector v[k] against the p unit - * N_Vectors at v[k-1], v[k-2], ..., v[k-p]. The parameters v, h, - * k, p, and new_vk_norm are as described in the documentation - * for ModifiedGS. - * - * temp is an N_Vector which can be used as workspace by the - * ClassicalGS routine. - * - * s is a length k array of realtype which can be used as - * workspace by the ClassicalGS routine. - * - * ClassicalGS returns 0 to indicate success. It cannot fail. - * ----------------------------------------------------------------- - */ - -int ClassicalGS(N_Vector *v, realtype **h, int k, int p, - realtype *new_vk_norm, N_Vector temp, realtype *s); - -/* - * ----------------------------------------------------------------- - * Function: QRfact - * ----------------------------------------------------------------- - * QRfact performs a QR factorization of the Hessenberg matrix H. - * - * n is the problem size; the matrix H is (n+1) by n. - * - * h is the (n+1) by n Hessenberg matrix H to be factored. It is - * stored row-wise. - * - * q is an array of length 2*n containing the Givens rotations - * computed by this function. A Givens rotation has the form: - * | c -s | - * | s c |. - * The components of the Givens rotations are stored in q as - * (c, s, c, s, ..., c, s). - * - * job is a control flag. If job==0, then a new QR factorization - * is performed. If job!=0, then it is assumed that the first - * n-1 columns of h have already been factored and only the last - * column needs to be updated. - * - * QRfact returns 0 if successful. If a zero is encountered on - * the diagonal of the triangular factor R, then QRfact returns - * the equation number of the zero entry, where the equations are - * numbered from 1, not 0. If QRsol is subsequently called in - * this situation, it will return an error because it could not - * divide by the zero diagonal entry. - * ----------------------------------------------------------------- - */ - -int QRfact(int n, realtype **h, realtype *q, int job); - -/* - * ----------------------------------------------------------------- - * Function: QRsol - * ----------------------------------------------------------------- - * QRsol solves the linear least squares problem - * - * min (b - H*x, b - H*x), x in R^n, - * - * where H is a Hessenberg matrix, and b is in R^(n+1). - * It uses the QR factors of H computed by QRfact. - * - * n is the problem size; the matrix H is (n+1) by n. - * - * h is a matrix (computed by QRfact) containing the upper - * triangular factor R of the original Hessenberg matrix H. - * - * q is an array of length 2*n (computed by QRfact) containing - * the Givens rotations used to factor H. - * - * b is the (n+1)-vector appearing in the least squares problem - * above. - * - * On return, b contains the solution x of the least squares - * problem, if QRsol was successful. - * - * QRsol returns a 0 if successful. Otherwise, a zero was - * encountered on the diagonal of the triangular factor R. - * In this case, QRsol returns the equation number (numbered - * from 1, not 0) of the zero entry. - * ----------------------------------------------------------------- - */ - -int QRsol(int n, realtype **h, realtype *q, realtype *b); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/shared/nvector.c b/src/sundials/shared/nvector.c deleted file mode 100755 index 1c13d6af55..0000000000 --- a/src/sundials/shared/nvector.c +++ /dev/null @@ -1,210 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for a generic NVECTOR package. - * It contains the implementation of the N_Vector kernels listed in - * nvector.h. - * ----------------------------------------------------------------- - */ - -#include - -#include "nvector.h" - -/* - * ----------------------------------------------------------------- - * Functions in the 'ops' structure - * ----------------------------------------------------------------- - */ - -N_Vector N_VClone(N_Vector w) -{ - N_Vector v; - v = w->ops->nvclone(w); - return(v); -} - -void N_VDestroy(N_Vector v) -{ - v->ops->nvdestroy(v); -} - -void N_VSpace(N_Vector v, long int *lrw, long int *liw) -{ - v->ops->nvspace(v, lrw, liw); -} - -realtype *N_VGetArrayPointer(N_Vector v) -{ - realtype *data; - data = v->ops->nvgetarraypointer(v); - return(data); -} - -void N_VSetArrayPointer(realtype *v_data, N_Vector v) -{ - v->ops->nvsetarraypointer(v_data, v); -} - -void N_VLinearSum(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) -{ - z->ops->nvlinearsum(a, x, b, y, z); -} - -void N_VConst(realtype c, N_Vector z) -{ - z->ops->nvconst(c, z); -} - -void N_VProd(N_Vector x, N_Vector y, N_Vector z) -{ - z->ops->nvprod(x, y, z); -} - -void N_VDiv(N_Vector x, N_Vector y, N_Vector z) -{ - z->ops->nvdiv(x, y, z); -} - -void N_VScale(realtype c, N_Vector x, N_Vector z) -{ - z->ops->nvscale(c, x, z); -} - -void N_VAbs(N_Vector x, N_Vector z) -{ - z->ops->nvabs(x, z); -} - -void N_VInv(N_Vector x, N_Vector z) -{ - z->ops->nvinv(x, z); -} - -void N_VAddConst(N_Vector x, realtype b, N_Vector z) -{ - z->ops->nvaddconst(x, b, z); -} - -realtype N_VDotProd(N_Vector x, N_Vector y) -{ - realtype prod; - prod = y->ops->nvdotprod(x, y); - return(prod); -} - -realtype N_VMaxNorm(N_Vector x) -{ - realtype norm; - norm = x->ops->nvmaxnorm(x); - return(norm); -} - -realtype N_VWrmsNorm(N_Vector x, N_Vector w) -{ - realtype norm; - norm = x->ops->nvwrmsnorm(x, w); - return(norm); -} - -realtype N_VWrmsNormMask(N_Vector x, N_Vector w, N_Vector id) -{ - realtype norm; - norm = x->ops->nvwrmsnormmask(x, w, id); - return(norm); -} - -realtype N_VMin(N_Vector x) -{ - realtype minval; - minval = x->ops->nvmin(x); - return(minval); -} - -realtype N_VWL2Norm(N_Vector x, N_Vector w) -{ - realtype norm; - norm = x->ops->nvwl2norm(x, w); - return(norm); -} - -realtype N_VL1Norm(N_Vector x) -{ - realtype norm; - norm = x->ops->nvl1norm(x); - return(norm); -} - -void N_VCompare(realtype c, N_Vector x, N_Vector z) -{ - z->ops->nvcompare(c, x, z); -} - -booleantype N_VInvTest(N_Vector x, N_Vector z) -{ - booleantype flag; - flag = z->ops->nvinvtest(x, z); - return(flag); -} - -booleantype N_VConstrMask(N_Vector c, N_Vector x, N_Vector m) -{ - booleantype flag; - flag = x->ops->nvconstrmask(c, x, m); - return(flag); -} - -realtype N_VMinQuotient(N_Vector num, N_Vector denom) -{ - realtype quotient; - quotient = num->ops->nvminquotient(num, denom); - return(quotient); -} - -/* - * ----------------------------------------------------------------- - * Additional functions exported by the generic NVECTOR: - * N_VCloneVectorArray - * N_VDestroyVectorArray - * ----------------------------------------------------------------- - */ - -N_Vector *N_VCloneVectorArray(int count, N_Vector w) -{ - N_Vector *vs; - int j; - - if (count <= 0) return(NULL); - - vs = (N_Vector *) malloc(count * sizeof(N_Vector)); - if(vs == NULL) return(NULL); - - for (j=0; j 0 and - * msk[i] = 0.0 if id[i] < 0 - * - * N_VMin - * Returns the smallest element of x: - * min (i=0 to N-1) x[i] - * - * N_VWL2Norm - * Returns the weighted Euclidean L2 norm of x with weight - * vector w: - * sqrt [(sum (i=0 to N-1) {(x[i] * w[i])^2}) ] - * - * N_VL1Norm - * Returns the L1 norm of x: - * sum (i=0 to N-1) {ABS(x[i])} - * - * N_VCompare - * Performs the operation - * z[i] = 1.0 if |x[i]| >= c i = 0, 1, ..., N-1 - * 0.0 otherwise - * - * N_VInvTest - * Performs the operation z[i] = 1.0 / x[i] with a test for - * x[i]==0.0 before inverting x[i]. - * This routine returns TRUE if all components of x are non-zero - * (successful inversion) and returns FALSE otherwise. - * - * N_VConstrMask - * Performs the operation : - * m[i] = 1.0 if constraint test fails for x[i] - * m[i] = 0.0 if constraint test passes for x[i] - * where the constraint tests are as follows: - * If c[i] = 2.0, then x[i] must be > 0.0. - * If c[i] = 1.0, then x[i] must be >= 0.0. - * If c[i] = -1.0, then x[i] must be <= 0.0. - * If c[i] = -2.0, then x[i] must be < 0.0. - * This routine returns a bool FALSE if any element failed - * the constraint test, TRUE if all passed. It also sets a - * mask vector m, with elements equal to 1.0 where the - * corresponding constraint test failed, and equal to 0.0 - * where the constraint test passed. - * This routine is specialized in that it is used only for - * constraint checking. - * - * N_VMinQuotient - * Performs the operation : - * minq = min ( num[i]/denom[i]) over all i such that - * denom[i] != 0. - * This routine returns the minimum of the quotients obtained - * by term-wise dividing num[i] by denom[i]. A zero element - * in denom will be skipped. If no such quotients are found, - * then the large value 1.0e99 is returned. - * - * ----------------------------------------------------------------- - * - * The following table lists the vector functions used by - * different modules in SUNDIALS. The symbols in the table - * have the following meaning: - * S - called by the solver; - * D - called by the dense linear solver module - * B - called by the band linear solver module - * Di - called by the diagonal linear solver module - * I - called by the iterative linear solver module - * BP - called by the band preconditioner module - * BBDP - called by the band-block diagonal preconditioner module - * F - called by the Fortran-to-C interface - * - * ------------------------------------------------ - * MODULES - * NVECTOR ------------------------------------------------ - * FUNCTIONS CVODE/CVODES IDA KINSOL - * ----------------------------------------------------------------- - * N_VClone S Di I S I BBDP S I BBDP - * ----------------------------------------------------------------- - * N_VDestroy S Di I S I BBDP S I BBDP - * ----------------------------------------------------------------- - * N_VSpace S S S - * ----------------------------------------------------------------- - * N_VGetArrayPointer D B BP BBDP F D B BBDP BBDP F - * ----------------------------------------------------------------- - * N_VSetArrayPointer D F D F - * ----------------------------------------------------------------- - * N_VLinearSum S D Di I S D I S I - * ----------------------------------------------------------------- - * N_VConst S I S I I - * ----------------------------------------------------------------- - * N_VProd S Di I S I S I - * ----------------------------------------------------------------- - * N_VDiv S Di I S I S I - * ----------------------------------------------------------------- - * N_VScale S D B Di I BP BBDP S D B I BBDP S I BBDP - * ----------------------------------------------------------------- - * N_VAbs S S S - * ----------------------------------------------------------------- - * N_VInv S Di S S - * ----------------------------------------------------------------- - * N_VAddConst S Di S - * ----------------------------------------------------------------- - * N_VDotProd I I I - * ----------------------------------------------------------------- - * N_VMaxNorm S S S - * ----------------------------------------------------------------- - * N_VWrmsNorm S D B I BP BBDP S - * ----------------------------------------------------------------- - * N_VWrmsNormMask S - * ----------------------------------------------------------------- - * N_VMin S S S - * ----------------------------------------------------------------- - * N_VWL2Norm S I - * ----------------------------------------------------------------- - * N_VL1Norm - * ----------------------------------------------------------------- - * N_VCompare Di S - * ----------------------------------------------------------------- - * N_VInvTest Di - * ----------------------------------------------------------------- - * N_VConstrMask S S - * ----------------------------------------------------------------- - * N_VMinQuotient S S - * ----------------------------------------------------------------- - */ - -N_Vector N_VClone(N_Vector w); -void N_VDestroy(N_Vector v); -void N_VSpace(N_Vector v, long int *lrw, long int *liw); -realtype *N_VGetArrayPointer(N_Vector v); -void N_VSetArrayPointer(realtype *v_data, N_Vector v); -void N_VLinearSum(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); -void N_VConst(realtype c, N_Vector z); -void N_VProd(N_Vector x, N_Vector y, N_Vector z); -void N_VDiv(N_Vector x, N_Vector y, N_Vector z); -void N_VScale(realtype c, N_Vector x, N_Vector z); -void N_VAbs(N_Vector x, N_Vector z); -void N_VInv(N_Vector x, N_Vector z); -void N_VAddConst(N_Vector x, realtype b, N_Vector z); -realtype N_VDotProd(N_Vector x, N_Vector y); -realtype N_VMaxNorm(N_Vector x); -realtype N_VWrmsNorm(N_Vector x, N_Vector w); -realtype N_VWrmsNormMask(N_Vector x, N_Vector w, N_Vector id); -realtype N_VMin(N_Vector x); -realtype N_VWL2Norm(N_Vector x, N_Vector w); -realtype N_VL1Norm(N_Vector x); -void N_VCompare(realtype c, N_Vector x, N_Vector z); -booleantype N_VInvTest(N_Vector x, N_Vector z); -booleantype N_VConstrMask(N_Vector c, N_Vector x, N_Vector m); -realtype N_VMinQuotient(N_Vector num, N_Vector denom); - -/* - * ----------------------------------------------------------------- - * Additional functions exported by nvector - * ----------------------------------------------------------------- - */ - -/* - * ----------------------------------------------------------------- - * N_VCloneVectorArray - * Creates (by cloning from 'w') an array of 'count' N_Vectors - * - * N_VDestroyVectorArray - * Frees memory for an array of 'count' N_Vectors that was - * created by cloning with N_VCloneVectorArray - * - * These functions are used by the SPGMR iterative linear solver - * module and by the CVODES and IDAS solvers. - * ----------------------------------------------------------------- - */ - -N_Vector *N_VCloneVectorArray(int count, N_Vector w); -void N_VDestroyVectorArray(N_Vector *vs, int count); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/shared/nvector_serial.c b/src/sundials/shared/nvector_serial.c deleted file mode 100755 index e4661e3b15..0000000000 --- a/src/sundials/shared/nvector_serial.c +++ /dev/null @@ -1,946 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 2212 $ - * $Date: 2008-09-08 16:32:26 +0200 (Mon, 08 Sep 2008) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, - * and Aaron Collier @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for a serial implementation - * of the NVECTOR package. - * ----------------------------------------------------------------- - */ - -#include <../../../nrnconf.h> -#if HAVE_POSIX_MEMALIGN -#define HAVE_MEMALIGN 1 -#endif -#if HAVE_MEMALIGN -#undef _XOPEN_SOURCE /* avoid warnings about redefining this */ -#define _XOPEN_SOURCE 600 -#endif - -#include -#include - -#include "nvector_serial.h" -#include "sundialsmath.h" -#include "sundialstypes.h" - -#define ZERO RCONST(0.0) -#define HALF RCONST(0.5) -#define ONE RCONST(1.0) -#define ONEPT5 RCONST(1.5) - -/* Private function prototypes */ -/* z=x */ -static void VCopy_Serial(N_Vector x, N_Vector z); -/* z=x+y */ -static void VSum_Serial(N_Vector x, N_Vector y, N_Vector z); -/* z=x-y */ -static void VDiff_Serial(N_Vector x, N_Vector y, N_Vector z); -/* z=-x */ -static void VNeg_Serial(N_Vector x, N_Vector z); -/* z=c(x+y) */ -static void VScaleSum_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z); -/* z=c(x-y) */ -static void VScaleDiff_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z); -/* z=ax+y */ -static void VLin1_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z); -/* z=ax-y */ -static void VLin2_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z); -/* y <- ax+y */ -static void Vaxpy_Serial(realtype a, N_Vector x, N_Vector y); -/* x <- ax */ -static void VScaleBy_Serial(realtype a, N_Vector x); - -/* - * ----------------------------------------------------------------- - * exported functions - * ----------------------------------------------------------------- - */ - -/* ---------------------------------------------------------------------------- - * Function to create a new empty serial vector - */ - -N_Vector N_VNewEmpty_Serial(long int length) -{ - N_Vector v; - N_Vector_Ops ops; - N_VectorContent_Serial content; - - /* Create vector */ - v = (N_Vector) malloc(sizeof *v); - if (v == NULL) return(NULL); - - /* Create vector operation structure */ - ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); - if (ops == NULL) {free(v);return(NULL);} - - ops->nvclone = N_VClone_Serial; - ops->nvdestroy = N_VDestroy_Serial; - ops->nvspace = N_VSpace_Serial; - ops->nvgetarraypointer = N_VGetArrayPointer_Serial; - ops->nvsetarraypointer = N_VSetArrayPointer_Serial; - ops->nvlinearsum = N_VLinearSum_Serial; - ops->nvconst = N_VConst_Serial; - ops->nvprod = N_VProd_Serial; - ops->nvdiv = N_VDiv_Serial; - ops->nvscale = N_VScale_Serial; - ops->nvabs = N_VAbs_Serial; - ops->nvinv = N_VInv_Serial; - ops->nvaddconst = N_VAddConst_Serial; - ops->nvdotprod = N_VDotProd_Serial; - ops->nvmaxnorm = N_VMaxNorm_Serial; - ops->nvwrmsnormmask = N_VWrmsNormMask_Serial; - ops->nvwrmsnorm = N_VWrmsNorm_Serial; - ops->nvmin = N_VMin_Serial; - ops->nvwl2norm = N_VWL2Norm_Serial; - ops->nvl1norm = N_VL1Norm_Serial; - ops->nvcompare = N_VCompare_Serial; - ops->nvinvtest = N_VInvTest_Serial; - ops->nvconstrmask = N_VConstrMask_Serial; - ops->nvminquotient = N_VMinQuotient_Serial; - - /* Create content */ - content = (N_VectorContent_Serial) malloc(sizeof(struct _N_VectorContent_Serial)); - if (content == NULL) {free(ops);free(v);return(NULL);} - - content->length = length; - content->own_data = FALSE; - content->data = NULL; - - /* Attach content and ops */ - v->content = content; - v->ops = ops; - - return(v); -} - -/* ---------------------------------------------------------------------------- - * Function to create a new serial vector - */ - -N_Vector N_VNew_Serial(long int length) -{ - N_Vector v; - realtype *data; - - v = N_VNewEmpty_Serial(length); - if (v == NULL) return(NULL); - - /* Create data */ - if (length > 0) { - - /* Allocate memory */ -#if HAVE_MEMALIGN - if (posix_memalign((void**)&data, 64, length*sizeof(realtype)) != 0) { - N_VDestroy_Serial(v);return(NULL); - } -#else - data = (realtype *) malloc(length * sizeof(realtype)); -#endif - if(data == NULL) {N_VDestroy_Serial(v);return(NULL);} - - /* Attach data */ - NV_OWN_DATA_S(v) = TRUE; - NV_DATA_S(v) = data; - - } - - return(v); -} - -/* ---------------------------------------------------------------------------- - * Function to clone from a template a new vector with empty (NULL) data array - */ - -N_Vector N_VCloneEmpty_Serial(N_Vector w) -{ - N_Vector v; - N_Vector_Ops ops; - N_VectorContent_Serial content; - - if (w == NULL) return(NULL); - - /* Create vector */ - v = (N_Vector) malloc(sizeof *v); - if (v == NULL) return(NULL); - - /* Create vector operation structure */ - ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); - if (ops == NULL) {free(v);return(NULL);} - - ops->nvclone = w->ops->nvclone; - ops->nvdestroy = w->ops->nvdestroy; - ops->nvspace = w->ops->nvspace; - ops->nvgetarraypointer = w->ops->nvgetarraypointer; - ops->nvsetarraypointer = w->ops->nvsetarraypointer; - ops->nvlinearsum = w->ops->nvlinearsum; - ops->nvconst = w->ops->nvconst; - ops->nvprod = w->ops->nvprod; - ops->nvdiv = w->ops->nvdiv; - ops->nvscale = w->ops->nvscale; - ops->nvabs = w->ops->nvabs; - ops->nvinv = w->ops->nvinv; - ops->nvaddconst = w->ops->nvaddconst; - ops->nvdotprod = w->ops->nvdotprod; - ops->nvmaxnorm = w->ops->nvmaxnorm; - ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; - ops->nvwrmsnorm = w->ops->nvwrmsnorm; - ops->nvmin = w->ops->nvmin; - ops->nvwl2norm = w->ops->nvwl2norm; - ops->nvl1norm = w->ops->nvl1norm; - ops->nvcompare = w->ops->nvcompare; - ops->nvinvtest = w->ops->nvinvtest; - ops->nvconstrmask = w->ops->nvconstrmask; - ops->nvminquotient = w->ops->nvminquotient; - - /* Create content */ - content = (N_VectorContent_Serial) malloc(sizeof(struct _N_VectorContent_Serial)); - if (content == NULL) {free(ops);free(v);return(NULL);} - - content->length = NV_LENGTH_S(w); - content->own_data = FALSE; - content->data = NULL; - - /* Attach content and ops */ - v->content = content; - v->ops = ops; - - return(v); -} - -/* ---------------------------------------------------------------------------- - * Function to create a serial N_Vector with user data component - */ - -N_Vector N_VMake_Serial(long int length, realtype *v_data) -{ - N_Vector v; - - v = N_VNewEmpty_Serial(length); - if (v == NULL) return(NULL); - - if (length > 0) { - /* Attach data */ - NV_OWN_DATA_S(v) = FALSE; - NV_DATA_S(v) = v_data; - } - - return(v); -} - -/* ---------------------------------------------------------------------------- - * Function to create an array of new serial vectors. - */ - -N_Vector *N_VNewVectorArray_Serial(int count, long int length) -{ - N_Vector *vs; - int j; - - if (count <= 0) return(NULL); - - vs = (N_Vector *) malloc(count * sizeof(N_Vector)); - if(vs == NULL) return(NULL); - - for (j=0; j 0) { - - /* Allocate memory */ -#if HAVE_MEMALIGN - if (posix_memalign((void**)&data, 64, length*sizeof(realtype)) != 0) { - N_VDestroy_Serial(v);return(NULL); - } -#else - data = (realtype *) malloc(length * sizeof(realtype)); -#endif - if(data == NULL) {N_VDestroy_Serial(v);return(NULL);} - - /* Attach data */ - NV_OWN_DATA_S(v) = TRUE; - NV_DATA_S(v) = data; - - } - - return(v); -} - -void N_VDestroy_Serial(N_Vector v) -{ - if (NV_OWN_DATA_S(v) == TRUE) - free(NV_DATA_S(v)); - free(v->content); - free(v->ops); - free(v); -} - -void N_VSpace_Serial(N_Vector v, long int *lrw, long int *liw) -{ - *lrw = NV_LENGTH_S(v); - *liw = 1; -} - -realtype *N_VGetArrayPointer_Serial(N_Vector v) -{ - realtype *v_data; - - v_data = NV_DATA_S(v); - - return(v_data); -} - -void N_VSetArrayPointer_Serial(realtype *v_data, N_Vector v) -{ - if (NV_LENGTH_S(v) > 0) NV_DATA_S(v) = v_data; -} - -void N_VLinearSum_Serial(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) -{ - long int i, N; - realtype c, *xd, *yd, *zd; - N_Vector v1, v2; - booleantype test; - - if ((b == ONE) && (z == y)) { /* BLAS usage: axpy y <- ax+y */ - Vaxpy_Serial(a,x,y); - return; - } - - if ((a == ONE) && (z == x)) { /* BLAS usage: axpy x <- by+x */ - Vaxpy_Serial(b,y,x); - return; - } - - /* Case: a == b == 1.0 */ - - if ((a == ONE) && (b == ONE)) { - VSum_Serial(x, y, z); - return; - } - - /* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */ - - if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE))) { - v1 = test ? y : x; - v2 = test ? x : y; - VDiff_Serial(v2, v1, z); - return; - } - - /* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */ - /* if a or b is 0.0, then user should have called N_VScale */ - - if ((test = (a == ONE)) || (b == ONE)) { - c = test ? b : a; - v1 = test ? y : x; - v2 = test ? x : y; - VLin1_Serial(c, v1, v2, z); - return; - } - - /* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */ - - if ((test = (a == -ONE)) || (b == -ONE)) { - c = test ? b : a; - v1 = test ? y : x; - v2 = test ? x : y; - VLin2_Serial(c, v1, v2, z); - return; - } - - /* Case: a == b */ - /* catches case both a and b are 0.0 - user should have called N_VConst */ - - if (a == b) { - VScaleSum_Serial(a, x, y, z); - return; - } - - /* Case: a == -b */ - - if (a == -b) { - VScaleDiff_Serial(a, x, y, z); - return; - } - - /* Do all cases not handled above: - (1) a == other, b == 0.0 - user should have called N_VScale - (2) a == 0.0, b == other - user should have called N_VScale - (3) a,b == other, a !=b, a != -b */ - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - yd = NV_DATA_S(y); - zd = NV_DATA_S(z); - - for (i=0; i < N; i++) - *zd++ = a * (*xd++) + b * (*yd++); -} - -void N_VConst_Serial(realtype c, N_Vector z) -{ - long int i, N; - realtype *zd; - - N = NV_LENGTH_S(z); - zd = NV_DATA_S(z); - - for (i=0; i < N; i++) - *zd++ = c; -} - -void N_VProd_Serial(N_Vector x, N_Vector y, N_Vector z) -{ - long int i, N; - realtype *xd, *yd, *zd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - yd = NV_DATA_S(y); - zd = NV_DATA_S(z); - - for (i=0; i < N; i++) - *zd++ = (*xd++) * (*yd++); -} - -void N_VDiv_Serial(N_Vector x, N_Vector y, N_Vector z) -{ - long int i, N; - realtype *xd, *yd, *zd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - yd = NV_DATA_S(y); - zd = NV_DATA_S(z); - - for (i=0; i < N; i++) - *zd++ = (*xd++) / (*yd++); -} - -void N_VScale_Serial(realtype c, N_Vector x, N_Vector z) -{ - long int i, N; - realtype *xd, *zd; - - if (z == x) { /* BLAS usage: scale x <- cx */ - VScaleBy_Serial(c, x); - return; - } - - if (c == ONE) { - VCopy_Serial(x, z); - } else if (c == -ONE) { - VNeg_Serial(x, z); - } else { - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - zd = NV_DATA_S(z); - for (i=0; i < N; i++) - *zd++ = c * (*xd++); - } -} - -void N_VAbs_Serial(N_Vector x, N_Vector z) -{ - long int i, N; - realtype *xd, *zd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - zd = NV_DATA_S(z); - - for (i=0; i < N; i++, xd++, zd++) - *zd = ABS(*xd); -} - -void N_VInv_Serial(N_Vector x, N_Vector z) -{ - long int i, N; - realtype *xd, *zd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - zd = NV_DATA_S(z); - - for (i=0; i < N; i++) - *zd++ = ONE / (*xd++); -} - -void N_VAddConst_Serial(N_Vector x, realtype b, N_Vector z) -{ - long int i, N; - realtype *xd, *zd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - zd = NV_DATA_S(z); - - for (i=0; i < N; i++) - *zd++ = (*xd++) + b; -} - -realtype N_VDotProd_Serial(N_Vector x, N_Vector y) -{ - long int i, N; - realtype sum = ZERO, *xd, *yd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - yd = NV_DATA_S(y); - - for (i=0; i < N; i++) - sum += (*xd++) * (*yd++); - - return(sum); -} - -realtype N_VMaxNorm_Serial(N_Vector x) -{ - long int i, N; - realtype max = ZERO, *xd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - - for (i=0; i < N; i++, xd++) { - if (ABS(*xd) > max) max = ABS(*xd); - } - - return(max); -} - -realtype N_VWrmsNorm_Serial(N_Vector x, N_Vector w) -{ - long int i, N; - realtype sum = ZERO, prodi, *xd, *wd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - wd = NV_DATA_S(w); - - for (i=0; i < N; i++) { - prodi = (*xd++) * (*wd++); - sum += prodi * prodi; - } - - return(RSqrt(sum / N)); -} - -realtype N_VWrmsNormMask_Serial(N_Vector x, N_Vector w, N_Vector id) -{ - long int i, N; - realtype sum = ZERO, prodi, *xd, *wd, *idd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - wd = NV_DATA_S(w); - idd = NV_DATA_S(id); - - for (i=0; i < N; i++) { - if (idd[i] > ZERO) { - prodi = xd[i] * wd[i]; - sum += prodi * prodi; - } - } - - return(RSqrt(sum / N)); -} - -realtype N_VMin_Serial(N_Vector x) -{ - long int i, N; - realtype min, *xd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - - min = xd[0]; - - xd++; - for (i=1; i < N; i++, xd++) { - if ((*xd) < min) min = *xd; - } - - return(min); -} - -realtype N_VWL2Norm_Serial(N_Vector x, N_Vector w) -{ - long int i, N; - realtype sum = ZERO, prodi, *xd, *wd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - wd = NV_DATA_S(w); - - for (i=0; i < N; i++) { - prodi = (*xd++) * (*wd++); - sum += prodi * prodi; - } - - return(RSqrt(sum)); -} - -realtype N_VL1Norm_Serial(N_Vector x) -{ - long int i, N; - realtype sum = ZERO, *xd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - - for (i=0; i= c) ? ONE : ZERO; - } -} - -booleantype N_VInvTest_Serial(N_Vector x, N_Vector z) -{ - long int i, N; - realtype *xd, *zd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - zd = NV_DATA_S(z); - - for (i=0; i < N; i++) { - if (*xd == ZERO) return(FALSE); - *zd++ = ONE / (*xd++); - } - - return(TRUE); -} - -booleantype N_VConstrMask_Serial(N_Vector c, N_Vector x, N_Vector m) -{ - long int i, N; - booleantype test; - realtype *cd, *xd, *md; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - cd = NV_DATA_S(c); - md = NV_DATA_S(m); - - test = TRUE; - - for (i=0; i ONEPT5 || (*cd) < -ONEPT5) { - if ( (*xd)*(*cd) <= ZERO) {test = FALSE; *md = ONE; } - continue; - } - if ( (*cd) > HALF || (*cd) < -HALF) { - if ( (*xd)*(*cd) < ZERO ) {test = FALSE; *md = ONE; } - } - } - return(test); -} - -realtype N_VMinQuotient_Serial(N_Vector num, N_Vector denom) -{ - booleantype notEvenOnce; - long int i, N; - realtype *nd, *dd, min=0.0; - - N = NV_LENGTH_S(num); - nd = NV_DATA_S(num); - dd = NV_DATA_S(denom); - - notEvenOnce = TRUE; - - for (i = 0; i < N; i++, nd++, dd++) { - if (*dd == ZERO) continue; - else { - if (notEvenOnce) { - min = *nd / *dd ; - notEvenOnce = FALSE; - } - else min = MIN(min, (*nd) / (*dd)); - } - } - - if (notEvenOnce || (N == 0)) min = BIG_REAL; - - return(min); -} - -/* - * ----------------------------------------------------------------- - * private functions - * ----------------------------------------------------------------- - */ - -static void VCopy_Serial(N_Vector x, N_Vector z) -{ - long int i, N; - realtype *xd, *zd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - zd = NV_DATA_S(z); - - for (i=0; i < N; i++) - *zd++ = *xd++; -} - -static void VSum_Serial(N_Vector x, N_Vector y, N_Vector z) -{ - long int i, N; - realtype *xd, *yd, *zd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - yd = NV_DATA_S(y); - zd = NV_DATA_S(z); - - for (i=0; i < N; i++) - *zd++ = (*xd++) + (*yd++); -} - -static void VDiff_Serial(N_Vector x, N_Vector y, N_Vector z) -{ - long int i, N; - realtype *xd, *yd, *zd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - yd = NV_DATA_S(y); - zd = NV_DATA_S(z); - - for (i=0; i < N; i++) - *zd++ = (*xd++) - (*yd++); -} - -static void VNeg_Serial(N_Vector x, N_Vector z) -{ - long int i, N; - realtype *xd, *zd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - zd = NV_DATA_S(z); - - for (i=0; i < N; i++) - *zd++ = -(*xd++); -} - -static void VScaleSum_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z) -{ - long int i, N; - realtype *xd, *yd, *zd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - yd = NV_DATA_S(y); - zd = NV_DATA_S(z); - - for (i=0; i < N; i++) - *zd++ = c * ((*xd++) + (*yd++)); -} - -static void VScaleDiff_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z) -{ - long int i, N; - realtype *xd, *yd, *zd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - yd = NV_DATA_S(y); - zd = NV_DATA_S(z); - - for (i=0; i < N; i++) - *zd++ = c * ((*xd++) - (*yd++)); -} - -static void VLin1_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z) -{ - long int i, N; - realtype *xd, *yd, *zd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - yd = NV_DATA_S(y); - zd = NV_DATA_S(z); - - for (i=0; i < N; i++) - *zd++ = a * (*xd++) + (*yd++); -} - -static void VLin2_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z) -{ - long int i, N; - realtype *xd, *yd, *zd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - yd = NV_DATA_S(y); - zd = NV_DATA_S(z); - - for (i=0; i < N; i++) - *zd++ = a * (*xd++) - (*yd++); -} - -static void Vaxpy_Serial(realtype a, N_Vector x, N_Vector y) -{ - long int i, N; - realtype *xd, *yd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - yd = NV_DATA_S(y); - - if (a == ONE) { - for (i=0; i < N; i++) - *yd++ += (*xd++); - return; - } - - if (a == -ONE) { - for (i=0; i < N; i++) - *yd++ -= (*xd++); - return; - } - - for (i=0; i < N; i++) - *yd++ += a * (*xd++); -} - -static void VScaleBy_Serial(realtype a, N_Vector x) -{ - long int i, N; - realtype *xd; - - N = NV_LENGTH_S(x); - xd = NV_DATA_S(x); - - for (i=0; i < N; i++) - *xd++ *= a; -} diff --git a/src/sundials/shared/nvector_serial.h b/src/sundials/shared/nvector_serial.h deleted file mode 100755 index 5e0a874a59..0000000000 --- a/src/sundials/shared/nvector_serial.h +++ /dev/null @@ -1,277 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, - * and Aaron Collier @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This is the header file for the serial implementation of the - * NVECTOR module. - * - * Part I contains declarations specific to the serial - * implementation of the supplied NVECTOR module. - * - * Part II defines accessor macros that allow the user to - * efficiently use the type N_Vector without making explicit - * references to the underlying data structure. - * - * Part III contains the prototype for the constructor N_VNew_Serial - * as well as implementation-specific prototypes for various useful - * vector operations. - * - * Notes: - * - * - The definition of the generic N_Vector structure can be found - * in the header file shared/include/nvector.h. - * - * - The definition of the type realtype can be found in the - * header file shared/include/sundialstypes.h, and it may be - * changed (at the configuration stage) according to the user's - * needs. The sundialstypes.h file also contains the definition - * for the type booleantype. - * - * - N_Vector arguments to arithmetic vector operations need not - * be distinct. For example, the following call: - * - * N_VLinearSum_Serial(a,x,b,y,y); - * - * (which stores the result of the operation a*x+b*y in y) - * is legal. - * ----------------------------------------------------------------- - */ - -#ifndef _NVECTOR_SERIAL_H -#define _NVECTOR_SERIAL_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include "nvector.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * PART I: SERIAL implementation of N_Vector - * ----------------------------------------------------------------- - */ - -/* serial implementation of the N_Vector 'content' structure - contains the length of the vector, a pointer to an array - of realtype components, and a flag indicating ownership of - the data */ - -struct _N_VectorContent_Serial { - long int length; - booleantype own_data; - realtype *data; -}; - -typedef struct _N_VectorContent_Serial *N_VectorContent_Serial; - -/* - * ----------------------------------------------------------------- - * PART II: macros NV_CONTENT_S, NV_DATA_S, NV_OWN_DATA_S, - * NV_LENGTH_S, and NV_Ith_S - * ----------------------------------------------------------------- - * In the descriptions below, the following user declarations - * are assumed: - * - * N_Vector v; - * long int i; - * - * (1) NV_CONTENT_S - * - * This routines gives access to the contents of the serial - * vector N_Vector. - * - * The assignment v_cont = NV_CONTENT_S(v) sets v_cont to be - * a pointer to the serial N_Vector content structure. - * - * (2) NV_DATA_S NV_OWN_DATA_S and NV_LENGTH_S - * - * These routines give access to the individual parts of - * the content structure of a serial N_Vector. - * - * The assignment v_data = NV_DATA_S(v) sets v_data to be - * a pointer to the first component of v. The assignment - * NV_DATA_S(v) = data_V sets the component array of v to - * be data_v by storing the pointer data_v. - * - * The assignment v_len = NV_LENGTH_S(v) sets v_len to be - * the length of v. The call NV_LENGTH_S(v) = len_v sets - * the length of v to be len_v. - * - * (3) NV_Ith_S - * - * In the following description, the components of an - * N_Vector are numbered 0..n-1, where n is the length of v. - * - * The assignment r = NV_Ith_S(v,i) sets r to be the value of - * the ith component of v. The assignment NV_Ith_S(v,i) = r - * sets the value of the ith component of v to be r. - * - * Note: When looping over the components of an N_Vector v, it is - * more efficient to first obtain the component array via - * v_data = NV_DATA_S(v) and then access v_data[i] within the - * loop than it is to use NV_Ith_S(v,i) within the loop. - * ----------------------------------------------------------------- - */ - -#define NV_CONTENT_S(v) ( (N_VectorContent_Serial)(v->content) ) - -#define NV_LENGTH_S(v) ( NV_CONTENT_S(v)->length ) - -#define NV_OWN_DATA_S(v) ( NV_CONTENT_S(v)->own_data ) - -#define NV_DATA_S(v) ( NV_CONTENT_S(v)->data ) - -#define NV_Ith_S(v,i) ( NV_DATA_S(v)[i] ) - -/* - * ----------------------------------------------------------------- - * PART III: functions exported by nvector_serial - * - * CONSTRUCTORS: - * N_VNew_Serial - * N_VNewEmpty_Serial - * N_VClone_Serial - * N_VCloneEmpty_Serial - * N_VMake_Serial - * N_VNewVectorArray_Serial - * N_VNewVectorArrayEmpty_Serial - * DESTRUCTORS: - * N_VDestroy_Serial - * N_VDestroyVectorArray_Serial - * ----------------------------------------------------------------- - */ - -/* - * ----------------------------------------------------------------- - * Function : N_VNew_Serial - * ----------------------------------------------------------------- - * This function creates and allocates memory for a serial vector. - * ----------------------------------------------------------------- - */ - -N_Vector N_VNew_Serial(long int vec_length); - -/* - * ----------------------------------------------------------------- - * Function : N_VNewEmpty_Serial - * ----------------------------------------------------------------- - * This function creates a new serial N_Vector with an empty (NULL) - * data array. - * ----------------------------------------------------------------- - */ - -N_Vector N_VNewEmpty_Serial(long int vec_length); - -/* - * ----------------------------------------------------------------- - * Function : N_VCloneEmpty_Serial - * ----------------------------------------------------------------- - * This function creates a new serial N_Vector with an empty (NULL) - * data array. - * ----------------------------------------------------------------- - */ - -N_Vector N_VCloneEmpty_Serial(N_Vector w); - -/* - * ----------------------------------------------------------------- - * Function : N_VMake_Serial - * ----------------------------------------------------------------- - * This function creates and allocates memory for a serial vector - * with a user-supplied data array. - * ----------------------------------------------------------------- - */ - -N_Vector N_VMake_Serial(long int vec_length, realtype *v_data); - -/* - * ----------------------------------------------------------------- - * Function : N_VNewVectorArray_Serial - * ----------------------------------------------------------------- - * This function creates an array of 'count' serial vectors. This - * array of N_Vectors can be freed using N_VDestroyVectorArray - * (defined by the generic NVECTOR module). - * ----------------------------------------------------------------- - */ - -N_Vector *N_VNewVectorArray_Serial(int count, long int vec_length); - -/* - * ----------------------------------------------------------------- - * Function : N_VNewVectorArrayEmpty_Serial - * ----------------------------------------------------------------- - * This function creates an array of 'count' serial vectors each - * with an empty (NULL) data array. - * ----------------------------------------------------------------- - */ - -N_Vector *N_VNewVectorArrayEmpty_Serial(int count, long int vec_length); - -/* - * ----------------------------------------------------------------- - * Function : N_VDestroyVectorArray_Serial - * ----------------------------------------------------------------- - * This function frees an array of N_Vector created with - * N_VNewVectorArray_Serial. - * ----------------------------------------------------------------- - */ - -void N_VDestroyVectorArray_Serial(N_Vector *vs, int count); - -/* - * ----------------------------------------------------------------- - * Function : N_VPrint_Serial - * ----------------------------------------------------------------- - * This function prints the content of a serial vector to stdout. - * ----------------------------------------------------------------- - */ - -void N_VPrint_Serial(N_Vector v); - -/* - * ----------------------------------------------------------------- - * serial implementations of various useful vector operations - * ----------------------------------------------------------------- - */ - -N_Vector N_VClone_Serial(N_Vector w); -void N_VDestroy_Serial(N_Vector v); -void N_VSpace_Serial(N_Vector v, long int *lrw, long int *liw); -realtype *N_VGetArrayPointer_Serial(N_Vector v); -void N_VSetArrayPointer_Serial(realtype *v_data, N_Vector v); -void N_VLinearSum_Serial(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); -void N_VConst_Serial(realtype c, N_Vector z); -void N_VProd_Serial(N_Vector x, N_Vector y, N_Vector z); -void N_VDiv_Serial(N_Vector x, N_Vector y, N_Vector z); -void N_VScale_Serial(realtype c, N_Vector x, N_Vector z); -void N_VAbs_Serial(N_Vector x, N_Vector z); -void N_VInv_Serial(N_Vector x, N_Vector z); -void N_VAddConst_Serial(N_Vector x, realtype b, N_Vector z); -realtype N_VDotProd_Serial(N_Vector x, N_Vector y); -realtype N_VMaxNorm_Serial(N_Vector x); -realtype N_VWrmsNorm_Serial(N_Vector x, N_Vector w); -realtype N_VWrmsNormMask_Serial(N_Vector x, N_Vector w, N_Vector id); -realtype N_VMin_Serial(N_Vector x); -realtype N_VWL2Norm_Serial(N_Vector x, N_Vector w); -realtype N_VL1Norm_Serial(N_Vector x); -void N_VCompare_Serial(realtype c, N_Vector x, N_Vector z); -booleantype N_VInvTest_Serial(N_Vector x, N_Vector z); -booleantype N_VConstrMask_Serial(N_Vector c, N_Vector x, N_Vector m); -realtype N_VMinQuotient_Serial(N_Vector num, N_Vector denom); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/shared/smalldense.c b/src/sundials/shared/smalldense.c deleted file mode 100755 index 407945aa4e..0000000000 --- a/src/sundials/shared/smalldense.c +++ /dev/null @@ -1,242 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen and Alan C. Hindmarsh @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for a generic DENSE linear - * solver package, intended for small dense matrices. - * ----------------------------------------------------------------- - */ - -#include -#include - -#include "smalldense.h" -#include "sundialsmath.h" -#include "sundialstypes.h" - -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) - -/* Implementation */ - -realtype **denalloc(long int n) -{ - long int j; - realtype **a; - - if (n <= 0) return(NULL); - - a = (realtype **) malloc(n * sizeof(realtype *)); - if (a == NULL) return(NULL); - - a[0] = (realtype *) malloc(n * n * sizeof(realtype)); - if (a[0] == NULL) { - free(a); - return(NULL); - } - - for (j=1; j < n; j++) a[j] = a[0] + j * n; - - return(a); -} - -long int *denallocpiv(long int n) -{ - if (n <= 0) return(NULL); - - return((long int *) malloc(n * sizeof(long int))); -} - -long int gefa(realtype **a, long int n, long int *p) -{ - long int i, j, k, l; - realtype *col_j, *col_k, *diag_k; - realtype temp, mult, a_kj; - booleantype swap; - - /* k = elimination step number */ - - for (k=0; k < n-1; k++, p++) { - - col_k = a[k]; - diag_k = col_k + k; - - /* find l = pivot row number */ - - l=k; - for (i=k+1; i < n; i++) - if (ABS(col_k[i]) > ABS(col_k[l])) l=i; - *p = l; - - /* check for zero pivot element */ - - if (col_k[l] == ZERO) return(k+1); - - /* swap a(l,k) and a(k,k) if necessary */ - - if ( (swap = (l != k) )) { - temp = col_k[l]; - col_k[l] = *diag_k; - *diag_k = temp; - } - - /* Scale the elements below the diagonal in */ - /* column k by -1.0 / a(k,k). After the above swap, */ - /* a(k,k) holds the pivot element. This scaling */ - /* stores the pivot row multipliers -a(i,k)/a(k,k) */ - /* in a(i,k), i=k+1, ..., n-1. */ - - mult = -ONE / (*diag_k); - for(i=k+1; i < n; i++) - col_k[i] *= mult; - - /* row_i = row_i - [a(i,k)/a(k,k)] row_k, i=k+1, ..., n-1 */ - /* row k is the pivot row after swapping with row l. */ - /* The computation is done one column at a time, */ - /* column j=k+1, ..., n-1. */ - - for (j=k+1; j < n; j++) { - - col_j = a[j]; - a_kj = col_j[l]; - - /* Swap the elements a(k,j) and a(k,l) if l!=k. */ - - if (swap) { - col_j[l] = col_j[k]; - col_j[k] = a_kj; - } - - /* a(i,j) = a(i,j) - [a(i,k)/a(k,k)]*a(k,j) */ - /* a_kj = a(k,j), col_k[i] = - a(i,k)/a(k,k) */ - - if (a_kj != ZERO) { - for (i=k+1; i < n; i++) - col_j[i] += a_kj * col_k[i]; - } - } - } - - /* set the last pivot row to be n-1 and check for a zero pivot */ - - *p = n-1; - if (a[n-1][n-1] == ZERO) return(n); - - /* return 0 to indicate success */ - - return(0); -} - -void gesl(realtype **a, long int n, long int *p, realtype *b) -{ - long int k, l, i; - realtype mult, *col_k; - - /* Solve Ly = Pb, store solution y in b */ - - for (k=0; k < n-1; k++) { - l = p[k]; - mult = b[l]; - if (l != k) { - b[l] = b[k]; - b[k] = mult; - } - col_k = a[k]; - for (i=k+1; i < n; i++) - b[i] += mult*col_k[i]; - } - - /* Solve Ux = y, store solution x in b */ - - for (k=n-1; k >= 0; k--) { - col_k = a[k]; - b[k] /= col_k[k]; - mult = -b[k]; - for (i=0; i < k; i++) - b[i] += mult*col_k[i]; - } -} - -void denzero(realtype **a, long int n) -{ - long int i, j; - realtype *col_j; - - for (j=0; j < n; j++) { - col_j = a[j]; - for (i=0; i < n; i++) - col_j[i] = ZERO; - } -} - -void dencopy(realtype **a, realtype **b, long int n) -{ - long int i, j; - realtype *a_col_j, *b_col_j; - - for (j=0; j < n; j++) { - a_col_j = a[j]; - b_col_j = b[j]; - for (i=0; i < n; i++) - b_col_j[i] = a_col_j[i]; - } - -} - -void denscale(realtype c, realtype **a, long int n) -{ - long int i, j; - realtype *col_j; - - for (j=0; j < n; j++) { - col_j = a[j]; - for (i=0; i < n; i++) - col_j[i] *= c; - } -} - -void denaddI(realtype **a, long int n) -{ - long int i; - - for (i=0; i < n; i++) a[i][i] += ONE; -} - -void denfreepiv(long int *p) -{ - free(p); -} - -void denfree(realtype **a) -{ - free(a[0]); - free(a); -} - -void denprint(realtype **a, long int n) -{ - long int i, j; - - printf("\n"); - for (i=0; i < n; i++) { - for (j=0; j < n; j++) { -#if defined(SUNDIALS_EXTENDED_PRECISION) - printf("%10Lg", a[j][i]); -#elif defined(SUNDIALS_DOUBLE_PRECISION) - printf("%10lg", a[j][i]); -#else - printf("%10g", a[j][i]); -#endif - } - printf("\n"); - } - printf("\n"); -} diff --git a/src/sundials/shared/smalldense.h b/src/sundials/shared/smalldense.h deleted file mode 100755 index defca98267..0000000000 --- a/src/sundials/shared/smalldense.h +++ /dev/null @@ -1,221 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen and Alan C. Hindmarsh @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This is the header file for a generic DENSE linear solver - * package, intended for small dense matrices. These routines - * use the type realtype** for dense matrix arguments. - * - * These routines begin with "den" (except for the factor and - * solve routines which are called gefa and gesl, respectively). - * The underlying matrix storage is described in the - * documentation for denalloc. - * ----------------------------------------------------------------- - */ - -#ifndef _SMALLDENSE_H -#define _SMALLDENSE_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Function : denalloc - * ----------------------------------------------------------------- - * Usage : realtype **a; - * a = denalloc(n); - * if (a == NULL) ... memory request failed - * ----------------------------------------------------------------- - * denalloc(n) allocates storage for an n by n dense matrix. It - * returns a pointer to the newly allocated storage if - * successful. If the memory request cannot be satisfied, then - * denalloc returns NULL. The underlying type of the dense matrix - * returned is realtype **. If we allocate a dense matrix - * realtype **a by a = denalloc(n), then a[j][i] references the - * (i,j)th element of the matrix a, 0 <= i,j <= n-1, and a[j] is - * a pointer to the first element in the jth column of a. - * The location a[0] contains a pointer to n^2 contiguous - * locations which contain the elements of a. - * ----------------------------------------------------------------- - */ - -realtype **denalloc(long int n); - -/* - * ----------------------------------------------------------------- - * Function : denallocpiv - * ----------------------------------------------------------------- - * Usage : long int *pivot; - * pivot = denallocpiv(n); - * if (pivot == NULL) ... memory request failed - * ----------------------------------------------------------------- - * denallocpiv(n) allocates an array of n long int. It returns - * a pointer to the first element in the array if successful. - * It returns NULL if the memory request could not be satisfied. - * ----------------------------------------------------------------- - */ - -long int *denallocpiv(long int n); - -/* - * ----------------------------------------------------------------- - * Function : gefa - * ----------------------------------------------------------------- - * Usage : long int ier; - * ier = gefa(a,n,p); - * if (ier > 0) ... zero element encountered during - * the factorization - * ----------------------------------------------------------------- - * gefa(a,n,p) factors the n by n dense matrix a. It overwrites - * the elements of a with its LU factors and keeps track of the - * pivot rows chosen in the pivot array p. - * - * A successful LU factorization leaves the matrix a and the - * pivot array p with the following information: - * - * (1) p[k] contains the row number of the pivot element chosen - * at the beginning of elimination step k, k=0, 1, ..., n-1. - * - * (2) If the unique LU factorization of a is given by Pa = LU, - * where P is a permutation matrix, L is a lower triangular - * matrix with all 1's on the diagonal, and U is an upper - * triangular matrix, then the upper triangular part of a - * (including its diagonal) contains U and the strictly lower - * triangular part of a contains the multipliers, I-L. - * - * gefa returns 0 if successful. Otherwise it encountered a zero - * diagonal element during the factorization. In this case it - * returns the column index (numbered from one) at which it - * encountered the zero. - * ----------------------------------------------------------------- - */ - -long int gefa(realtype **a, long int n, long int *p); - -/* - * ----------------------------------------------------------------- - * Function : gesl - * ----------------------------------------------------------------- - * Usage : realtype *b; - * ier = gefa(a,n,p); - * if (ier == 0) gesl(a,n,p,b); - * ----------------------------------------------------------------- - * gesl(a,n,p,b) solves the n by n linear system ax = b. It - * assumes that a has been LU factored and the pivot array p has - * been set by a successful call to gefa(a,n,p). The solution x - * is written into the b array. - * ----------------------------------------------------------------- - */ - -void gesl(realtype **a, long int n, long int *p, realtype *b); - -/* - * ----------------------------------------------------------------- - * Function : denzero - * ----------------------------------------------------------------- - * Usage : denzero(a,n); - * ----------------------------------------------------------------- - * denzero(a,n) sets all the elements of the n by n dense matrix - * a to be 0.0. - * ----------------------------------------------------------------- - */ - -void denzero(realtype **a, long int n); - -/* - * ----------------------------------------------------------------- - * Function : dencopy - * ----------------------------------------------------------------- - * Usage : dencopy(a,b,n); - * ----------------------------------------------------------------- - * dencopy(a,b,n) copies the n by n dense matrix a into the - * n by n dense matrix b. - * ----------------------------------------------------------------- - */ - -void dencopy(realtype **a, realtype **b, long int n); - -/* - * ----------------------------------------------------------------- - * Function : denscale - * ----------------------------------------------------------------- - * Usage : denscale(c,a,n); - * ----------------------------------------------------------------- - * denscale(c,a,n) scales every element in the n by n dense - * matrix a by c. - * ----------------------------------------------------------------- - */ - -void denscale(realtype c, realtype **a, long int n); - -/* - * ----------------------------------------------------------------- - * Function : denaddI - * ----------------------------------------------------------------- - * Usage : denaddI(a,n); - * ----------------------------------------------------------------- - * denaddI(a,n) increments the n by n dense matrix a by the - * identity matrix. - * ----------------------------------------------------------------- - */ - -void denaddI(realtype **a, long int n); - -/* - * ----------------------------------------------------------------- - * Function : denfreepiv - * ----------------------------------------------------------------- - * Usage : denfreepiv(p); - * ----------------------------------------------------------------- - * denfreepiv(p) frees the pivot array p allocated by - * denallocpiv. - * ----------------------------------------------------------------- - */ - -void denfreepiv(long int *p); - -/* - * ----------------------------------------------------------------- - * Function : denfree - * ----------------------------------------------------------------- - * Usage : denfree(a); - * ----------------------------------------------------------------- - * denfree(a) frees the dense matrix a allocated by denalloc. - * ----------------------------------------------------------------- - */ - -void denfree(realtype **a); - -/* - * ----------------------------------------------------------------- - * Function : denprint - * ----------------------------------------------------------------- - * Usage : denprint(a,n); - * ----------------------------------------------------------------- - * denprint(a,n) prints the n by n dense matrix a to standard - * output as it would normally appear on paper. It is intended as - * a debugging tool with small values of n. The elements are - * printed using the %g/lg/Lg option. A blank line is printed - * before and after the matrix. - * ----------------------------------------------------------------- - */ - -void denprint(realtype **a, long int n); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/shared/spgmr.c b/src/sundials/shared/spgmr.c deleted file mode 100755 index 5d6ba2f760..0000000000 --- a/src/sundials/shared/spgmr.c +++ /dev/null @@ -1,441 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for the scaled preconditioned - * GMRES (SPGMR) iterative linear solver. - * ----------------------------------------------------------------- - */ - -#include -#include - -#include "iterative.h" -#include "nvector.h" -#include "spgmr.h" -#include "sundialsmath.h" -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * private constants - * ----------------------------------------------------------------- - */ - -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) - -/* - * ----------------------------------------------------------------- - * Function : SpgmrMalloc - * ----------------------------------------------------------------- - */ - -SpgmrMem SpgmrMalloc(int l_max, N_Vector vec_tmpl) -{ - SpgmrMem mem; - N_Vector *V, xcor, vtemp; - realtype **Hes, *givens, *yg; - int k, i; - - /* Check the input parameters. */ - - if (l_max <= 0) return(NULL); - - /* Get memory for the Krylov basis vectors V[0], ..., V[l_max]. */ - - V = N_VCloneVectorArray(l_max+1, vec_tmpl); - if (V == NULL) return(NULL); - - /* Get memory for the Hessenberg matrix Hes. */ - - Hes = (realtype **) malloc((l_max+1)*sizeof(realtype *)); - if (Hes == NULL) { - N_VDestroyVectorArray(V, l_max+1); - return(NULL); - } - - for (k = 0; k <= l_max; k++) { - Hes[k] = (realtype *) malloc(l_max*sizeof(realtype)); - if (Hes[k] == NULL) { - for (i = 0; i < k; i++) free(Hes[i]); - N_VDestroyVectorArray(V, l_max+1); - return(NULL); - } - } - - /* Get memory for Givens rotation components. */ - - givens = (realtype *) malloc(2*l_max*sizeof(realtype)); - if (givens == NULL) { - for (i = 0; i <= l_max; i++) free(Hes[i]); - N_VDestroyVectorArray(V, l_max+1); - return(NULL); - } - - /* Get memory to hold the correction to z_tilde. */ - - xcor = N_VClone(vec_tmpl); - if (xcor == NULL) { - free(givens); - for (i = 0; i <= l_max; i++) free(Hes[i]); - N_VDestroyVectorArray(V, l_max+1); - return(NULL); - } - - /* Get memory to hold SPGMR y and g vectors. */ - - yg = (realtype *) malloc((l_max+1)*sizeof(realtype)); - if (yg == NULL) { - N_VDestroy(xcor); - free(givens); - for (i = 0; i <= l_max; i++) free(Hes[i]); - N_VDestroyVectorArray(V, l_max+1); - return(NULL); - } - - /* Get an array to hold a temporary vector. */ - - vtemp = N_VClone(vec_tmpl); - if (vtemp == NULL) { - free(yg); - N_VDestroy(xcor); - free(givens); - for (i = 0; i <= l_max; i++) free(Hes[i]); - N_VDestroyVectorArray(V, l_max+1); - return(NULL); - } - - /* Get memory for an SpgmrMemRec containing SPGMR matrices and vectors. */ - - mem = (SpgmrMem) malloc(sizeof(SpgmrMemRec)); - if (mem == NULL) { - N_VDestroy(vtemp); - free(yg); - N_VDestroy(xcor); - free(givens); - for (i = 0; i <= l_max; i++) free(Hes[i]); - N_VDestroyVectorArray(V, l_max+1); - return(NULL); - } - - /* Set the fields of mem. */ - - mem->l_max = l_max; - mem->V = V; - mem->Hes = Hes; - mem->givens = givens; - mem->xcor = xcor; - mem->yg = yg; - mem->vtemp = vtemp; - - /* Return the pointer to SPGMR memory. */ - - return(mem); -} - -/* - * ----------------------------------------------------------------- - * Function : SpgmrSolve - * ----------------------------------------------------------------- - */ - -int SpgmrSolve(SpgmrMem mem, void *A_data, N_Vector x, N_Vector b, - int pretype, int gstype, realtype delta, int max_restarts, - void *P_data, N_Vector s1, N_Vector s2, ATimesFn atimes, - PSolveFn psolve, realtype *res_norm, int *nli, int *nps) -{ - N_Vector *V, xcor, vtemp; - realtype **Hes, *givens, *yg; - realtype beta, rotation_product, r_norm, s_product, rho=0.0; - booleantype preOnLeft, preOnRight, scale2, scale1, converged; - int i, j, k, l, l_plus_1, l_max, krydim, ier, ntries; - - if (mem == NULL) return(SPGMR_MEM_NULL); - - /* Initialize some variables */ - - l_plus_1 = 0; - krydim = 0; - - /* Make local copies of mem variables. */ - - l_max = mem->l_max; - V = mem->V; - Hes = mem->Hes; - givens = mem->givens; - xcor = mem->xcor; - yg = mem->yg; - vtemp = mem->vtemp; - - *nli = *nps = 0; /* Initialize counters */ - converged = FALSE; /* Initialize converged flag */ - - if (max_restarts < 0) max_restarts = 0; - - if ((pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) - pretype = PREC_NONE; - - preOnLeft = ((pretype == PREC_LEFT) || (pretype == PREC_BOTH)); - preOnRight = ((pretype == PREC_RIGHT) || (pretype == PREC_BOTH)); - scale1 = (s1 != NULL); - scale2 = (s2 != NULL); - - /* Set vtemp and V[0] to initial (unscaled) residual r_0 = b - A*x_0. */ - - if (N_VDotProd(x, x) == ZERO) { - N_VScale(ONE, b, vtemp); - } else { - if (atimes(A_data, x, vtemp) != 0) - return(SPGMR_ATIMES_FAIL); - N_VLinearSum(ONE, b, -ONE, vtemp, vtemp); - } - N_VScale(ONE, vtemp, V[0]); - - /* Apply left preconditioner and left scaling to V[0] = r_0. */ - - if (preOnLeft) { - ier = psolve(P_data, V[0], vtemp, PREC_LEFT); - (*nps)++; - if (ier != 0) - return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); - } else { - N_VScale(ONE, V[0], vtemp); - } - - if (scale1) { - N_VProd(s1, vtemp, V[0]); - } else { - N_VScale(ONE, vtemp, V[0]); - } - - /* Set r_norm = beta to L2 norm of V[0] = s1 P1_inv r_0, and - return if small. */ - - *res_norm = r_norm = beta = RSqrt(N_VDotProd(V[0], V[0])); - if (r_norm <= delta) - return(SPGMR_SUCCESS); - - /* Set xcor = 0. */ - - N_VConst(ZERO, xcor); - - - /* Begin outer iterations: up to (max_restarts + 1) attempts. */ - - for (ntries = 0; ntries <= max_restarts; ntries++) { - - /* Initialize the Hessenberg matrix Hes and Givens rotation - product. Normalize the initial vector V[0]. */ - - for (i = 0; i <= l_max; i++) - for (j = 0; j < l_max; j++) - Hes[i][j] = ZERO; - - rotation_product = ONE; - - N_VScale(ONE/r_norm, V[0], V[0]); - - /* Inner loop: generate Krylov sequence and Arnoldi basis. */ - - for (l = 0; l < l_max; l++) { - - (*nli)++; - - krydim = l_plus_1 = l + 1; - - /* Generate A-tilde V[l], where A-tilde = s1 P1_inv A P2_inv s2_inv. */ - - /* Apply right scaling: vtemp = s2_inv V[l]. */ - - if (scale2) N_VDiv(V[l], s2, vtemp); - else N_VScale(ONE, V[l], vtemp); - - /* Apply right preconditioner: vtemp = P2_inv s2_inv V[l]. */ - - if (preOnRight) { - N_VScale(ONE, vtemp, V[l_plus_1]); - ier = psolve(P_data, V[l_plus_1], vtemp, PREC_RIGHT); - (*nps)++; - if (ier != 0) - return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); - } - - /* Apply A: V[l+1] = A P2_inv s2_inv V[l]. */ - - if (atimes(A_data, vtemp, V[l_plus_1] ) != 0) - return(SPGMR_ATIMES_FAIL); - - /* Apply left preconditioning: vtemp = P1_inv A P2_inv s2_inv V[l]. */ - - if (preOnLeft) { - ier = psolve(P_data, V[l_plus_1], vtemp, PREC_LEFT); - (*nps)++; - if (ier != 0) - return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); - } else { - N_VScale(ONE, V[l_plus_1], vtemp); - } - - /* Apply left scaling: V[l+1] = s1 P1_inv A P2_inv s2_inv V[l]. */ - - if (scale1) { - N_VProd(s1, vtemp, V[l_plus_1]); - } else { - N_VScale(ONE, vtemp, V[l_plus_1]); - } - - /* Orthogonalize V[l+1] against previous V[i]: V[l+1] = w_tilde. */ - - if (gstype == CLASSICAL_GS) { - if (ClassicalGS(V, Hes, l_plus_1, l_max, &(Hes[l_plus_1][l]), - vtemp, yg) != 0) - return(SPGMR_GS_FAIL); - } else { - if (ModifiedGS(V, Hes, l_plus_1, l_max, &(Hes[l_plus_1][l])) != 0) - return(SPGMR_GS_FAIL); - } - - /* Update the QR factorization of Hes. */ - - if(QRfact(krydim, Hes, givens, l) != 0 ) - return(SPGMR_QRFACT_FAIL); - - /* Update residual norm estimate; break if convergence test passes. */ - - rotation_product *= givens[2*l+1]; - *res_norm = rho = ABS(rotation_product*r_norm); - - if (rho <= delta) { converged = TRUE; break; } - - /* Normalize V[l+1] with norm value from the Gram-Schmidt routine. */ - - N_VScale(ONE/Hes[l_plus_1][l], V[l_plus_1], V[l_plus_1]); - } - - /* Inner loop is done. Compute the new correction vector xcor. */ - - /* Construct g, then solve for y. */ - - yg[0] = r_norm; - for (i = 1; i <= krydim; i++) yg[i]=ZERO; - if (QRsol(krydim, Hes, givens, yg) != 0) - return(SPGMR_QRSOL_FAIL); - - /* Add correction vector V_l y to xcor. */ - - for (k = 0; k < krydim; k++) - N_VLinearSum(yg[k], V[k], ONE, xcor, xcor); - - /* If converged, construct the final solution vector x and return. */ - - if (converged) { - - /* Apply right scaling and right precond.: vtemp = P2_inv s2_inv xcor. */ - - if (scale2) N_VDiv(xcor, s2, xcor); - if (preOnRight) { - ier = psolve(P_data, xcor, vtemp, PREC_RIGHT); - (*nps)++; - if (ier != 0) - return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); - } else { - N_VScale(ONE, xcor, vtemp); - } - - /* Add vtemp to initial x to get final solution x, and return */ - - N_VLinearSum(ONE, x, ONE, vtemp, x); - - return(SPGMR_SUCCESS); - } - - /* Not yet converged; if allowed, prepare for restart. */ - - if (ntries == max_restarts) break; - - /* Construct last column of Q in yg. */ - - s_product = ONE; - for (i = krydim; i > 0; i--) { - yg[i] = s_product*givens[2*i-2]; - s_product *= givens[2*i-1]; - } - yg[0] = s_product; - - /* Scale r_norm and yg. */ - r_norm *= s_product; - for (i = 0; i <= krydim; i++) - yg[i] *= r_norm; - r_norm = ABS(r_norm); - - /* Multiply yg by V_(krydim+1) to get last residual vector; restart. */ - N_VScale(yg[0], V[0], V[0]); - for (k = 1; k <= krydim; k++) - N_VLinearSum(yg[k], V[k], ONE, V[0], V[0]); - - } - - /* Failed to converge, even after allowed restarts. - If the residual norm was reduced below its initial value, compute - and return x anyway. Otherwise return failure flag. */ - - if (rho < beta) { - - /* Apply right scaling and right precond.: vtemp = P2_inv s2_inv xcor. */ - - if (scale2) N_VDiv(xcor, s2, xcor); - if (preOnRight) { - ier = psolve(P_data, xcor, vtemp, PREC_RIGHT); - (*nps)++; - if (ier != 0) - return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); - } else { - N_VScale(ONE, xcor, vtemp); - } - - /* Add vtemp to initial x to get final solution x, and return. */ - - N_VLinearSum(ONE, x, ONE, vtemp, x); - - return(SPGMR_RES_REDUCED); - } - - return(SPGMR_CONV_FAIL); -} - -/* - * ----------------------------------------------------------------- - * Function : SpgmrFree - * ----------------------------------------------------------------- - */ - -void SpgmrFree(SpgmrMem mem) -{ - int i, l_max; - realtype **Hes; - - if (mem == NULL) return; - - l_max = mem->l_max; - Hes = mem->Hes; - - N_VDestroyVectorArray(mem->V, l_max+1); - for (i = 0; i <= l_max; i++) free(Hes[i]); - free(Hes); - free(mem->givens); - N_VDestroy(mem->xcor); - free(mem->yg); - N_VDestroy(mem->vtemp); - - free(mem); -} diff --git a/src/sundials/shared/spgmr.h b/src/sundials/shared/spgmr.h deleted file mode 100755 index c089481287..0000000000 --- a/src/sundials/shared/spgmr.h +++ /dev/null @@ -1,295 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Radu Serban @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This is the header file for the implementation of SPGMR Krylov - * iterative linear solver. The SPGMR algorithm is based on the - * Scaled Preconditioned GMRES (Generalized Minimal Residual) - * method. - * - * The SPGMR algorithm solves a linear system A x = b. - * Preconditioning is allowed on the left, right, or both. - * Scaling is allowed on both sides, and restarts are also allowed. - * We denote the preconditioner and scaling matrices as follows: - * P1 = left preconditioner - * P2 = right preconditioner - * S1 = diagonal matrix of scale factors for P1-inverse b - * S2 = diagonal matrix of scale factors for P2 x - * The matrices A, P1, and P2 are not required explicitly; only - * routines that provide A, P1-inverse, and P2-inverse as - * operators are required. - * - * In this notation, SPGMR applies the underlying GMRES method to - * the equivalent transformed system - * Abar xbar = bbar , where - * Abar = S1 (P1-inverse) A (P2-inverse) (S2-inverse) , - * bbar = S1 (P1-inverse) b , and xbar = S2 P2 x . - * - * The scaling matrices must be chosen so that vectors S1 - * P1-inverse b and S2 P2 x have dimensionless components. - * If preconditioning is done on the left only (P2 = I), by a - * matrix P, then S2 must be a scaling for x, while S1 is a - * scaling for P-inverse b, and so may also be taken as a scaling - * for x. Similarly, if preconditioning is done on the right only - * (P1 = I, P2 = P), then S1 must be a scaling for b, while S2 is - * a scaling for P x, and may also be taken as a scaling for b. - * - * The stopping test for the SPGMR iterations is on the L2 norm of - * the scaled preconditioned residual: - * || bbar - Abar xbar ||_2 < delta - * with an input test constant delta. - * - * The usage of this SPGMR solver involves supplying two routines - * and making three calls. The user-supplied routines are - * atimes (A_data, x, y) to compute y = A x, given x, - * and - * psolve (P_data, x, y, lr) - * to solve P1 x = y or P2 x = y for x, given y. - * The three user calls are: - * mem = SpgmrMalloc(lmax, vec_tmpl); - * to initialize memory, - * flag = SpgmrSolve(mem,A_data,x,b,..., - * P_data,s1,s2,atimes,psolve,...); - * to solve the system, and - * SpgmrFree(mem); - * to free the memory created by SpgmrMalloc. - * Complete details for specifying atimes and psolve and for the - * usage calls are given in the paragraphs below and in iterative.h. - * ----------------------------------------------------------------- - */ - -#ifndef _SPGMR_H -#define _SPGMR_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include "sundialstypes.h" -#include "iterative.h" -#include "nvector.h" - -/* - * ----------------------------------------------------------------- - * Types: SpgmrMemRec, SpgmrMem - * ----------------------------------------------------------------- - * SpgmrMem is a pointer to an SpgmrMemRec which contains - * the memory needed by SpgmrSolve. The SpgmrMalloc routine - * returns a pointer of type SpgmrMem which should then be passed - * in subsequent calls to SpgmrSolve. The SpgmrFree routine frees - * the memory allocated by SpgmrMalloc. - * - * l_max is the maximum Krylov dimension that SpgmrSolve will be - * permitted to use. - * - * V is the array of Krylov basis vectors v_1, ..., v_(l_max+1), - * stored in V[0], ..., V[l_max], where l_max is the second - * parameter to SpgmrMalloc. Each v_i is a vector of type - * N_Vector. - * - * Hes is the (l_max+1) x l_max Hessenberg matrix. It is stored - * row-wise so that the (i,j)th element is given by Hes[i][j]. - * - * givens is a length 2*l_max array which represents the - * Givens rotation matrices that arise in the algorithm. The - * Givens rotation matrices F_0, F_1, ..., F_j, where F_i is - * - * 1 - * 1 - * c_i -s_i <--- row i - * s_i c_i - * 1 - * 1 - * - * are represented in the givens vector as - * givens[0]=c_0, givens[1]=s_0, givens[2]=c_1, givens[3]=s_1, - * ..., givens[2j]=c_j, givens[2j+1]=s_j. - * - * xcor is a vector (type N_Vector) which holds the scaled, - * preconditioned correction to the initial guess. - * - * yg is a length (l_max+1) array of realtype used to hold "short" - * vectors (e.g. y and g). - * - * vtemp is a vector (type N_Vector) used as temporary vector - * storage during calculations. - * ----------------------------------------------------------------- - */ - -typedef struct _SpgmrMemRec { - - int l_max; - - N_Vector *V; - realtype **Hes; - realtype *givens; - N_Vector xcor; - realtype *yg; - N_Vector vtemp; - -} SpgmrMemRec, *SpgmrMem; - -/* - * ----------------------------------------------------------------- - * Function : SpgmrMalloc - * ----------------------------------------------------------------- - * SpgmrMalloc allocates the memory used by SpgmrSolve. It - * returns a pointer of type SpgmrMem which the user of the - * SPGMR package should pass to SpgmrSolve. The parameter l_max - * is the maximum Krylov dimension that SpgmrSolve will be - * permitted to use. The parameter vec_tmpl is a pointer to an - * N_Vector used as a template to create new vectors by duplication. - * This routine returns NULL if there is a memory request failure. - * ----------------------------------------------------------------- - */ - -SpgmrMem SpgmrMalloc(int l_max, N_Vector vec_tmpl); - -/* - * ----------------------------------------------------------------- - * Function : SpgmrSolve - * ----------------------------------------------------------------- - * SpgmrSolve solves the linear system Ax = b using the SPGMR - * method. The return values are given by the symbolic constants - * below. The first SpgmrSolve parameter is a pointer to memory - * allocated by a prior call to SpgmrMalloc. - * - * mem is the pointer returned by SpgmrMalloc to the structure - * containing the memory needed by SpgmrSolve. - * - * A_data is a pointer to information about the coefficient - * matrix A. This pointer is passed to the user-supplied function - * atimes. - * - * x is the initial guess x_0 upon entry and the solution - * N_Vector upon exit with return value SPGMR_SUCCESS or - * SPGMR_RES_REDUCED. For all other return values, the output x - * is undefined. - * - * b is the right hand side N_Vector. It is undisturbed by this - * function. - * - * pretype is the type of preconditioning to be used. Its - * legal possible values are enumerated in iterativ.h. These - * values are PREC_NONE=0, PREC_LEFT=1, PREC_RIGHT=2, and - * PREC_BOTH=3. - * - * gstype is the type of Gram-Schmidt orthogonalization to be - * used. Its legal values are enumerated in iterativ.h. These - * values are MODIFIED_GS=0 and CLASSICAL_GS=1. - * - * delta is the tolerance on the L2 norm of the scaled, - * preconditioned residual. On return with value SPGMR_SUCCESS, - * this residual satisfies || s1 P1_inv (b - Ax) ||_2 <= delta. - * - * max_restarts is the maximum number of times the algorithm is - * allowed to restart. - * - * P_data is a pointer to preconditioner information. This - * pointer is passed to the user-supplied function psolve. - * - * s1 is an N_Vector of positive scale factors for P1-inv b, where - * P1 is the left preconditioner. (Not tested for positivity.) - * Pass NULL if no scaling on P1-inv b is required. - * - * s2 is an N_Vector of positive scale factors for P2 x, where - * P2 is the right preconditioner. (Not tested for positivity.) - * Pass NULL if no scaling on P2 x is required. - * - * atimes is the user-supplied function which performs the - * operation of multiplying A by a given vector. Its description - * is given in iterative.h. - * - * psolve is the user-supplied function which solves a - * preconditioner system Pz = r, where P is P1 or P2. Its full - * description is given in iterativ.h. The psolve function will - * not be called if pretype is NONE; in that case, the user - * should pass NULL for psolve. - * - * res_norm is a pointer to the L2 norm of the scaled, - * preconditioned residual. On return with value SPGMR_SUCCESS or - * SPGMR_RES_REDUCED, (*res_norm) contains the value - * || s1 P1_inv (b - Ax) ||_2 for the computed solution x. - * For all other return values, (*res_norm) is undefined. The - * caller is responsible for allocating the memory (*res_norm) - * to be filled in by SpgmrSolve. - * - * nli is a pointer to the number of linear iterations done in - * the execution of SpgmrSolve. The caller is responsible for - * allocating the memory (*nli) to be filled in by SpgmrSolve. - * - * nps is a pointer to the number of calls made to psolve during - * the execution of SpgmrSolve. The caller is responsible for - * allocating the memory (*nps) to be filled in by SpgmrSolve. - * - * Note: Repeated calls can be made to SpgmrSolve with varying - * input arguments. If, however, the problem size N or the - * maximum Krylov dimension l_max changes, then a call to - * SpgmrMalloc must be made to obtain new memory for SpgmrSolve - * to use. - * ----------------------------------------------------------------- - */ - -int SpgmrSolve(SpgmrMem mem, void *A_data, N_Vector x, N_Vector b, - int pretype, int gstype, realtype delta, - int max_restarts, void *P_data, N_Vector s1, - N_Vector s2, ATimesFn atimes, PSolveFn psolve, - realtype *res_norm, int *nli, int *nps); - - -/* Return values for SpgmrSolve */ - -#define SPGMR_SUCCESS 0 /* Converged */ -#define SPGMR_RES_REDUCED 1 /* Did not converge, but reduced - norm of residual */ -#define SPGMR_CONV_FAIL 2 /* Failed to converge */ -#define SPGMR_QRFACT_FAIL 3 /* QRfact found singular matrix */ -#define SPGMR_PSOLVE_FAIL_REC 4 /* psolve failed recoverably */ -#define SPGMR_MEM_NULL -1 /* mem argument is NULL */ -#define SPGMR_ATIMES_FAIL -2 /* atimes returned failure flag */ -#define SPGMR_PSOLVE_FAIL_UNREC -3 /* psolve failed unrecoverably */ -#define SPGMR_GS_FAIL -4 /* Gram-Schmidt routine - returned failure flag */ -#define SPGMR_QRSOL_FAIL -5 /* QRsol found singular R */ - -/* - * ----------------------------------------------------------------- - * Function : SpgmrFree - * ----------------------------------------------------------------- - * SpgmrMalloc frees the memory allocated by SpgmrMalloc. It is - * illegal to use the pointer mem after a call to SpgmrFree. - * ----------------------------------------------------------------- - */ - -void SpgmrFree(SpgmrMem mem); - -/* - * ----------------------------------------------------------------- - * Macro: SPGMR_VTEMP - * ----------------------------------------------------------------- - * This macro provides access to the work vector vtemp in the - * memory block of the SPGMR module. The argument mem is the - * memory pointer returned by SpgmrMalloc, of type SpgmrMem, - * and the macro value is of type N_Vector. - * On a return from SpgmrSolve with *nli = 0, this vector - * contains the scaled preconditioned initial residual, - * s1 * P1_inverse * (b - A x_0). - * ----------------------------------------------------------------- - */ - -#define SPGMR_VTEMP(mem) (mem->vtemp) - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/shared/sundialsmath.c b/src/sundials/shared/sundialsmath.c deleted file mode 100755 index 84fb7e555e..0000000000 --- a/src/sundials/shared/sundialsmath.c +++ /dev/null @@ -1,90 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Aaron Collier @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This is the implementation file for a simple C-language math - * library. - * ----------------------------------------------------------------- - */ - -#include -#include -#include - -#include "sundialsmath.h" -#include "sundialstypes.h" - -#define ZERO RCONST(0.0) -#define ONE RCONST(1.0) -#define TWO RCONST(2.0) - -realtype RPowerI(realtype base, int exponent) -{ - int i, expt; - realtype prod; - - prod = ONE; - expt = abs(exponent); - for(i = 1; i <= expt; i++) prod *= base; - if (exponent < 0) prod = ONE/prod; - return(prod); -} - -extern double hoc_pow(double, double); - -realtype RPowerR(realtype base, realtype exponent) -{ - if (base <= ZERO) return(ZERO); - -#if defined(SUNDIALS_USE_GENERIC_MATH) - return((realtype) hoc_pow((double) base, (double) exponent)); -#elif defined(SUNDIALS_SINGLE_PRECISION) - return(powf(base, exponent)); -#elif defined(SUNDIALS_EXTENDED_PRECISION) - return(powl(base, exponent)); -#endif -} - -realtype RSqrt(realtype x) -{ - if (x <= ZERO) return(ZERO); - -#if defined(SUNDIALS_USE_GENERIC_MATH) - return((realtype) sqrt((double) x)); -#elif defined(SUNDIALS_SINGLE_PRECISION) - return(sqrtf(x)); -#elif defined(SUNDIALS_EXTENDED_PRECISION) - return(sqrtl(x)); -#endif -} - -realtype RAbs(realtype x) -{ -#if defined(SUNDIALS_USE_GENERIC_MATH) - return((realtype) fabs((double) x)); -#elif defined(SUNDIALS_SINGLE_PRECISION) - return(fabsf(x)); -#elif defined(SUNDIALS_EXTENDED_PRECISION) - return(fabsl(x)); -#endif -} - -realtype RPower2(realtype x) -{ -#if defined(SUNDIALS_USE_GENERIC_MATH) - return((realtype) hoc_pow((double) x, 2.0)); -#elif defined(SUNDIALS_SINGLE_PRECISION) - return(powf(x, TWO)); -#elif defined(SUNDIALS_EXTENDED_PRECISION) - return(powl(x, TWO)); -#endif -} diff --git a/src/sundials/shared/sundialsmath.h b/src/sundials/shared/sundialsmath.h deleted file mode 100755 index 0c38cbaaa4..0000000000 --- a/src/sundials/shared/sundialsmath.h +++ /dev/null @@ -1,129 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and - * Aaron Collier @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - * ----------------------------------------------------------------- - * This is the header file for a simple C-language math library. The - * routines listed here work with the type realtype as defined in - * the header file shared/include/sundialstypes.h. - * ----------------------------------------------------------------- - */ - -#ifndef _SUNDIALSMATH_H -#define _SUNDIALSMATH_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#include "sundialstypes.h" - -/* - * ----------------------------------------------------------------- - * Macros : MIN and MAX - * ----------------------------------------------------------------- - * MIN(A,B) returns the minimum of A and B - * - * MAX(A,B) returns the maximum of A and B - * ----------------------------------------------------------------- - */ - -#ifndef MIN -#define MIN(A, B) ((A) < (B) ? (A) : (B)) -#endif - -#ifndef MAX -#define MAX(A, B) ((A) > (B) ? (A) : (B)) -#endif - -#ifndef ABS -#define ABS RAbs -#endif - -#ifndef SQR -#define SQR RPower2 -#endif - -/* - * ----------------------------------------------------------------- - * Function : RPowerI - * ----------------------------------------------------------------- - * Usage : int exponent; - * realtype base, ans; - * ans = RPowerI(base,exponent); - * ----------------------------------------------------------------- - * RPowerI returns the value of base^exponent, where base is of type - * realtype and exponent is of type int. - * ----------------------------------------------------------------- - */ - -realtype RPowerI(realtype base, int exponent); - -/* - * ----------------------------------------------------------------- - * Function : RPowerR - * ----------------------------------------------------------------- - * Usage : realtype base, exponent, ans; - * ans = RPowerR(base,exponent); - * ----------------------------------------------------------------- - * RPowerR returns the value of base^exponent, where both base and - * exponent are of type realtype. If base < ZERO, then RPowerR - * returns ZERO. - * ----------------------------------------------------------------- - */ - -realtype RPowerR(realtype base, realtype exponent); - -/* - * ----------------------------------------------------------------- - * Function : RSqrt - * ----------------------------------------------------------------- - * Usage : realtype sqrt_x; - * sqrt_x = RSqrt(x); - * ----------------------------------------------------------------- - * RSqrt(x) returns the square root of x. If x < ZERO, then RSqrt - * returns ZERO. - * ----------------------------------------------------------------- - */ - -realtype RSqrt(realtype x); - -/* - * ----------------------------------------------------------------- - * Function : RAbs (a.k.a. ABS) - * ----------------------------------------------------------------- - * Usage : realtype abs_x; - * abs_x = RAbs(x); - * ----------------------------------------------------------------- - * RAbs(x) returns the absolute value of x. - * ----------------------------------------------------------------- - */ - -realtype RAbs(realtype x); - -/* - * ----------------------------------------------------------------- - * Function : RPower2 (a.k.a. SQR) - * ----------------------------------------------------------------- - * Usage : realtype sqr_x; - * sqr_x = RPower2(x); - * ----------------------------------------------------------------- - * RPower2(x) returns x^2. - * ----------------------------------------------------------------- - */ - -realtype RPower2(realtype x); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/shared/sundialstypes.h b/src/sundials/shared/sundialstypes.h deleted file mode 100644 index b4a72d86dd..0000000000 --- a/src/sundials/shared/sundialstypes.h +++ /dev/null @@ -1,114 +0,0 @@ -/* - * ----------------------------------------------------------------- - * $Revision: 855 $ - * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $ - * ----------------------------------------------------------------- - * Programmer(s): Scott Cohen, Alan Hindmarsh, Radu Serban, and - * Aaron Collier @ LLNL - * ----------------------------------------------------------------- - * Copyright (c) 2002, The Regents of the University of California. - * Produced at the Lawrence Livermore National Laboratory. - * All rights reserved. - * For details, see sundials/shared/LICENSE. - *------------------------------------------------------------------ - * This header file exports two types: realtype and booleantype, - * as well as the constants TRUE and FALSE. - * - * Users should include the header file sundialstypes.h in every - * program file and use the exported name realtype instead of - * float, double or long double. - * - * The constants SUNDIALS_SINGLE_PRECISION, SUNDIALS_DOUBLE_PRECISION - * and SUNDIALS_LONG_DOUBLE_PRECISION indicate the underlying data - * type of realtype. It is set at the configuration stage. - * - * The legal types for realtype are float, double and long double. - * - * The macro RCONST gives the user a convenient way to define - * real-valued constants. To use the constant 1.0, for example, - * the user should write the following: - * - * #define ONE RCONST(1.0) - * - * If realtype is defined as a double, then RCONST(1.0) expands - * to 1.0. If realtype is defined as a float, then RCONST(1.0) - * expands to 1.0F. If realtype is defined as a long double, - * then RCONST(1.0) expands to 1.0L. There is never a need to - * explicitly cast 1.0 to (realtype). - *------------------------------------------------------------------ - */ - -#ifndef _SUNDIALSTYPES_H -#define _SUNDIALSTYPES_H - -#ifdef __cplusplus /* wrapper to enable C++ usage */ -extern "C" { -#endif - -#ifndef _SUNDIALS_CONFIG_H -#define _SUNDIALS_CONFIG_H -#include "sundials_config.h" -#endif - -#include - -#if defined(SUNDIALS_SINGLE_PRECISION) - -typedef float realtype; -#define RCONST(x) x##F -#define BIG_REAL FLT_MAX -#define SMALL_REAL FLT_MIN -#define UNIT_ROUNDOFF FLT_EPSILON - -#elif defined(SUNDIALS_DOUBLE_PRECISION) - -typedef double realtype; -#define RCONST(x) x -#define BIG_REAL DBL_MAX -#define SMALL_REAL DBL_MIN -#define UNIT_ROUNDOFF DBL_EPSILON - -#elif defined(SUNDIALS_EXTENDED_PRECISION) - -typedef long double realtype; -#define RCONST(x) x##L -#define BIG_REAL LDBL_MAX -#define SMALL_REAL LDBL_MIN -#define UNIT_ROUNDOFF LDBL_EPSILON - -#endif - -/* - *------------------------------------------------------------------ - * Type : booleantype - *------------------------------------------------------------------ - * Constants : FALSE and TRUE - *------------------------------------------------------------------ - * ANSI C does not have a built-in bool data type. Below is the - * definition for a new type called booleantype. The advantage of - * using the name booleantype (instead of int) is an increase in - * code readability. It also allows the programmer to make a - * distinction between int and bool data. Variables of type - * booleantype are intended to have only the two values FALSE and - * TRUE which are defined below to be equal to 0 and 1, - * respectively. - *------------------------------------------------------------------ - */ - -#ifndef booleantype -#define booleantype int -#endif - -#ifndef FALSE -#define FALSE 0 -#endif - -#ifndef TRUE -#define TRUE 1 -#endif - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/sundials/sundials_config.h.in b/src/sundials/sundials_config.h.in deleted file mode 100755 index a378e81360..0000000000 --- a/src/sundials/sundials_config.h.in +++ /dev/null @@ -1,41 +0,0 @@ -/* FCMIX: Define name-mangling macro */ -#cmakedefine F77_FUNC @F77_FUNC@ - -/* Define to 1 if you have the header file. */ -#cmakedefine HAVE_DLFCN_H @HAVE_DLFCN_H@ - -/* Define to 1 if you have the `m' library (-lm). */ -#cmakedefine HAVE_LIBM @HAVE_LIBM@ - -/* Define to 1 if you have the header file. */ -#cmakedefine HAVE_UNISTD_H @HAVE_UNISTD_H@ - -/* Define to the version of this package. */ -#cmakedefine PACKAGE_VERSION @PACKAGE_VERSION@ - -/* FCMIX: Make function names lowercase */ -#cmakedefine SUNDIALS_CASE_LOWER @SUNDIALS_CASE_LOWER@ - -/* FCMIX: Make function names uppercase */ -#cmakedefine SUNDIALS_CASE_UPPER @SUNDIALS_CASE_UPPER@ - -/* Define SUNDIALS data type 'realtype' as 'double' */ -#cmakedefine SUNDIALS_DOUBLE_PRECISION @SUNDIALS_DOUBLE_PRECISION@ - -/* Define SUNDIALS data type 'realtype' as 'long double' */ -#cmakedefine SUNDIALS_EXTENDED_PRECISION @SUNDIALS_EXTENDED_PRECISION@ - -/* Define SUNDIALS data type 'realtype' as 'float' */ -#cmakedefine SUNDIALS_SINGLE_PRECISION @SUNDIALS_SINGLE_PRECISION@ - -/* FCMIX: Do NOT append any underscores to functions names */ -#cmakedefine SUNDIALS_UNDERSCORE_NONE @SUNDIALS_UNDERSCORE_NONE@ - -/* FCMIX: Append ONE underscore to function names */ -#cmakedefine SUNDIALS_UNDERSCORE_ONE @SUNDIALS_UNDERSCORE_ONE@ - -/* FCMIX: Append TWO underscores to function names */ -#cmakedefine SUNDIALS_UNDERSCORE_TWO @SUNDIALS_UNDERSCORE_TWO@ - -/* Use generic math functions */ -#cmakedefine SUNDIALS_USE_GENERIC_MATH @SUNDIALS_USE_GENERIC_MATH@ diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index ffa28da9b2..f58fe79bea 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -392,7 +392,7 @@ if(NRN_ENABLE_PYTHON) ENVIRONMENT "NRN_PYTEST_ARGS=${pytest_arg_string}" "CC=${CMAKE_C_COMPILER}" SCRIPT_PATTERNS test/pytest_coreneuron/run_pytest.py test/pytest_coreneuron/test_nrntest_fast.json - test/pytest_coreneuron/test_nrntest_fast.py + test/pytest_coreneuron/test_nrntest_fast_cv3.json test/pytest_coreneuron/test_nrntest_fast.py COMMAND ${MPIEXEC_NAME} ${MPIEXEC_NUMPROC_FLAG} 2 ${MPIEXEC_OVERSUBSCRIBE} ${MPIEXEC_PREFLAGS} special ${MPIEXEC_POSTFLAGS} -mpi -python test/pytest_coreneuron/run_pytest.py) # CoreNEURON's reports require MPI and segfault if it is not initialised. This is a crude diff --git a/test/cover/test_netcvode.json b/test/cover/test_netcvode.json index 2c7e76440c..4b27df87fa 100644 --- a/test/cover/test_netcvode.json +++ b/test/cover/test_netcvode.json @@ -14,32 +14,32 @@ "Cell1.soma.n_hh(0.5)" ], "cv.states": [ - -52.56915019288364, - -64.97554915771914, + -52.50938711497598, + -64.97554877215292, 0.0, 0.0, 0.0, 0.0, - 0.15526244018443686, - 0.5507143232853652, - 0.3451711102968484, - 0.05305325627781504, - 0.5960693669188045, - 0.31771127129361837 + 0.15582485144869637, + 0.55055775754716, + 0.3452546332246297, + 0.05305323269495299, + 0.5960693873718816, + 0.31771125645516396 ], "cv.dstates": [ - 12.366207188611789, - 0.02011923265881439, + 12.560086669798395, + 0.020118199892408574, -0.0, -0.0, -0.0, -0.0, - 0.11092977761552453, - -0.06416028033466402, - 0.036826999863115606, - 0.00013511580326666157, - -9.442748798103862e-05, - 6.237597633092167e-05 + 0.11207709505125722, + -0.06459562693011639, + 0.0370479067665413, + 0.00013522546304641636, + -9.443147521419767e-05, + 6.237977868226249e-05 ], "cv.error_weights": [ 1000.0, @@ -56,18 +56,18 @@ 1000.0 ], "cv.acor": [ - 0.0013309376181316142, - -1.2803391296318743e-08, + 0.0010812690723232437, + -1.4040774835404841e-08, 0.0, 0.0, 0.0, 0.0, - 6.6246598443165175e-06, - -2.3147493054086524e-06, - 9.917395969969089e-07, - 9.204792170098638e-10, - -2.3004375027497064e-11, - 2.3749720020827986e-11 + 4.657357986718185e-06, + -1.7872853616841512e-06, + 7.801498904080935e-07, + 1.0106810987514186e-09, + 4.997030297669551e-11, + -3.261713280559383e-11 ], "cv.statename lvardt": [ "Cell0.soma.v(0.5)", @@ -84,32 +84,32 @@ "Cell1.soma.n_hh(0.5)" ], "cv.states lvardt": [ - -52.556751629912945, + -52.53545236589848, 0.0, 0.0, - 0.15537064595973532, - 0.5506906013816929, - 0.3451862813940629, - -64.97670673284887, + 0.15558226635175665, + 0.5506282888605684, + 0.3452177082451229, + -64.9761957025603, 0.0, 0.0, - 0.0530492926609814, - 0.5960591577595183, - 0.3177175465913647 + 0.05304893701102853, + 0.5960633730004943, + 0.31771495734633265 ], "cv.dstates lvardt": [ - 12.40286741907709, + 12.47685558511351, -0.0, -0.0, - 0.11118849853419506, - -0.06425210339486709, - 0.03687327666674022, - 0.020258772081912287, + 0.11156915048226415, + -0.06440599813381483, + 0.03695162889715873, + 0.02004031194638477, -0.0, -0.0, - 0.00012128867605830228, - -8.846993767685432e-05, - 5.797373671525566e-05 + 0.00013627477218227798, + -9.106569603587847e-05, + 5.988397486638602e-05 ], "cv.error_weights lvardt": [ 1000.0, @@ -126,24 +126,24 @@ 1000.0 ], "cv.acor lvardt": [ - 0.0015165351332186512, + 0.001797648791297263, 0.0, 0.0, - 7.893058618725124e-06, - -2.788901777989529e-06, - 1.1972425237004676e-06, - -0.0007271442024934361, + 9.48714317398556e-06, + -3.308676418046889e-06, + 1.4307718973480343e-06, + -5.837135010288721e-05, 0.0, 0.0, - -8.615811648346098e-07, - -7.290163596890982e-06, - 4.616408157291523e-06 + -1.5186446462501243e-06, + -4.173939436043979e-07, + 2.1475215349602923e-07 ], "AtolTool": [ [ "v", 65.0, - 0.00187703630095626 + 0.0024854818855429366 ], [ "vext", @@ -172,18 +172,18 @@ ], [ "m_hh", - 0.15869553536795727, - 0.00016712701324188094 + 0.1560889907785202, + 0.00030912677821062876 ], [ "h_hh", 0.5961207535084603, - 2.0614893826950767e-05 + 2.49005552987478e-05 ], [ "n_hh", - 0.34629304832291347, - 7.5189202567305286e-06 + 0.34534183345837116, + 1.4084414690185844e-05 ], [ "ExpSyn.g", @@ -228,32 +228,32 @@ 0.0, 0.0, 0.0, - 0.15869553536795727, + 0.1560889907785202, 0.5961207535084603, - 0.34629304832291347, - 0.053057286843134016, + 0.34534183345837116, + 0.05305355044613753, 0.5961207535084603, - 0.31771316009296613 + 0.3177114032079621 ], "state_magnitudes acor": [ - 0.00187703630095626, - 1.3305439139589164e-06, + 0.0024854818855429366, + 2.504355613758206e-06, 0.0, 0.0, 0.0, 0.0, - 0.00016712701324188094, - 2.0614893826950767e-05, - 7.5189202567305286e-06, - 9.795770257160691e-08, - 9.171206138868032e-09, - 6.21304356086902e-09 + 0.00030912677821062876, + 2.49005552987478e-05, + 1.4084414690185844e-05, + 1.8204042386329376e-07, + 8.132383943998542e-09, + 6.27378631165311e-09 ], "AtolTool lvardt": [ [ "v", 65.0, - 0.0015165351332186512 + 0.00236087209990945 ], [ "vext", @@ -282,18 +282,18 @@ ], [ "m_hh", - 0.15943774047102888, - 0.00018205280403388316 + 0.158833417642452, + 0.00011959184172682607 ], [ "h_hh", 0.5961207535084603, - 1.536059852156204e-05 + 1.979758873080762e-05 ], [ "n_hh", - 0.34650998769347674, - 8.148397108026221e-06 + 0.34627618550058137, + 6.24144887929199e-06 ], [ "ExpSyn.g", @@ -335,9 +335,9 @@ 65.0, 0.0, 0.0, - 0.15943774047102888, + 0.158833417642452, 0.5961207535084603, - 0.34650998769347674, + 0.34627618550058137, 0.0, 0.0, 0.0, @@ -346,12 +346,12 @@ 0.0 ], "state_magnitudes acor lvardt": [ - 0.0015165351332186512, + 0.00236087209990945, 0.0, 0.0, - 0.00018205280403388316, - 1.536059852156204e-05, - 8.148397108026221e-06, + 0.00011959184172682607, + 1.979758873080762e-05, + 6.24144887929199e-06, 0.0, 0.0, 0.0, @@ -361,110 +361,122 @@ ], "record discrete tvec": [ -55.73833959014465, - -56.16269457449066, - -56.3516105831247, - -56.31586499025859, - -56.09610128991302, - -55.720713401617196, - -55.196718148619745, - -54.51912717017699 + -56.164073429598, + -56.353197398035576, + -56.31417939595125, + -56.087804781948854, + -55.70415710330923, + -55.17496924198961, + -54.489315154531134 + ], + "record discrete savestate tvec": [ + -51.05761223577956, + -49.083613840583915, + -46.26523218155794, + -41.96064390742168, + -34.81024885330416, + -21.839144847655277, + 1.599154947822088, + 28.91849590614551 ], "record discrete dt": [ -65.0, -55.73833959014465, - -56.16269457449066, - -56.3516105831247, - -56.31586499025859, - -56.09610128991302, - -55.720713401617196, - -55.19671814861975, - -54.51912717017699, - -53.66214294823793, - -52.56915019288365 - ], - "record discrete savestate tvec": [ - -51.140993480829515, - -49.20460254259869, - -46.44948436293736, - -42.25630675380093, - -35.336614602375676, - -22.831382830522298, - -0.06750064895864982, - 27.690563157778776 + -56.164073429598, + -56.353197398035576, + -56.31417939595125, + -56.087804781948854, + -55.70415710330923, + -55.17496924198961, + -54.489315154531134, + -53.618721296124875, + -52.50938711497598 ], "record discrete savestate dt": [ -65.0, - -51.140993480829515, - -49.20460254259869, - -46.44948436293736, - -42.25630675380093, - -35.336614602375654, - -22.83138283052226, - -0.06750064895858676, - 27.690563157778826, - 38.76897882554628 + -51.05761223577956, + -49.083613840583915, + -46.26523218155794, + -41.96064390742168, + -34.81024885330414, + -21.839144847655238, + 1.5991549478221518, + 28.918495906145555, + 38.93353691988716 ], "rtol=0.001 atol=0 tvec": [ 0.0, - 0.02236067977538076, - 0.04472135955076152, - 0.1219190044369798, - 0.19911664932319806, - 0.27631429420941633, - 0.42695939217920337, - 0.5776044901489904, - 0.7282495881187774, - 0.8788946860885645, - 1.0295397840583516, - 1.1801848820281386, - 1.3308299799979257, - 1.4814750779677128, - 1.6321201759375, - 1.782765273907287, - 1.933410371877074, + 0.022360679774997894, + 0.04472135954999579, + 0.1219190045167767, + 0.19911664948355762, + 0.2763142944503385, + 0.4269593925378439, + 0.5776044906253492, + 0.7282495887128546, + 0.87889468680036, + 1.0295397848878654, + 1.1801848829753707, + 1.330829981062876, + 1.4814750791503815, + 1.6321201772378868, + 1.7827652753253922, + 1.9334103734128976, 2.0 ], "rtol=0.001 atol=0 vvec": [ 0.001, - 0.0009781283844168443, - 0.000956735136401906, - 0.0008864924820811945, - 0.0008208339646961824, - 0.0007598424282698836, - 0.0006531309234969456, - 0.000561199154196322, - 0.0004821344379982148, - 0.00041418309710490364, - 0.00035579966640500075, - 0.0003056427967938534, - 0.00026255538572055856, - 0.00022554174334754837, - 0.000193745944678334, - 0.0001664325166086807, - 0.00014296959483807464, - 0.00013365247855087568 + 0.0009781283844172107, + 0.0009567351364026562, + 0.0008864924820122856, + 0.0008208339645665602, + 0.0007598424280885463, + 0.0006531309232629807, + 0.0005611991539277455, + 0.00048213443770928115, + 0.00041418309680670457, + 0.00035579966610583554, + 0.00030564279649990115, + 0.0002625553854362881, + 0.00022554174307610442, + 0.00019374594442173116, + 0.00016643251636812263, + 0.00014296959461413495, + 0.00013365247854877708 ], "rtol=0 atol=0.001 tvec": [ 0.0, 0.0036865877408063983, 0.582009367159784, - 1.5645270609956103, + 1.5645270609956108, 2.0 ], "rtol=0 atol=0.001 vvec": [ 0.001, 0.0009963269532682463, 0.0006312567785627606, - 0.00025650358596811197, + 0.00025650358596811186, 0.0001536542475067585 ], "stiff=0 lvardt tvec size": 69, "stiff=0 tvec size": 73, - "stiff=1 tvec size": 66, - "stiff=2 tvec size": 71, + "stiff=1 tvec size": 72, + "stiff=2 tvec size": 67, "jacobian 2 tvec size": 93, "jacobian 1 tvec size": 78, - "jacobian 0 tvec size": 71, + "jacobian 0 tvec size": 67, + "store_events": [ + 0.0, + 10.986122886681098, + 0.0, + 12.527629684953682, + 0.0, + 14.66337068793427, + 10.986122886681098, + 21.972245773362197, + 12.527629684953682, + 25.055259369907365 + ], "event queue spikes": [ [ 10.986122886681098, @@ -527,18 +539,6 @@ 0.0 ] ], - "store_events": [ - 0.0, - 10.986122886681098, - 0.0, - 12.527629684953682, - 0.0, - 14.66337068793427, - 10.986122886681098, - 21.972245773362197, - 12.527629684953682, - 25.055259369907365 - ], - "interthread debug_event 2 serial threads": "send NetParEvent 0 t=4.975 tt-t=4.975\nsend NetParEvent 1 t=4.975 tt-t=4.975\nsend PreSyn src=Cell0.soma 6.7250000001\ninterthread send td=6.7250000001 DE type=4 thread=1 target=-1 ?\ninterthread enqueue td=6.7250000001 DE type=4 thread=1 target=-1 ?\nsend PreSyn src=Cell0.soma 6.7250000001\ndeliver NetParEvent 1 t=4.975 tt-t=-3.73035e-14\nsend NetParEvent 1 t=9.95 tt-t=4.975\ndeliver NetParEvent 0 t=4.975 tt-t=-3.73035e-14\nsend NetParEvent 0 t=9.95 tt-t=4.975\ndeliver PreSyn src=Cell0.soma 6.7250000001\ndeliver PreSyn src=Cell0.soma 6.7250000001\ndeliver NetParEvent 1 t=9.95 tt-t=3.01981e-14\nsend NetParEvent 1 t=14.925 tt-t=4.975\ndeliver NetParEvent 0 t=9.95 tt-t=3.01981e-14\nsend NetParEvent 0 t=14.925 tt-t=4.975\n", - "playrecord debug_event": "send PlayRecordEvent 0 VecPlayStep Vector[N].x[0]\ndeliver PlayRecordEvent 0 VecPlayStep Vector[N].x[0]\nsend PlayRecordEvent 1 VecPlayStep Vector[N].x[1]\nmicrostep retreat from 1 (cvode_0x... is at 1) for event onset=1\n" + "playrecord debug_event": "send PlayRecordEvent 0 VecPlayStep Vector[N].x[0]\ndeliver PlayRecordEvent 0 VecPlayStep Vector[N].x[0]\nsend PlayRecordEvent 1 VecPlayStep Vector[N].x[1]\nmicrostep retreat from 1 (cvode_0x... is at 1) for event onset=1\n", + "interthread debug_event 2 serial threads": "send NetParEvent 0 t=4.975 tt-t=4.975\nsend NetParEvent 1 t=4.975 tt-t=4.975\nsend PreSyn src=Cell0.soma 6.7250000001\ninterthread send td=6.7250000001 DE type=4 thread=1 target=-1 ?\ninterthread enqueue td=6.7250000001 DE type=4 thread=1 target=-1 ?\nsend PreSyn src=Cell0.soma 6.7250000001\ndeliver NetParEvent 1 t=4.975 tt-t=-3.73035e-14\nsend NetParEvent 1 t=9.95 tt-t=4.975\ndeliver NetParEvent 0 t=4.975 tt-t=-3.73035e-14\nsend NetParEvent 0 t=9.95 tt-t=4.975\ndeliver PreSyn src=Cell0.soma 6.7250000001\ndeliver PreSyn src=Cell0.soma 6.7250000001\ndeliver NetParEvent 1 t=9.95 tt-t=3.01981e-14\nsend NetParEvent 1 t=14.925 tt-t=4.975\ndeliver NetParEvent 0 t=9.95 tt-t=3.01981e-14\nsend NetParEvent 0 t=14.925 tt-t=4.975\n" } diff --git a/test/cover/test_netcvode.py b/test/cover/test_netcvode.py index 4751c2f622..dcea52f288 100644 --- a/test/cover/test_netcvode.py +++ b/test/cover/test_netcvode.py @@ -9,9 +9,10 @@ from neuron.tests.utils.checkresult import Chk from neuron.tests.utils import get_c_compiler +jsonfile = "test_netcvode.json" dir_path = os.path.dirname(os.path.realpath(__file__)) -chk = Chk(os.path.join(dir_path, "test_netcvode.json")) +chk = Chk(os.path.join(dir_path, jsonfile)) if hasattr(h, "usetable_hh"): h.usetable_hh = 0 # So same whether compiled with CoreNEURON or not. @@ -557,8 +558,8 @@ def integrator_properties(): def run1(key): h.finitialize(0.001) cv.solve(2) - chk(key + " tvec", tvec, tol=5e-10) - chk(key + " vvec", vvec, tol=1e-9) + chk(key + " tvec", tvec, tol=1e-9) + chk(key + " vvec", vvec, tol=2e-9) cv.rtol(1e-3) cv.atol(0) diff --git a/test/external/CMakeLists.txt b/test/external/CMakeLists.txt index b48e547073..d6567f25a0 100644 --- a/test/external/CMakeLists.txt +++ b/test/external/CMakeLists.txt @@ -19,7 +19,7 @@ FetchContent_Declare( FetchContent_Declare( nrntest GIT_REPOSITORY https://github.com/neuronsimulator/nrntest - GIT_TAG a85864d1b2a7a531716e3c4908dec83faad83020 + GIT_TAG 94078e88b305f1581ccf0c74bd15316f5351c179 # hines/update-t12 SOURCE_DIR ${PROJECT_SOURCE_DIR}/external/tests/nrntest) FetchContent_Declare( diff --git a/test/hoctests/tests/test_kschan.json b/test/hoctests/tests/test_kschan.json index 650c7a2faa..0c75d95c0e 100644 --- a/test/hoctests/tests/test_kschan.json +++ b/test/hoctests/tests/test_kschan.json @@ -8,154 +8,139 @@ 0.0, 0.00245193773986701, 0.00490387547973402, - 0.011343926658017558, - 0.017783977836301094, - 0.02422402901458463, - 0.03442215740629855, - 0.05959292637493886, - 0.0717927520065163, - 0.08399257763809374, - 0.09619240326967118, + 0.010304630635043222, + 0.015705385790352425, + 0.021106140945661628, + 0.030406735719525256, + 0.05319083176943047, + 0.0759749278193357, + 0.08621139949460939, + 0.09644787116988308, 0.09999999999999779, 0.10000000000000112, - 0.10263805068250757, - 0.10527610136501403, - 0.11205936160250875, - 0.11884262184000347, - 0.12562588207749817, - 0.13240914231499287, - 0.13919240255248758, - 0.15226722278104374, - 0.1653420430095999, - 0.17841686323815606, - 0.19149168346671222, - 0.2205861694524643, - 0.24968065543821635, - 0.2768889711481657, - 0.304097286858115, - 0.3313056025680643, - 0.3585139182780136, - 0.37525437399062056, - 0.3919948297032275, - 0.4087352854158345, - 0.42547574112844144, - 0.4422161968410484, - 0.45895665255365536, - 0.4685026085643592, - 0.47804856457506306, - 0.4875945205857669, - 0.49714047659647076, - 0.5066864326071746, - 0.5210660174659459, - 0.5354456023247173, - 0.5498251871834886, - 0.5642047720422599, - 0.5785843569010313, - 0.5929639417598026, - 0.6073435266185739, - 0.6217231114773453, - 0.6361026963361166, - 0.6504822811948879, - 0.6648618660536593, - 0.6792414509124306, - 0.6936210357712019, - 0.7080006206299733, - 0.7223802054887446, - 0.745902837978681, - 0.7694254704686173, - 0.7929481029585537, - 0.81647073544849, - 0.8399933679384264, - 0.8635160004283627, - 0.8870386329182991, - 0.9105612654082355, - 0.9340838978981718, - 0.9576065303881082, - 0.9971074388490605, + 0.10263630708647273, + 0.10527261417294434, + 0.11243788396298723, + 0.11960315375303013, + 0.12676842354307302, + 0.13393369333311592, + 0.1410989631231588, + 0.15445083359000208, + 0.16780270405684536, + 0.18115457452368863, + 0.1945064449905319, + 0.2220473916325471, + 0.24958833827456228, + 0.2780319647703528, + 0.3064755912661433, + 0.33491921776193384, + 0.3522890526526552, + 0.36965888754337656, + 0.3870287224340979, + 0.4043985573248193, + 0.43247359585773254, + 0.4453430533067773, + 0.4582125107558221, + 0.47108196820486686, + 0.48395142565391164, + 0.4968208831029564, + 0.5096903405520011, + 0.5225597980010459, + 0.5354553578496775, + 0.548350917698309, + 0.5612464775469406, + 0.5741420373955721, + 0.5870375972442037, + 0.5999331570928352, + 0.6128287169414668, + 0.6257242767900983, + 0.6386198366387299, + 0.6515153964873615, + 0.664410956335993, + 0.6842586197827478, + 0.7041062832295026, + 0.7239539466762575, + 0.7438016101230123, + 0.7636492735697671, + 0.7834969370165219, + 0.8033446004632767, + 0.8231922639100315, + 0.8430399273567863, + 0.8806854239334706, + 0.9183309205101549, + 0.9559764170868391, + 0.9936219136635234, 1.0 ], [ -65.0, -64.26484111153752, - -63.53089400597157, - -61.60862994684805, - -59.693587447610454, - -57.78622684869641, - -54.78162733894752, - -47.44281638250003, - -43.923664068893245, - -40.42547971951952, - -36.94382264194653, - -35.86018255657097, - -35.86018255657097, - -35.90082319848319, - -35.940222689051474, - -36.03568498464055, - -36.1226627732539, - -36.199698266090564, - -36.26566771729424, - -36.31957746558762, - -36.38574444995952, - -36.39748086911035, - -36.34853899987099, - -36.23254921100638, - -35.70317801563712, - -34.74329305521833, - -33.39016154402204, - -31.525963189927655, - -29.06741314493461, - -25.914719167503286, - -23.579832370127882, - -20.906268510967095, - -17.863529577751116, - -14.424432214913185, - -10.570911591208795, - -6.299280611440655, - -3.6819900003844763, - -0.9443230219848133, - 1.8997829803973731, - 4.831465377889435, - 7.8266072797326585, - 12.391377960424135, - 16.914709246024483, - 21.26616111118005, - 25.314373159763356, - 28.945880002554883, - 32.081532129323456, - 34.68490450668356, - 36.761733164052245, - 38.3520430966959, - 39.51802808542601, - 40.33127278420815, - 40.8622889734875, - 41.173818843521396, - 41.31780455634654, - 41.3350255167126, - 41.16764401415044, - 40.83173522931841, - 40.377735615974345, - 39.83391465243114, - 39.21753555745409, - 38.539831235711155, - 37.80808784291536, - 37.027134102231216, - 36.20064198740306, - 35.3319092157213, - 33.786997763595046, - 33.66993536143933 + -63.53088693085283, + -61.918100195987165, + -60.310401991314244, + -58.708150743425016, + -55.96179865615698, + -49.298875945904385, + -42.7199058735335, + -39.788678991353656, + -36.86873656212963, + -35.85781591053689, + -35.85781591053689, + -35.898403922601815, + -35.937760655801966, + -36.03816077322458, + -36.129043481243585, + -36.208682919207625, + -36.2757709954464, + -36.329148545173545, + -36.38804873971793, + -36.38900157576894, + -36.32542405347975, + -36.19056802745058, + -35.659473211428526, + -34.7392226275911, + -33.31282727205928, + -31.323735324102987, + -28.67535498334692, + -26.686167614108975, + -24.37709985314526, + -21.71429443457416, + -18.663456435175856, + -12.838262597510383, + -9.775518251557514, + -6.4659701967445855, + -2.9211778108752755, + 0.8347977401614997, + 4.762626130154883, + 8.80603189727622, + 12.892074748477993, + 16.943772227864052, + 20.856895289297697, + 24.535310006989565, + 27.894288359871172, + 30.869915277093412, + 33.424817716186396, + 35.54959867181365, + 37.26031184050992, + 38.592408656009745, + 39.593233524957874, + 40.314771472508, + 40.9940052123888, + 41.29045568033915, + 41.32756749385567, + 41.18792714315614, + 40.92297421012165, + 40.56587324478584, + 40.13923154644093, + 39.657086663721465, + 39.1270140153969, + 38.00651403452935, + 36.75312500731109, + 35.38618512626952, + 33.920653918120856, + 33.663404365001796 ] ], - "kchan with single": "a4600b6156ca96ce9338c37c0f464c8a", - "kchan failed to turn off single": "a4600b6156ca96ce9338c37c0f464c8a", - "kchan without single": "0e6f04378e8456893795c88970e056d3", - "before remove transition": "277655b8ea0d4483a3449f9a1c2c951b", - "after remove transition": "35033bca7e44b8b88945fdc3f71cd23a", - "KSTrans 1<->2 with cai": "a3ee87362e20cb7fafecfdae59305539", - "KSTrans 1<->2 change to cao": "5b1729b60c4f8f5f134498975a70be78", - "KSTrans 1<->2 change to cli": "b41397bb15644a328ee0fb8a0d4a587d", - "KSTrans 1<->2 has no ligand": "292155541558e8ed3e218a9122242562", - "bug? cl_ion not used but still ligand 0": "db46a89fe983ac7a3d30ea05be7a7e39", - "bug? 4 ligands (cl_ion, 2 u238_ion, ca_ion), none in use": "e901ab7ab099e838de6636b72728d2ff", "nahh cvode=False": [ [ 0.0, @@ -772,268 +757,417 @@ 34.05466009572817 ] ], + "kchan with single": "a4600b6156ca96ce9338c37c0f464c8a", + "kchan failed to turn off single": "a4600b6156ca96ce9338c37c0f464c8a", + "kchan without single": "0e6f04378e8456893795c88970e056d3", "kchan without single cvode=True": [ [ 0.0, 0.0027138443813536513, 0.005427688762707303, - 0.012497719672848798, - 0.019567750582990293, - 0.026637781493131788, - 0.03803632185741194, - 0.055176791278722916, - 0.07231726070003389, - 0.08945773012134486, + 0.01134958050884308, + 0.017271472254978857, + 0.023193364001114634, + 0.03353145623166176, + 0.06212152653596793, + 0.0748293225624078, + 0.08753711858884768, 0.09999999999999779, 0.10000000000000112, - 0.1029099907014636, - 0.10581998140292609, - 0.11305637171381606, - 0.12029276202470604, - 0.12752915233559603, - 0.13476554264648602, - 0.142001932957376, - 0.156152689337463, - 0.17030344571755002, - 0.18445420209763702, - 0.19860495847772403, - 0.22870181004821277, - 0.2587986616187015, - 0.28889551318919027, - 0.318992364759679, - 0.3379262672558148, - 0.3568601697519506, - 0.3757940722480864, - 0.4075885053962256, - 0.4393829385443647, - 0.45712250256401116, - 0.4748620665836576, - 0.49260163060330403, - 0.5103411946229505, - 0.5280807586425968, - 0.5458203226622433, - 0.55809408291673, - 0.5703678431712167, - 0.5826416034257034, - 0.59491536368019, - 0.6071891239346767, - 0.6194628841891634, - 0.6383136675491474, - 0.6508417401965236, - 0.6633698128438998, - 0.675897885491276, - 0.6884259581386523, - 0.7009540307860285, - 0.7134821034334047, - 0.7260101760807809, - 0.7586374237787784, - 0.7774648679384102, - 0.796292312098042, - 0.8151197562576737, - 0.8339472004173055, - 0.8527746445769373, - 0.8716020887365691, - 0.8904295328962009, - 0.9189698572512912, - 0.934101671072843, - 0.9492334848943949, + 0.10290724552654784, + 0.10581449105309457, + 0.11348213299415277, + 0.12114977493521098, + 0.1288174168762692, + 0.1364850588173274, + 0.1441527007583856, + 0.1586139199884385, + 0.17307513921849138, + 0.18753635844854427, + 0.20199757767859716, + 0.23032047574665604, + 0.2586433738147149, + 0.2869662718827738, + 0.31528916995083267, + 0.34361206801889155, + 0.3719349660869504, + 0.4002578641550093, + 0.4285807622230682, + 0.4427204161065647, + 0.45686006999006123, + 0.47099972387355776, + 0.4851393777570543, + 0.4941476858233291, + 0.5031559938896039, + 0.5121643019558786, + 0.5286876105141872, + 0.5452109190724959, + 0.5617342276308045, + 0.5782575361891131, + 0.5896318403118017, + 0.6010061444344903, + 0.6123804485571789, + 0.6237547526798675, + 0.635129056802556, + 0.6532961530672234, + 0.6714632493318908, + 0.6896303455965582, + 0.7077974418612256, + 0.7282342842298329, + 0.7486711265984403, + 0.7691079689670476, + 0.7895448113356549, + 0.8099816537042622, + 0.8304184960728695, + 0.863869979778127, + 0.8973214634833844, + 0.9307729471886418, + 0.9642244308938992, + 0.9976759145991566, 1.0 ], [ -65.0, -64.18646893974743, - -63.37442173683355, - -61.265462310626305, - -59.16517900529351, - -57.07410699935114, - -53.72224075938467, - -48.72484743816321, - -43.77539189932893, - -38.86553349845051, - -35.86150319791169, - -35.86150319791169, - -35.90624370002775, - -35.94946275932843, - -36.050211120092214, - -36.14114860041652, - -36.22054975345217, - -36.287065691146644, - -36.33949794648734, - -36.396676305630784, - -36.38793872376296, - -36.30543391887692, - -36.14113154886276, - -35.484371558983845, - -34.3458430524747, - -32.63946323849545, - -30.264369516679647, - -28.37505912332529, - -26.137045071566778, - -23.50899357839703, - -18.0969136138025, - -11.274228077786306, - -6.810622872774583, - -1.897118742975757, - 3.3994496775855527, - 8.955345974805287, - 14.585573940163279, - 20.057109689544195, - 23.61688815328194, - 26.90496994574964, - 29.861310971662572, - 32.44587073815056, - 34.64139723529966, - 36.45281751496347, - 38.54241491524826, - 39.52944178963125, - 40.25066413245361, - 40.751931245039685, - 41.0754814485946, - 41.25815305421991, - 41.330368731021615, - 41.31617873152482, - 40.99784149517678, - 40.681581238398074, - 40.29660888716977, - 39.85736796408913, - 39.37260594580294, - 38.847538245824936, - 38.28572886748986, - 37.690047699471194, - 36.72789377540983, - 36.19091785177815, - 35.63641734732693, - 33.6574907875631 + -63.37441217434573, + -61.60704611626884, + -59.84577992013202, + -58.091035551360285, + -55.04341832167125, + -46.71082713135837, + -43.05032482947234, + -39.411427164969396, + -35.8586349981608, + -35.8586349981608, + -35.90329497077794, + -35.946447574693316, + -36.052644850233534, + -36.147757746615014, + -36.2297204702835, + -36.29694902697411, + -36.34803326866736, + -36.395441914993526, + -36.37242829598478, + -36.270715014331344, + -36.081775624828936, + -35.42730102732387, + -34.34206588057904, + -32.75432542759601, + -30.58067892962082, + -27.71955001962047, + -24.047676891593788, + -19.42410532426408, + -13.709502361315943, + -10.413486210032264, + -6.819269076510758, + -2.939729695225085, + 1.1942819390177586, + 3.9394643088810155, + 6.748603116473766, + 9.598082946413802, + 14.83550027369321, + 19.925171970336002, + 24.670003102217677, + 28.89086184947842, + 31.420082763127382, + 33.61738213995599, + 35.48049516334016, + 37.021290947558576, + 38.262869660198724, + 39.70265461942777, + 40.60088406825695, + 41.0982355279119, + 41.30936293215694, + 41.3075103549133, + 41.12847229666455, + 40.825559742762806, + 40.43409413595607, + 39.975275725084465, + 39.46040808677869, + 38.513539837074596, + 37.45493734242615, + 36.300609777521416, + 35.06162146538181, + 33.74540319660194, + 33.651269543567096 ] ], + "before remove transition": "277655b8ea0d4483a3449f9a1c2c951b", + "after remove transition": "35033bca7e44b8b88945fdc3f71cd23a", + "KSTrans 1<->2 with cai": "a3ee87362e20cb7fafecfdae59305539", + "KSTrans 1<->2 change to cao": "5b1729b60c4f8f5f134498975a70be78", + "KSTrans 1<->2 change to cli": "b41397bb15644a328ee0fb8a0d4a587d", + "KSTrans 1<->2 has no ligand": "292155541558e8ed3e218a9122242562", "KSTrans cvode=True single=True": [ [ 0.0, 0.002714579857699548, 0.005429159715399096, - 0.01250802339214606, - 0.019586887068893024, - 0.02666575074563999, - 0.038074488617193376, - 0.055177667890721635, - 0.07228084716424989, - 0.08938402643777814, + 0.011352480754876437, + 0.017275801794353778, + 0.023199122833831118, + 0.03354075102616134, + 0.06227377310530063, + 0.07495076389462299, + 0.08762775468394536, 0.09999999999999779, 0.10000000000000112, - 0.10291059249212993, - 0.10582118498425874, - 0.11307661749030269, - 0.12033204999634664, - 0.1275874825023906, - 0.13484291500843457, - 0.14209834751447853, - 0.15626672473703923, - 0.17043510195959993, - 0.18460347918216063, - 0.19877185640472134, - 0.22886651969260813, - 0.2589611829804949, - 0.2890558462683817, - 0.3191505095562685, - 0.3380751675621692, - 0.3569998255680699, - 0.3759244835739706, - 0.40711703029352764, - 0.43830957701308465, - 0.4560611389921882, - 0.47381270097129174, - 0.4915642629503953, - 0.5093158249294988, - 0.5270673869086023, - 0.5448189488877059, - 0.5571679236164115, - 0.5695168983451172, - 0.5818658730738229, - 0.5942148478025285, - 0.6065638225312342, - 0.6189127972599399, - 0.6390053707152302, - 0.6516300658765157, - 0.6642547610378012, - 0.6768794561990867, - 0.6895041513603722, - 0.7021288465216577, - 0.7240395290725938, - 0.7459502116235299, - 0.767860894174466, - 0.7897715767254021, - 0.8116822592763382, - 0.8335929418272743, - 0.8555036243782104, - 0.8774143069291465, - 0.9107030791479962, - 0.9439918513668459, - 0.9772806235856957, + 0.10290773450628886, + 0.1058154690125766, + 0.11348273923837665, + 0.1211500094641767, + 0.12881727968997675, + 0.1364845499157768, + 0.14415182014157685, + 0.15861604980319038, + 0.17308027946480392, + 0.18754450912641746, + 0.202008738788031, + 0.23030070578331382, + 0.25859267277859666, + 0.2868846397738795, + 0.31517660676916237, + 0.34346857376444523, + 0.3717605407597281, + 0.40005250775501094, + 0.4283444747502938, + 0.4426162492721297, + 0.45688802379396565, + 0.47115979831580157, + 0.4854315728376375, + 0.49443654572733425, + 0.503441518617031, + 0.5124464915067277, + 0.5285911085777293, + 0.5447357256487309, + 0.5608803427197324, + 0.577024959790734, + 0.5931695768617355, + 0.6093141939327371, + 0.6254588110037387, + 0.6416034280747402, + 0.6577480451457418, + 0.6738926622167434, + 0.6900372792877449, + 0.7061818963587465, + 0.7223265134297481, + 0.7384711305007496, + 0.7546157475717512, + 0.7707603646427528, + 0.7869049817137543, + 0.8030495987847559, + 0.8191942158557575, + 0.835338832926759, + 0.8514834499977606, + 0.8676280670687622, + 0.8938249854396043, + 0.9200219038104465, + 0.9462188221812886, + 0.9860343949540455, 1.0 ], [ -65.0, -64.18623645893358, - -63.3739568108875, - -61.262334953249876, - -59.15940601945265, - -57.06570585934258, - -53.71082295307949, - -48.72420347968739, - -43.78529170086838, - -38.88577682636021, - -35.860522519901686, - -35.860522519901686, - -35.905220286495904, - -35.948396186229715, - -36.04925802543033, - -36.14025316406032, - -36.21964272577292, - -36.28606789974167, - -36.33832113129902, - -36.394826527253656, - -36.38517757291258, - -36.30149090614295, - -36.13570315386551, - -35.47579171470582, - -34.333602337548584, - -32.62289230177675, - -30.242622621840198, - -28.350394587764843, - -26.109317489550204, - -23.47805764870901, - -18.172588984630906, - -11.510256480457944, - -7.069226195790272, - -2.1753640553417957, - 3.1072608014785095, - 8.657983810800609, - 14.294521227280963, - 19.785227482513168, - 23.384350454658975, - 26.713270299175083, - 29.709589302187315, - 32.3311677796415, - 34.559170164493345, - 36.397608295036264, - 38.61867929346114, - 39.594433572000426, - 40.3037820374152, - 40.793219381426326, - 41.10548844853454, - 41.27776611049866, - 41.33102325817382, - 41.16698343549704, - 40.856744323481344, - 40.441767713040356, - 39.94695288717403, - 39.38817093819083, - 38.77500156136339, - 38.112912921460946, - 37.02196872103532, - 35.83871275247566, - 34.57410947748538, - 33.668960797953524 + -63.37394723930826, + -61.60612625768008, + -59.844404787058195, + -58.089204723177176, + -55.04048486246385, + -46.66628343565681, + -43.014741329830166, + -39.384637372707815, + -35.85753695644038, + -35.85753695644038, + -35.90214962999171, + -35.94525382497904, + -36.05129682941083, + -36.14625373180068, + -36.22805905166067, + -36.29512888394597, + -36.34605299185441, + -36.39315776710731, + -36.369794004855365, + -36.26767579647768, + -36.078266879903204, + -35.42376524860334, + -34.33934081190361, + -32.75340631419913, + -30.582795749528792, + -27.726248867725463, + -24.060897279193682, + -19.44620139951, + -13.743354755256329, + -10.41822648592005, + -6.789163351046144, + -2.8695224682931286, + 1.3086747651924457, + 4.056300567286326, + 6.867008193747146, + 9.71702485532221, + 14.835374849720806, + 19.812943658652614, + 24.46529046404585, + 28.62384590976176, + 32.166256423797215, + 35.036593020668654, + 37.24689385705839, + 38.86263796043376, + 39.979007211458615, + 40.69844692277351, + 41.11501216733593, + 41.30659557488521, + 41.33334182586596, + 41.239176464841364, + 41.05509044549883, + 40.802531291849505, + 40.4960734522069, + 40.14551950835602, + 39.757491528313324, + 39.336573466615924, + 38.88605666517053, + 38.40840285301662, + 37.58050485601193, + 36.692542760663144, + 35.74957946631354, + 34.22122220603341, + 33.66030776511344 + ] + ], + "KSTrans cvode=True single=False": [ + [ + 0.0, + 0.0027143066344790467, + 0.005428613268958093, + 0.011350979956848094, + 0.017273346644738095, + 0.023195713332628095, + 0.03353491864503463, + 0.061977295727314294, + 0.07469504511440542, + 0.08741279450149654, + 0.09999999999999779, + 0.10000000000000112, + 0.10290793040439505, + 0.10581586080878899, + 0.11348327422877291, + 0.12115068764875683, + 0.12881810106874075, + 0.13648551448872467, + 0.1441529279087086, + 0.15861761771745847, + 0.17308230752620835, + 0.18754699733495822, + 0.2020116871437081, + 0.23030832159085365, + 0.2586049560379992, + 0.28690159048514474, + 0.31519822493229027, + 0.3434948593794358, + 0.37179149382658133, + 0.40008812827372686, + 0.4283847627208724, + 0.44265410870125527, + 0.45692345468163814, + 0.471192800662021, + 0.4854621466424039, + 0.4944669621078251, + 0.5034717775732463, + 0.5124765930386675, + 0.5286158938000501, + 0.5447551945614327, + 0.5608944953228153, + 0.5770337960841979, + 0.5931730968455805, + 0.6093123976069631, + 0.6254516983683457, + 0.6415909991297283, + 0.6577302998911109, + 0.6738696006524935, + 0.690008901413876, + 0.7061482021752586, + 0.7222875029366412, + 0.7384268036980238, + 0.7545661044594064, + 0.770705405220789, + 0.7868447059821716, + 0.8029840067435542, + 0.8191233075049368, + 0.8352626082663194, + 0.851401909027702, + 0.8675412097890846, + 0.893724139588288, + 0.9199070693874916, + 0.9460899991866951, + 0.9858795182374621, + 1.0 + ], + [ + -65.0, + -64.18632124787062, + -63.37411670999513, + -61.606586800149145, + -59.845155257174014, + -58.09024392212163, + -55.0422477552791, + -46.75219450863091, + -43.088445600857234, + -39.446358030972284, + -35.857864158447384, + -35.857864158447384, + -35.90249354319761, + -35.945614457073155, + -36.05169671676238, + -36.14669381841308, + -36.228540364537, + -36.29565248577447, + -36.34661997042342, + -36.39380979656374, + -36.37053335629269, + -36.26850482007852, + -36.07918814746574, + -35.42476205905926, + -34.34030592958675, + -32.75420793498289, + -30.583271388845432, + -27.72619435099371, + -24.06005331053317, + -19.444245124253136, + -13.739911847325528, + -10.41505227318824, + -6.786377944986206, + -2.867254062673835, + 1.3102993328156465, + 4.057882998142163, + 6.868526528503449, + 9.718456396192126, + 14.835013495702572, + 19.810872835739424, + 24.461777041553283, + 28.61931371948824, + 32.16121204163398, + 35.03152704908716, + 37.24219637314458, + 38.85855641463596, + 39.975650930860034, + 40.69582210767104, + 41.1130653243275, + 41.305249611732584, + 41.33251912903293, + 41.238810520728876, + 41.05512967245435, + 40.80293884627785, + 40.49682517822385, + 40.14660109212593, + 39.758895794742706, + 39.338298148800405, + 38.888102715815656, + 38.4107732301605, + 37.5835864327957, + 36.69637175654319, + 35.754188558964636, + 34.22726123645658, + 33.66020918067044 ] ], "KSTrans cvode=False single=True": [ @@ -1124,6 +1258,96 @@ 34.54936780351269 ] ], + "KSTrans cvode=False single=False": [ + [ + 0.0, + 0.025, + 0.05, + 0.075, + 0.09999999999999999, + 0.12499999999999999, + 0.15, + 0.17500000000000002, + 0.20000000000000004, + 0.22500000000000006, + 0.25000000000000006, + 0.2750000000000001, + 0.3000000000000001, + 0.3250000000000001, + 0.35000000000000014, + 0.37500000000000017, + 0.4000000000000002, + 0.4250000000000002, + 0.45000000000000023, + 0.47500000000000026, + 0.5000000000000002, + 0.5250000000000001, + 0.55, + 0.575, + 0.5999999999999999, + 0.6249999999999998, + 0.6499999999999997, + 0.6749999999999996, + 0.6999999999999995, + 0.7249999999999994, + 0.7499999999999993, + 0.7749999999999992, + 0.7999999999999992, + 0.8249999999999991, + 0.849999999999999, + 0.8749999999999989, + 0.8999999999999988, + 0.9249999999999987, + 0.9499999999999986, + 0.9749999999999985, + 0.9999999999999984 + ], + [ + -65.0, + -57.61698001518964, + -50.350680331662666, + -43.190959064808595, + -36.118349378635024, + -36.45214555816893, + -36.64013375770745, + -36.63901228066678, + -36.40785016818501, + -35.90739311979073, + -35.098342787028955, + -33.938983603152764, + -32.38249620775813, + -30.37433493239779, + -27.85023024839231, + -24.735811936721902, + -20.949673938481457, + -16.41300375864941, + -11.070338662286476, + -4.925845486416181, + 1.9065110859235475, + 9.156953785515793, + 16.396750192384502, + 23.114467243140304, + 28.85862394448292, + 33.36981164763734, + 36.623187926589694, + 38.77284096573438, + 40.05395516480963, + 40.70121687913082, + 40.90634885315981, + 40.808208123873015, + 40.499949593417945, + 40.04123645048496, + 39.469454750133934, + 38.808051820286906, + 38.07208641230601, + 37.271686168441654, + 36.414113931544115, + 35.50497068675557, + 34.54888423211685 + ] + ], + "bug? cl_ion not used but still ligand 0": "db46a89fe983ac7a3d30ea05be7a7e39", + "bug? 4 ligands (cl_ion, 2 u238_ion, ca_ion), none in use": "e901ab7ab099e838de6636b72728d2ff", "khh4 ivtype=0 ion=NonSpecific": [ [ 0.0, @@ -1651,219 +1875,5 @@ 32.21218074323528, 31.218680285698994 ] - ], - "KSTrans cvode=True single=False": [ - [ - 0.0, - 0.0027143066344790467, - 0.005428613268958093, - 0.012490885062614594, - 0.019553156856271094, - 0.026615428649927594, - 0.03800903502056763, - 0.05514693084159548, - 0.07228482666262333, - 0.08942272248365118, - 0.09999999999999779, - 0.10000000000000112, - 0.10291059502661276, - 0.1058211900532244, - 0.11307666574190492, - 0.12033214143058543, - 0.12758761711926594, - 0.13484309280794646, - 0.14209856849662697, - 0.15626681605027712, - 0.17043506360392727, - 0.18460331115757742, - 0.19877155871122756, - 0.2288718651320854, - 0.2589721715529433, - 0.28907247797380115, - 0.319172784394659, - 0.33809740253078896, - 0.3570220206669189, - 0.37594663880304885, - 0.4071537990821027, - 0.43836095936115654, - 0.45611081882296123, - 0.4738606782847659, - 0.4916105377465706, - 0.5093603972083753, - 0.5271102566701801, - 0.5448601161319848, - 0.5572067862725636, - 0.5695534564131424, - 0.5819001265537211, - 0.5942467966942999, - 0.6065934668348787, - 0.6189401369754575, - 0.6389905159039171, - 0.6516123149951849, - 0.6642341140864527, - 0.6768559131777205, - 0.6894777122689884, - 0.7020995113602562, - 0.7238128674546157, - 0.7455262235489752, - 0.7783127681601059, - 0.8110993127712365, - 0.8438858573823671, - 0.8766724019934977, - 0.9094589466046283, - 0.942245491215759, - 0.9750320358268896, - 1.0 - ], - [ - -65.0, - -64.18632124787062, - -63.37412627840421, - -61.26744702837232, - -59.16942160833874, - -57.080583970974544, - -53.730051257660435, - -48.73320285657006, - -43.78427161789913, - -38.87489559689218, - -35.86072873050872, - -35.86072873050872, - -35.905437080667824, - -35.94862357435213, - -36.04951236147748, - -36.140534448691284, - -36.21995098660866, - -36.28640319768453, - -36.33868356846626, - -36.395242127118244, - -36.385649479751955, - -36.302023146812715, - -36.13630078715495, - -35.476376110301636, - -34.33400867169064, - -32.622915894466445, - -30.24200806598848, - -28.349610945984633, - -26.108356637122288, - -23.476911880538534, - -18.16832383101533, - -11.501553783837052, - -7.060043936642613, - -2.1658871326786624, - 3.1167629524017313, - 8.667164901684119, - 14.302990988579486, - 19.792611242494218, - 23.390485966864674, - 26.718124053533902, - 29.71320134776253, - 32.33364271530464, - 34.56065987824687, - 36.39829031839922, - 38.61502871326616, - 39.59126444761296, - 40.30109185146664, - 40.79098727697746, - 41.10367999979603, - 41.27633866906626, - 41.33076687954793, - 41.17086391843039, - 40.670458301085205, - 39.962867314939935, - 39.10701234166909, - 38.13383073252198, - 37.06108604570682, - 35.90061431156987, - 34.66119695066269, - 33.66864036827043 - ] - ], - "KSTrans cvode=False single=False": [ - [ - 0.0, - 0.025, - 0.05, - 0.075, - 0.09999999999999999, - 0.12499999999999999, - 0.15, - 0.17500000000000002, - 0.20000000000000004, - 0.22500000000000006, - 0.25000000000000006, - 0.2750000000000001, - 0.3000000000000001, - 0.3250000000000001, - 0.35000000000000014, - 0.37500000000000017, - 0.4000000000000002, - 0.4250000000000002, - 0.45000000000000023, - 0.47500000000000026, - 0.5000000000000002, - 0.5250000000000001, - 0.55, - 0.575, - 0.5999999999999999, - 0.6249999999999998, - 0.6499999999999997, - 0.6749999999999996, - 0.6999999999999995, - 0.7249999999999994, - 0.7499999999999993, - 0.7749999999999992, - 0.7999999999999992, - 0.8249999999999991, - 0.849999999999999, - 0.8749999999999989, - 0.8999999999999988, - 0.9249999999999987, - 0.9499999999999986, - 0.9749999999999985, - 0.9999999999999984 - ], - [ - -65.0, - -57.61698001518964, - -50.350680331662666, - -43.190959064808595, - -36.118349378635024, - -36.45214555816893, - -36.64013375770745, - -36.63901228066678, - -36.40785016818501, - -35.90739311979073, - -35.098342787028955, - -33.938983603152764, - -32.38249620775813, - -30.37433493239779, - -27.85023024839231, - -24.735811936721902, - -20.949673938481457, - -16.41300375864941, - -11.070338662286476, - -4.925845486416181, - 1.9065110859235475, - 9.156953785515793, - 16.396750192384502, - 23.114467243140304, - 28.85862394448292, - 33.36981164763734, - 36.623187926589694, - 38.77284096573438, - 40.05395516480963, - 40.70121687913082, - 40.90634885315981, - 40.808208123873015, - 40.499949593417945, - 40.04123645048496, - 39.469454750133934, - 38.808051820286906, - 38.07208641230601, - 37.271686168441654, - 36.414113931544115, - 35.50497068675557, - 34.54888423211685 - ] ] } diff --git a/test/hoctests/tests/test_kschan.py b/test/hoctests/tests/test_kschan.py index b168f3b2d4..7bda15379f 100644 --- a/test/hoctests/tests/test_kschan.py +++ b/test/hoctests/tests/test_kschan.py @@ -9,6 +9,9 @@ from neuron.expect_hocerr import expect_err from neuron import expect_hocerr + +print("cvode version ", h.cvode.version()) # for coverage + expect_hocerr.quiet = False from neuron.tests.utils.capture_stdout import capture_stdout @@ -68,9 +71,10 @@ def hrun(name, t_tol=0.0, v_tol=0.0, v_tol_per_time=0.0): ref_data = chk.get(name) new_tv, new_vv = trec.to_python(), vrec.to_python() if ref_data is None: - chk("ZZZ" + name, [new_tv, new_vv]) - chk.save() + # comment out Exception if want new reference data raise Exception("No reference data for key: " + name) + chk(name, [new_tv, new_vv]) + return ref_tv, ref_vv = ref_data np.testing.assert_equal(len(ref_tv), len(ref_vv)) np.testing.assert_equal(len(ref_tv), len(new_tv)) @@ -342,7 +346,10 @@ def test_2(): h.cvode_active(1) # At least executes KSChan::mulmat hrun( - "kchan without single cvode=True", t_tol=2e-7, v_tol=1e-11, v_tol_per_time=5e-7 + "kchan without single cvode=True", + t_tol=5e-6, + v_tol=1e-11, + v_tol_per_time=5e-7, ) h.cvode_active(0) diff --git a/test/hoctests/tests/test_neurondemo.json b/test/hoctests/tests/test_neurondemo.json index fba7e8e43d..e994f1005c 100644 --- a/test/hoctests/tests/test_neurondemo.json +++ b/test/hoctests/tests/test_neurondemo.json @@ -9284,5 +9284,1277 @@ } ] ] + ], + "cover3454-cv3": [ + [ + "Graph[0]", + [ + { + "x": [ + "7.5", + "9.81763", + "11.9084", + "13.5676", + "14.6329", + "15", + "14.6329", + "13.5676", + "11.9084", + "9.81763", + "7.5", + "5.18237", + "3.09161", + "1.43237", + "0.367076", + "0", + "0.367076", + "1.43237", + "3.09161", + "5.18237", + "7.5" + ], + "y": [ + "7.5", + "7.13292", + "6.06763", + "4.40839", + "2.31763", + "4.59243e-16", + "-2.31763", + "-4.40839", + "-6.06763", + "-7.13292", + "-7.5", + "-7.13292", + "-6.06763", + "-4.40839", + "-2.31763", + "-1.37773e-15", + "2.31763", + "4.40839", + "6.06763", + "7.13292", + "7.5" + ] + } + ] + ], + [ + "Graph[1]", + [ + { + "x": [ + "0", + "15" + ], + "y": [ + "20", + "0" + ] + } + ] + ], + [ + "Graph[2]", + [] + ], + [ + "Graph[3]", + [ + { + "x": [ + "0", + "0.0005", + "0.001", + "0.002", + "0.004", + "0.008", + "0.016", + "0.032", + "0.064", + "0.128", + "0.256", + "0.384", + "0.5", + "0.5", + "0.500003", + "0.500006", + "0.500012", + "0.500025", + "0.500049", + "0.500099", + "0.500198", + "0.500396", + "0.500792", + "0.501583", + "0.503166", + "0.506333", + "0.512666", + "0.525332", + "0.537998", + "0.550664", + "0.56333", + "0.575996", + "0.588662", + "0.6", + "0.6", + "0.60006", + "0.600121", + "0.600241", + "0.600482", + "0.600964", + "0.601929", + "0.603857", + "0.607715", + "0.61543", + "0.623144", + "0.630859", + "0.638574", + "0.654004", + "0.669433", + "0.684863", + "0.700293", + "0.715722", + "0.723437", + "0.738867", + "0.754296", + "0.769726", + "0.785156", + "0.800585", + "0.816015", + "0.831445", + "0.846874", + "0.862304", + "0.877734", + "0.893163", + "0.908593", + "0.924022", + "0.937752", + "0.94717", + "0.956588", + "0.966006", + "0.975424", + "0.9839", + "0.992376", + "1.00085", + "1.00933", + "1.0178", + "1.02628", + "1.03476", + "1.04323", + "1.05171", + "1.06018", + "1.06866", + "1.07714", + "1.08561", + "1.09409", + "1.10256", + "1.11104", + "1.11952", + "1.12799", + "1.13647", + "1.14494", + "1.1619", + "1.17705", + "1.1922", + "1.20583", + "1.21946", + "1.2331", + "1.24673", + "1.26037", + "1.274", + "1.28764", + "1.30127", + "1.3149", + "1.32854", + "1.35581", + "1.38035", + "1.40489", + "1.42943", + "1.45397", + "1.47852", + "1.50306", + "1.5276", + "1.57668", + "1.62577", + "1.67485", + "1.72393", + "1.76746", + "1.81099", + "1.85016", + "1.88934", + "1.92851", + "1.96769", + "2.00686", + "2.04604", + "2.08521", + "2.12439", + "2.20273", + "2.28108", + "2.35943", + "2.43778", + "2.51613", + "2.58502", + "2.6539", + "2.72279", + "2.78479", + "2.84058", + "2.89638", + "2.9466", + "2.99682", + "3.04201", + "3.08721", + "3.13241", + "3.1776", + "3.2228", + "3.25048", + "3.27816", + "3.29866", + "3.31915", + "3.33965", + "3.36014", + "3.38064", + "3.40114", + "3.42163", + "3.44213", + "3.46263", + "3.48312", + "3.50362", + "3.52412", + "3.54461", + "3.56511", + "3.5856", + "3.6061", + "3.6266", + "3.64709", + "3.66759", + "3.67784", + "3.69833", + "3.71883", + "3.73933", + "3.75982", + "3.78032", + "3.80082", + "3.81106", + "3.83156", + "3.85206", + "3.87255", + "3.89305", + "3.91355", + "3.95454", + "3.99553", + "4.03652", + "4.07752", + "4.11851", + "4.1595", + "4.2005", + "4.24149", + "4.32347", + "4.40546", + "4.48744", + "4.56943", + "4.65142", + "4.81539", + "4.97936", + "5", + "5" + ], + "y": [ + "-65", + "-64.9997", + "-64.9993", + "-64.9986", + "-64.9973", + "-64.9946", + "-64.9892", + "-64.9785", + "-64.9574", + "-64.9163", + "-64.8379", + "-64.7635", + "-64.6994", + "-64.6994", + "-64.6985", + "-64.6976", + "-64.6957", + "-64.692", + "-64.6846", + "-64.6697", + "-64.64", + "-64.5805", + "-64.4616", + "-64.2239", + "-63.7488", + "-62.8002", + "-60.9092", + "-57.1506", + "-53.4226", + "-49.7241", + "-46.0529", + "-42.4064", + "-38.7813", + "-35.5498", + "-35.5498", + "-35.5507", + "-35.5516", + "-35.5535", + "-35.5572", + "-35.5646", + "-35.5792", + "-35.6079", + "-35.6632", + "-35.7646", + "-35.8527", + "-35.9262", + "-35.9837", + "-36.0457", + "-36.0274", + "-35.9181", + "-35.7071", + "-35.3839", + "-35.1769", + "-34.6654", + "-34.0142", + "-33.2119", + "-32.245", + "-31.0989", + "-29.757", + "-28.2013", + "-26.4115", + "-24.3658", + "-22.0403", + "-19.411", + "-16.4546", + "-13.1533", + "-9.91508", + "-7.52937", + "-5.01414", + "-2.37644", + "0.372735", + "2.92965", + "5.54983", + "8.21524", + "10.9047", + "13.5942", + "16.2579", + "18.8684", + "21.398", + "23.8202", + "26.111", + "28.2498", + "30.2204", + "32.0118", + "33.6181", + "35.0387", + "36.2777", + "37.3431", + "38.2457", + "38.999", + "39.6172", + "40.5082", + "40.9905", + "41.2492", + "41.3374", + "41.3218", + "41.2267", + "41.0698", + "40.8638", + "40.6177", + "40.338", + "40.0294", + "39.6954", + "39.3384", + "38.5624", + "37.8007", + "36.9851", + "36.1202", + "35.2097", + "34.2569", + "33.2653", + "32.2381", + "30.0891", + "27.8321", + "25.4859", + "23.0725", + "20.893", + "18.6855", + "16.6807", + "14.6656", + "12.6472", + "10.6306", + "8.61962", + "6.61758", + "4.62731", + "2.65129", + "-1.25084", + "-5.07875", + "-8.82862", + "-12.4998", + "-16.0976", + "-19.2076", + "-22.2772", + "-25.3205", + "-28.0546", + "-30.5277", + "-33.0317", + "-35.3311", + "-37.6963", + "-39.9012", + "-42.2007", + "-44.6155", + "-47.1665", + "-49.8689", + "-51.5991", + "-53.3862", + "-54.7422", + "-56.1219", + "-57.5197", + "-58.9281", + "-60.3378", + "-61.738", + "-63.1159", + "-64.4579", + "-65.75", + "-66.979", + "-68.1327", + "-69.2009", + "-70.1765", + "-71.0556", + "-71.8373", + "-72.5238", + "-73.1199", + "-73.632", + "-74.0679", + "-74.2599", + "-74.5972", + "-74.8792", + "-75.1133", + "-75.3068", + "-75.466", + "-75.5964", + "-75.6524", + "-75.7485", + "-75.8266", + "-75.8896", + "-75.9402", + "-75.9806", + "-76.0377", + "-76.0719", + "-76.0901", + "-76.0974", + "-76.0971", + "-76.0917", + "-76.0825", + "-76.0707", + "-76.0413", + "-76.0078", + "-75.9713", + "-75.933", + "-75.8929", + "-75.8081", + "-75.7179", + "-75.7062", + "-75.7062" + ] + } + ] + ], + [ + "Graph[4]", + [ + { + "x": [ + "0", + "0.0005", + "0.001", + "0.002", + "0.004", + "0.008", + "0.016", + "0.032", + "0.064", + "0.128", + "0.256", + "0.384", + "0.5", + "0.5", + "0.500003", + "0.500006", + "0.500012", + "0.500025", + "0.500049", + "0.500099", + "0.500198", + "0.500396", + "0.500792", + "0.501583", + "0.503166", + "0.506333", + "0.512666", + "0.525332", + "0.537998", + "0.550664", + "0.56333", + "0.575996", + "0.588662", + "0.6", + "0.6", + "0.60006", + "0.600121", + "0.600241", + "0.600482", + "0.600964", + "0.601929", + "0.603857", + "0.607715", + "0.61543", + "0.623144", + "0.630859", + "0.638574", + "0.654004", + "0.669433", + "0.684863", + "0.700293", + "0.715722", + "0.723437", + "0.738867", + "0.754296", + "0.769726", + "0.785156", + "0.800585", + "0.816015", + "0.831445", + "0.846874", + "0.862304", + "0.877734", + "0.893163", + "0.908593", + "0.924022", + "0.937752", + "0.94717", + "0.956588", + "0.966006", + "0.975424", + "0.9839", + "0.992376", + "1.00085", + "1.00933", + "1.0178", + "1.02628", + "1.03476", + "1.04323", + "1.05171", + "1.06018", + "1.06866", + "1.07714", + "1.08561", + "1.09409", + "1.10256", + "1.11104", + "1.11952", + "1.12799", + "1.13647", + "1.14494", + "1.1619", + "1.17705", + "1.1922", + "1.20583", + "1.21946", + "1.2331", + "1.24673", + "1.26037", + "1.274", + "1.28764", + "1.30127", + "1.3149", + "1.32854", + "1.35581", + "1.38035", + "1.40489", + "1.42943", + "1.45397", + "1.47852", + "1.50306", + "1.5276", + "1.57668", + "1.62577", + "1.67485", + "1.72393", + "1.76746", + "1.81099", + "1.85016", + "1.88934", + "1.92851", + "1.96769", + "2.00686", + "2.04604", + "2.08521", + "2.12439", + "2.20273", + "2.28108", + "2.35943", + "2.43778", + "2.51613", + "2.58502", + "2.6539", + "2.72279", + "2.78479", + "2.84058", + "2.89638", + "2.9466", + "2.99682", + "3.04201", + "3.08721", + "3.13241", + "3.1776", + "3.2228", + "3.25048", + "3.27816", + "3.29866", + "3.31915", + "3.33965", + "3.36014", + "3.38064", + "3.40114", + "3.42163", + "3.44213", + "3.46263", + "3.48312", + "3.50362", + "3.52412", + "3.54461", + "3.56511", + "3.5856", + "3.6061", + "3.6266", + "3.64709", + "3.66759", + "3.67784", + "3.69833", + "3.71883", + "3.73933", + "3.75982", + "3.78032", + "3.80082", + "3.81106", + "3.83156", + "3.85206", + "3.87255", + "3.89305", + "3.91355", + "3.95454", + "3.99553", + "4.03652", + "4.07752", + "4.11851", + "4.1595", + "4.2005", + "4.24149", + "4.32347", + "4.40546", + "4.48744", + "4.56943", + "4.65142", + "4.81539", + "4.97936", + "5", + "5" + ], + "y": [ + "-0.00122006", + "-0.00122005", + "-0.00122005", + "-0.00122005", + "-0.00122004", + "-0.00122004", + "-0.0012201", + "-0.00122044", + "-0.00122193", + "-0.00122721", + "-0.00124484", + "-0.001272", + "-0.00129415", + "-0.00129389", + "-0.00129388", + "-0.00129387", + "-0.00129385", + "-0.00129381", + "-0.00129373", + "-0.00129358", + "-0.00129328", + "-0.00129269", + "-0.00129157", + "-0.00128961", + "-0.00128675", + "-0.0012852", + "-0.00129904", + "-0.00139942", + "-0.00158806", + "-0.00192218", + "-0.00245798", + "-0.00337644", + "-0.00454761", + "-0.00623062", + "-0.00623105", + "-0.00624237", + "-0.00625369", + "-0.0062764", + "-0.00632183", + "-0.00641355", + "-0.00659888", + "-0.00697885", + "-0.00777483", + "-0.0095121", + "-0.0114431", + "-0.0135686", + "-0.0158881", + "-0.0211058", + "-0.0270857", + "-0.0338229", + "-0.0413254", + "-0.0496067", + "-0.0540713", + "-0.0635913", + "-0.0740068", + "-0.0853591", + "-0.0978236", + "-0.111498", + "-0.126593", + "-0.143114", + "-0.161369", + "-0.181459", + "-0.203541", + "-0.227665", + "-0.2538", + "-0.281495", + "-0.307313", + "-0.325078", + "-0.342619", + "-0.359623", + "-0.375577", + "-0.388623", + "-0.400112", + "-0.409584", + "-0.416697", + "-0.421157", + "-0.422702", + "-0.421333", + "-0.417", + "-0.409913", + "-0.400382", + "-0.388845", + "-0.375839", + "-0.361939", + "-0.347748", + "-0.333823", + "-0.320658", + "-0.30866", + "-0.298126", + "-0.28925", + "-0.282124", + "-0.273084", + "-0.270402", + "-0.271994", + "-0.276332", + "-0.282816", + "-0.290919", + "-0.300234", + "-0.310448", + "-0.321332", + "-0.332715", + "-0.344469", + "-0.356503", + "-0.368745", + "-0.393663", + "-0.416366", + "-0.439136", + "-0.461855", + "-0.484379", + "-0.506625", + "-0.528485", + "-0.549865", + "-0.590871", + "-0.629044", + "-0.663881", + "-0.69534", + "-0.720082", + "-0.741584", + "-0.758319", + "-0.772556", + "-0.784315", + "-0.79363", + "-0.800564", + "-0.8052", + "-0.807635", + "-0.807954", + "-0.80267", + "-0.790175", + "-0.771305", + "-0.746869", + "-0.717555", + "-0.688235", + "-0.655966", + "-0.620958", + "-0.587117", + "-0.554804", + "-0.520585", + "-0.487986", + "-0.453476", + "-0.420594", + "-0.38573", + "-0.348846", + "-0.309763", + "-0.268714", + "-0.243014", + "-0.216577", + "-0.197124", + "-0.177606", + "-0.158385", + "-0.13961", + "-0.121508", + "-0.104298", + "-0.0882151", + "-0.0734299", + "-0.0601245", + "-0.0483961", + "-0.0382935", + "-0.0297912", + "-0.0227973", + "-0.0171856", + "-0.0127765", + "-0.00938342", + "-0.0068186", + "-0.00491227", + "-0.00351589", + "-0.0029647", + "-0.00210875", + "-0.00149261", + "-0.00106386", + "-0.000761111", + "-0.000545884", + "-0.000393134", + "-0.000332028", + "-0.000241718", + "-0.000176532", + "-0.000134723", + "-0.00010095", + "-7.73063e-05", + "-4.64669e-05", + "-3.07062e-05", + "-2.69667e-05", + "-1.86618e-05", + "-1.37453e-05", + "-1.06997e-05", + "-9.26814e-06", + "-8.66929e-06", + "-7.94314e-06", + "-7.68307e-06", + "-7.54107e-06", + "-7.61333e-06", + "-7.89026e-06", + "-8.5335e-06", + "-9.50285e-06", + "-9.62e-06", + "-9.62e-06" + ] + }, + { + "x": [ + "0", + "0.0005", + "0.001", + "0.002", + "0.004", + "0.008", + "0.016", + "0.032", + "0.064", + "0.128", + "0.256", + "0.384", + "0.5", + "0.5", + "0.500003", + "0.500006", + "0.500012", + "0.500025", + "0.500049", + "0.500099", + "0.500198", + "0.500396", + "0.500792", + "0.501583", + "0.503166", + "0.506333", + "0.512666", + "0.525332", + "0.537998", + "0.550664", + "0.56333", + "0.575996", + "0.588662", + "0.6", + "0.6", + "0.60006", + "0.600121", + "0.600241", + "0.600482", + "0.600964", + "0.601929", + "0.603857", + "0.607715", + "0.61543", + "0.623144", + "0.630859", + "0.638574", + "0.654004", + "0.669433", + "0.684863", + "0.700293", + "0.715722", + "0.723437", + "0.738867", + "0.754296", + "0.769726", + "0.785156", + "0.800585", + "0.816015", + "0.831445", + "0.846874", + "0.862304", + "0.877734", + "0.893163", + "0.908593", + "0.924022", + "0.937752", + "0.94717", + "0.956588", + "0.966006", + "0.975424", + "0.9839", + "0.992376", + "1.00085", + "1.00933", + "1.0178", + "1.02628", + "1.03476", + "1.04323", + "1.05171", + "1.06018", + "1.06866", + "1.07714", + "1.08561", + "1.09409", + "1.10256", + "1.11104", + "1.11952", + "1.12799", + "1.13647", + "1.14494", + "1.1619", + "1.17705", + "1.1922", + "1.20583", + "1.21946", + "1.2331", + "1.24673", + "1.26037", + "1.274", + "1.28764", + "1.30127", + "1.3149", + "1.32854", + "1.35581", + "1.38035", + "1.40489", + "1.42943", + "1.45397", + "1.47852", + "1.50306", + "1.5276", + "1.57668", + "1.62577", + "1.67485", + "1.72393", + "1.76746", + "1.81099", + "1.85016", + "1.88934", + "1.92851", + "1.96769", + "2.00686", + "2.04604", + "2.08521", + "2.12439", + "2.20273", + "2.28108", + "2.35943", + "2.43778", + "2.51613", + "2.58502", + "2.6539", + "2.72279", + "2.78479", + "2.84058", + "2.89638", + "2.9466", + "2.99682", + "3.04201", + "3.08721", + "3.13241", + "3.1776", + "3.2228", + "3.25048", + "3.27816", + "3.29866", + "3.31915", + "3.33965", + "3.36014", + "3.38064", + "3.40114", + "3.42163", + "3.44213", + "3.46263", + "3.48312", + "3.50362", + "3.52412", + "3.54461", + "3.56511", + "3.5856", + "3.6061", + "3.6266", + "3.64709", + "3.66759", + "3.67784", + "3.69833", + "3.71883", + "3.73933", + "3.75982", + "3.78032", + "3.80082", + "3.81106", + "3.83156", + "3.85206", + "3.87255", + "3.89305", + "3.91355", + "3.95454", + "3.99553", + "4.03652", + "4.07752", + "4.11851", + "4.1595", + "4.2005", + "4.24149", + "4.32347", + "4.40546", + "4.48744", + "4.56943", + "4.65142", + "4.81539", + "4.97936", + "5", + "5" + ], + "y": [ + "0.00186994", + "0.00186994", + "0.00186993", + "0.00186992", + "0.0018699", + "0.00186987", + "0.00186988", + "0.00187011", + "0.00187139", + "0.00187626", + "0.00189311", + "0.00191952", + "0.00194102", + "0.00194077", + "0.00194075", + "0.00194073", + "0.00194069", + "0.00194061", + "0.00194046", + "0.00194016", + "0.00193956", + "0.00193837", + "0.00193607", + "0.00193173", + "0.00192412", + "0.00191309", + "0.00190801", + "0.00197081", + "0.00212216", + "0.00241927", + "0.00291833", + "0.00380027", + "0.00493512", + "0.00658572", + "0.00658615", + "0.00659747", + "0.0066088", + "0.00663153", + "0.00667699", + "0.00676879", + "0.00695425", + "0.00733448", + "0.00813097", + "0.00986915", + "0.0118009", + "0.013927", + "0.0162469", + "0.0214649", + "0.0274443", + "0.03418", + "0.0416799", + "0.0499575", + "0.0544197", + "0.0639341", + "0.0743424", + "0.085686", + "0.0981401", + "0.111802", + "0.126883", + "0.143387", + "0.161624", + "0.181692", + "0.203749", + "0.227845", + "0.253949", + "0.28161", + "0.307394", + "0.325133", + "0.342648", + "0.359625", + "0.375551", + "0.38857", + "0.400032", + "0.409476", + "0.416563", + "0.420995", + "0.422514", + "0.421118", + "0.41676", + "0.40965", + "0.400097", + "0.388538", + "0.375514", + "0.361597", + "0.347391", + "0.333452", + "0.320276", + "0.308267", + "0.297726", + "0.288842", + "0.281711", + "0.272662", + "0.269976", + "0.271565", + "0.275902", + "0.282386", + "0.290489", + "0.299805", + "0.310021", + "0.320906", + "0.332291", + "0.344048", + "0.356084", + "0.368329", + "0.393253", + "0.415962", + "0.438739", + "0.461466", + "0.483997", + "0.506252", + "0.52812", + "0.549509", + "0.590534", + "0.628727", + "0.663586", + "0.695067", + "0.719829", + "0.741352", + "0.758106", + "0.772363", + "0.784141", + "0.793475", + "0.800429", + "0.805085", + "0.807539", + "0.807878", + "0.802633", + "0.790177", + "0.771347", + "0.746948", + "0.717672", + "0.688385", + "0.656149", + "0.621173", + "0.587362", + "0.555075", + "0.520884", + "0.48831", + "0.453825", + "0.420967", + "0.386128", + "0.34927", + "0.310216", + "0.269197", + "0.243515", + "0.217098", + "0.197659", + "0.178157", + "0.158951", + "0.140191", + "0.122104", + "0.104909", + "0.0888409", + "0.0740699", + "0.0607783", + "0.0490629", + "0.0389725", + "0.0304814", + "0.0234977", + "0.0178951", + "0.0134941", + "0.010108", + "0.00754934", + "0.00564825", + "0.00425631", + "0.00370708", + "0.00285455", + "0.00224127", + "0.00181488", + "0.00151409", + "0.00130047", + "0.00114903", + "0.00108849", + "0.000999143", + "0.000934741", + "0.000893565", + "0.000860301", + "0.000837062", + "0.000806796", + "0.000791377", + "0.00078782", + "0.000779589", + "0.00077467", + "0.00077157", + "0.000770047", + "0.00076933", + "0.00076831", + "0.000767715", + "0.000767209", + "0.000766897", + "0.000766773", + "0.000766569", + "0.000766636", + "0.000766636", + "0.000766636" + ] + } + ] + ] ] } diff --git a/test/hoctests/tests/test_neurondemo.py b/test/hoctests/tests/test_neurondemo.py index 6e1d14c3ae..5be6ef0cca 100644 --- a/test/hoctests/tests/test_neurondemo.py +++ b/test/hoctests/tests/test_neurondemo.py @@ -2,7 +2,7 @@ import sys import warnings -from neuron import config +from neuron import config, n from neuron.tests.utils.checkresult import Chk from neuron.tests.utils import get_c_compiler @@ -196,7 +196,12 @@ def special_run(key, demo_index, pre_run_stmts): # For full coverage of #3454, do another run of Dynamic Clamp with cvode active. -special_run("cover3454", 6, "cvode_active(1)") +cover3454 = "cover3454" # for old cvode version 2 +cv = n.CVode() +if hasattr(cv, "version"): + cover3454 += f"-cv{cv.version()[0]}" +print(f"special_run for key {cover3454}") +special_run(cover3454, 6, "cvode_active(1)") chk.save() diff --git a/test/nmodl/transpiler/usecases/matexp/simulate.py b/test/nmodl/transpiler/usecases/matexp/simulate.py index 7c7c0e94ab..493461c13a 100644 --- a/test/nmodl/transpiler/usecases/matexp/simulate.py +++ b/test/nmodl/transpiler/usecases/matexp/simulate.py @@ -6,6 +6,7 @@ * A modified HH model solved by MATEXP, where each gate (M, H, N) is replaced by an equivalent two state Markov model. """ + import numpy as np from neuron import gui, h diff --git a/test/pytest/test_nrntest_thread.py b/test/pytest/test_nrntest_thread.py index c86d5ca5fb..2c5c601ee6 100644 --- a/test/pytest/test_nrntest_thread.py +++ b/test/pytest/test_nrntest_thread.py @@ -2,6 +2,7 @@ Tests that used to live in the thread/ subdirectory of the https://github.com/neuronsimulator/nrntest repository """ + import os import pytest from neuron import h diff --git a/test/pytest_coreneuron/test_nrntest_fast.json b/test/pytest_coreneuron/test_nrntest_fast.json index 120ba7f06a..16a1873c4d 100644 --- a/test/pytest_coreneuron/test_nrntest_fast.json +++ b/test/pytest_coreneuron/test_nrntest_fast.json @@ -1231,391 +1231,389 @@ 0.0, 0.0021782700426607325, 0.004356540085321465, - 0.010144251315598807, - 0.01593196254587615, - 0.021719673776153494, - 0.030707749283625962, - 0.05122171773865329, - 0.07173568619368062, - 0.0808866402279297, - 0.09003759426217878, - 0.09918854829642786, + 0.009209371054258113, + 0.014062202023194761, + 0.01891503299213141, + 0.0271456900080463, + 0.045898929346240944, + 0.06465216868443559, + 0.07455914596408417, + 0.08446612324373275, + 0.09437310052338133, 0.09999999999999779, 0.10000000000000112, - 0.1000030830871392, - 0.10341300090558016, - 0.10987369384046246, - 0.11633438677534476, - 0.12279507971022706, - 0.12925577264510935, - 0.13571646557999165, - 0.14217715851487395, - 0.14863785144975625, - 0.15509854438463855, - 0.16155923731952085, - 0.1720481181210025, - 0.18253699892248418, - 0.19302587972396584, + 0.10000308344162252, + 0.10341132548916554, + 0.10987517599504681, + 0.11633902650092809, + 0.12280287700680936, + 0.12926672751269064, + 0.1357305780185719, + 0.1421944285244532, + 0.14865827903033446, + 0.15859246600409055, + 0.16852665297784664, + 0.17846083995160272, + 0.1883950269253588, + 0.1983292138991149, 0.19999999999999557, 0.20000000000000223, - 0.20091543391452527, - 0.2018308678290483, - 0.20361444233935574, - 0.2053980168496632, - 0.20718159135997063, - 0.21019561637880158, - 0.21320964139763252, - 0.21782485556023548, - 0.22244006972283845, - 0.2270552838854414, - 0.23167049804804438, - 0.23628571221064734, - 0.2432342358268311, - 0.2501827594430149, - 0.25713128305919863, - 0.2640798066753824, - 0.27102833029156614, - 0.2779768539077499, - 0.28492537752393365, - 0.2918739011401174, - 0.29882242475630116, + 0.20091547395172407, + 0.2018309479034459, + 0.20365904368137847, + 0.20548713945931102, + 0.20731523523724357, + 0.21033704645190943, + 0.21335885766657528, + 0.21798208768281976, + 0.22260531769906425, + 0.22722854771530873, + 0.23185177773155322, + 0.2364750077477977, + 0.24109823776404218, + 0.24985908653267958, + 0.25861993530131694, + 0.2673807840699543, + 0.27614163283859167, + 0.28490248160722903, + 0.2936633303758664, 0.2999999999999934, 0.3000000000000034, - 0.3006724199444088, - 0.3013448398888142, - 0.30283678825998744, - 0.30432873663116067, - 0.3058206850023339, - 0.3082167723871527, - 0.3121724011518111, - 0.3161280299164695, - 0.32008365868112787, - 0.32403928744578625, - 0.32799491621044463, - 0.33406178151604055, - 0.34012864682163646, - 0.3461955121272324, - 0.3522623774328283, - 0.3621397656783724, - 0.37201715392391654, - 0.38189454216946067, - 0.3917719304150048, - 0.4016493186605489, - 0.41152670690609305, - 0.4214040951516372, - 0.4312814833971813, - 0.44115887164272544, - 0.45103625988826956, - 0.4609136481338137, - 0.4707910363793578, - 0.48066842462490195, - 0.4905458128704461, - 0.5004232011159901, - 0.5103005893615342, - 0.5265337093780071, - 0.5427668293944801, - 0.558999949410953, - 0.5752330694274259, - 0.5914661894438988, - 0.6076993094603718, - 0.6239324294768447, - 0.6401655494933176, - 0.6563986695097905, - 0.6726317895262635, - 0.6888649095427364, - 0.7050980295592093, - 0.7213311495756822, - 0.7375642695921552, - 0.7537973896086281, - 0.770030509625101, - 0.7888841100590429, - 0.8017808793880951, - 0.8146776487171472, - 0.8275744180461994, - 0.8404711873752515, - 0.8533679567043037, - 0.8662647260333558, - 0.879161495362408, - 0.8920582646914601, - 0.9049550340205123, - 0.9294182305234298, - 0.9462090502315512, - 0.9629998699396727, - 0.9797906896477941, - 0.9965815093559156, - 1.013372329064037, - 1.0301631487721585, - 1.04695396848028, - 1.0806240181616504, - 1.101525991887505, - 1.1224279656133598, - 1.1433299393392145, - 1.1642319130650691, - 1.1851338867909238, - 1.2060358605167785, - 1.2631747851334303, - 1.320313709750082, - 1.377452634366734, - 1.4345915589833858, - 1.4684901834585067, - 1.5023888079336276, - 1.5362874324087485, - 1.5880903612542963, - 1.639893290099844, - 1.6916962189453917, - 1.7434991477909394, - 1.795302076636487, - 1.8471050054820348, - 1.8989079343275825, - 1.9507108631731302, - 2.0363633202090647, - 2.1220157772449992, - 2.2076682342809337, - 2.293320691316868, - 2.3789731483528027, - 2.464625605388737, - 2.5502780624246717, - 2.5940840186421377, - 2.6378899748596036, - 2.6816959310770696, - 2.7255018872945356, - 2.7693078435120015, - 2.8131137997294675, - 2.8418960304239897, - 2.870678261118512, - 2.8994604918130342, - 2.9282427225075565, - 2.9570249532020787, - 2.985807183896601, - 3.014589414591123, - 3.0433716452856454, - 3.0721538759801676, - 3.10093610667469, - 3.129718337369212, - 3.1585005680637344, - 3.1872827987582566, - 3.216065029452779, - 3.244847260147301, - 3.2736294908418233, - 3.3024117215363455, - 3.331193952230868, - 3.35997618292539, - 3.3887584136199123, - 3.4175406443144345, - 3.4463228750089567, - 3.475105105703479, - 3.503887336398001, - 3.5326695670925234, - 3.5787938424354193, - 3.6668895202843714, - 3.720654541316907, - 3.7744195623494425, - 3.828184583381978, - 3.8819496044145136, - 3.935714625447049, - 3.9894796464795848, - 4.04324466751212, - 4.124178086535243, - 4.300674919360661, - 4.47717175218608, - 4.6536685850114985, - 4.830165417836917, + 0.30067267332400544, + 0.3013453466480075, + 0.3028276792272832, + 0.3043100118065589, + 0.30579234438583464, + 0.3081893334358465, + 0.31213534228058365, + 0.3160813511253208, + 0.320027359970058, + 0.32397336881479516, + 0.32791937765953233, + 0.3339762759614212, + 0.3400331742633101, + 0.34609007256519897, + 0.35214697086708785, + 0.362109096180154, + 0.3720712214932202, + 0.38203334680628637, + 0.39199547211935254, + 0.4019575974324187, + 0.4119197227454849, + 0.42188184805855106, + 0.43184397337161723, + 0.4418060986846834, + 0.4517682239977496, + 0.46173034931081575, + 0.4716924746238819, + 0.4816545999369481, + 0.49161672525001426, + 0.5015788505630805, + 0.5115409758761467, + 0.5283037938614952, + 0.5450666118468437, + 0.5618294298321922, + 0.5785922478175407, + 0.5953550658028892, + 0.6121178837882377, + 0.6288807017735862, + 0.6456435197589347, + 0.6624063377442833, + 0.6791691557296318, + 0.6959319737149803, + 0.7126947917003288, + 0.7294576096856773, + 0.7462204276710258, + 0.7629832456563743, + 0.7797460636417228, + 0.7965088816270713, + 0.8132716996124199, + 0.8300345175977684, + 0.8467973355831169, + 0.8635601535684654, + 0.8803229715538139, + 0.8970857895391624, + 0.9138486075245109, + 0.9306114255098594, + 0.9473742434952079, + 0.9641370614805564, + 0.980899879465905, + 0.9976626974512535, + 1.014425515436602, + 1.0311883334219505, + 1.047951151407299, + 1.0647139693926475, + 1.081476787377996, + 1.0982396053633445, + 1.115002423348693, + 1.1423681390229952, + 1.1697338546972973, + 1.1970995703715994, + 1.2389386448914943, + 1.2807777194113892, + 1.322616793931284, + 1.364455868451179, + 1.4428816572707979, + 1.5213074460904168, + 1.5409138932953215, + 1.5605203405002261, + 1.5801267877051308, + 1.5997332349100355, + 1.6193396821149402, + 1.6389461293198448, + 1.6585525765247495, + 1.688127712376697, + 1.7177028482286443, + 1.7472779840805917, + 1.776853119932539, + 1.8550670616609963, + 1.9332810033894536, + 2.011494945117911, + 2.0897088868463682, + 2.1679228285748255, + 2.246136770303283, + 2.32435071203174, + 2.4025646537601975, + 2.4807785954886548, + 2.5322643078588487, + 2.5837500202290427, + 2.6352357325992366, + 2.6867214449694306, + 2.7382071573396245, + 2.7896928697098184, + 2.822359545726363, + 2.855026221742907, + 2.8876928977594516, + 2.920359573775996, + 2.9530262497925404, + 2.9856929258090847, + 3.018359601825629, + 3.0510262778421735, + 3.083692953858718, + 3.1163596298752623, + 3.1490263058918067, + 3.181692981908351, + 3.2143596579248954, + 3.24702633394144, + 3.279693009957984, + 3.3123596859745286, + 3.345026361991073, + 3.3776930380076173, + 3.4103597140241617, + 3.443026390040706, + 3.4756930660572505, + 3.508359742073795, + 3.5410264180903392, + 3.5736930941068836, + 3.6446252167239312, + 3.715557339340979, + 3.7643433642244144, + 3.81312938910785, + 3.8619154139912855, + 3.910701438874721, + 4.007774041380115, + 4.104846643885509, + 4.2019192463909025, + 4.298991848896296, + 4.39606445140169, + 4.550802142359061, + 4.705539833316433, + 4.940497460263208, 5.0 ], "v": [ -65.0, -64.56491841217131, - -64.13047441574555, - -62.979092343123334, - -61.831607924739316, - -60.68827674297587, - -58.92103363510366, - -54.92375017900241, - -50.973908608624996, - -49.2264370884664, - -47.48686552240552, - -45.75433415039267, - -45.601038475236415, - -45.601038475236415, - -45.601072745131084, - -45.638130498525264, - -45.70617945227868, - -45.77124585779919, - -45.83290491634737, - -45.89087657471256, - -45.944935682949115, - -45.99487891278728, - -46.04051888524377, - -46.08167351036362, - -46.118167695045166, - -46.16705171835679, - -46.20256045470219, - -46.224037336567356, - -46.230230613964935, - -46.230230613964935, - -46.230494285878905, - -46.23064239750441, - -46.230637899049924, - -46.23023997018535, - -46.229413691574194, - -46.227002950480575, - -46.22330562884593, - -46.21511474611184, - -46.20382261388709, - -46.18938090382252, - -46.17174226581886, - -46.150860878503174, - -46.11320760955837, - -46.06795004273756, - -46.01493607846521, - -45.95401304314769, - -45.88502664449565, - -45.8078201746416, - -45.72223337637713, - -45.62810149405568, - -45.52525420872345, - -45.50694858033008, - -45.50694858033008, - -45.4963390244899, - -45.48564568956203, - -45.46164381059611, - -45.43727287824812, - -45.41250060162046, - -45.37184414818531, - -45.30234261498873, - -45.229843427266104, - -45.15430928937392, - -45.07570125786701, - -44.993979822016975, - -44.86249817052013, - -44.72345590285087, - -44.57669103606135, - -44.422031007181886, - -44.152867963565704, - -43.86147005503628, - -43.546941506041286, - -43.20829638254428, - -42.84445419722465, - -42.45422671263541, - -42.03630788399533, - -41.58926324080337, - -41.111517356059665, - -40.601340154765765, - -40.05683227340834, - -39.47590945271688, - -38.85628590719713, - -38.195456679601996, - -37.490679071443395, - -36.73895333287058, - -35.39266558965004, - -33.89429330292143, - -32.225280002245995, - -30.364330214831124, - -28.287490748033445, - -25.968426423568946, - -23.378917200275435, - -20.489893822173013, - -17.273422872660895, - -13.706034822818545, - -9.773760279052073, - -5.4790768699063825, - -0.8494521638185585, - 4.05385008252182, - 9.129405750087422, - 14.235520893137908, - 19.977519982636203, - 23.646537082423045, - 27.009665418755183, - 30.00417953618642, - 32.59131478404075, - 34.7583498141366, - 36.51707332716974, - 37.89882371948951, - 38.947556212654376, - 39.712808138252285, - 40.554389463503696, - 40.797568675778514, - 40.85377304310056, - 40.770913998919035, - 40.583512132287744, - 40.318414626179, - 39.994386060628834, - 39.62229379485234, - 38.76055557044039, - 38.15464000204507, - 37.5023667641635, - 36.81019779907539, - 36.08169965311572, - 35.318761976589734, - 34.52326788527531, - 32.20042123421218, - 29.691885541967906, - 27.03665549907234, - 24.27944041070187, - 22.59819391250315, - 20.89136298531992, - 19.167997259053582, - 16.512865630140524, - 13.843798281483735, - 11.172329550211163, - 8.507589330193415, - 5.85795732020734, - 3.2304779076587997, - 0.6304139112345526, - -1.938614723270085, - -6.112794303285554, - -10.191852513728364, - -14.178505570798894, - -18.080804710596247, - -21.915856103244206, - -25.70671634357704, - -29.492965190350247, - -31.44629422174416, - -33.42417648917125, - -35.43796510044725, - -37.50173275277506, - -39.63250568972405, - -41.84950149285415, - -43.36260865334462, - -44.926715948812465, - -46.54686766159145, - -48.227410478986705, - -49.97122599579679, - -51.778823394294754, - -53.64733468113374, - -55.569388431491596, - -57.531929767480456, - -59.51523957665616, - -61.492555144250815, - -63.43074724299252, - -65.29241123984735, - -67.03941988222819, - -68.6374611133183, - -70.06053505589196, - -71.29415513613036, - -72.33633715678467, - -73.19625082660887, - -73.89121023755713, - -74.44307229394776, - -74.8749941888778, - -75.20908016167212, - -75.46501245828075, - -75.65948757289976, - -75.87626970801635, - -76.09233135041075, - -76.14947750422762, - -76.17548407808935, - -76.18321216110344, - -76.18023796438403, - -76.17061951434953, - -76.1565844886163, - -76.13953945793956, - -76.11012674702752, - -76.03599142454703, - -75.95510559127779, - -75.86984619413361, - -75.77930480051468, - -75.68652448122042 + -64.1304710891133, + -63.16467173624995, + -62.201617706894304, + -61.24150506520784, + -59.61990067100001, + -55.955872234756185, + -52.33254787821945, + -50.43404028315241, + -48.54529550970171, + -46.66539600412285, + -45.60130305983913, + -45.60130305983913, + -45.60133734328116, + -45.638388458037916, + -45.706521240511705, + -45.77166003033151, + -45.83337961987645, + -45.89140372067826, + -45.94550981181184, + -45.99549730464836, + -46.04117692100663, + -46.10257282386708, + -46.15277992976128, + -46.19119033791422, + -46.21721849617898, + -46.230317198198755, + -46.23121180371715, + -46.23121180371715, + -46.23148243995393, + -46.23163779085768, + -46.23163986148049, + -46.23122883236099, + -46.230367560322556, + -46.22791587631975, + -46.224170672694534, + -46.215901149749705, + -46.20451863517562, + -46.189974983597914, + -46.172222645684414, + -46.15121551636305, + -46.12690841271615, + -46.071636434197124, + -46.00404932295977, + -45.92384071098714, + -45.830699892510154, + -45.72430879357636, + -45.604338666418506, + -45.5089092373698, + -45.5089092373698, + -45.49830395953154, + -45.48761488452668, + -45.46378778977484, + -45.439596518748026, + -45.41500918261838, + -45.3743805218907, + -45.30512323171301, + -45.23288413860123, + -45.157625386496576, + -45.079308867078794, + -44.99789560277998, + -44.86681455931831, + -44.72820151264114, + -44.581896619673984, + -44.42772924100972, + -44.15657986334592, + -43.862823926567906, + -43.545541742999156, + -43.203722733338466, + -42.83625575320174, + -42.44191920239334, + -42.019370059817994, + -41.56713178816824, + -41.08358118427347, + -40.56693419584926, + -40.01523067695982, + -39.42632262964595, + -38.79784762589026, + -38.12721330717865, + -37.41157336385481, + -36.6478223107341, + -35.24444890872161, + -33.67687569337336, + -31.924335280396214, + -29.963037497644123, + -27.76611602617894, + -25.30403302604745, + -22.545291396095024, + -19.457965194644824, + -16.012431220702982, + -12.186165139186542, + -7.969888853600123, + -3.376509274224559, + 1.5483838231346845, + 6.717008574610861, + 11.994887070209165, + 17.2061190490275, + 22.15165660498758, + 26.639141931503975, + 30.516645815479357, + 33.69873650819964, + 36.17525371856702, + 38.00067528374572, + 39.27042556356644, + 40.09459027501137, + 40.577606969183876, + 40.80724618399121, + 40.85167384333729, + 40.7607207116184, + 40.569550846423326, + 40.3025146031807, + 39.976135055648825, + 39.601476806245145, + 39.18598122406331, + 38.73479409272775, + 38.25162027246824, + 37.73924233638554, + 36.845647616853796, + 35.88736681658345, + 34.87031798531678, + 33.21371517109887, + 31.449370553587848, + 29.593425428796227, + 27.661190466511066, + 23.87511711967996, + 19.93544295788888, + 18.936568374586315, + 17.934014848732755, + 16.92787657933105, + 15.919386800062213, + 14.909489268169654, + 13.89847045434801, + 12.886729437674092, + 11.360815961135664, + 9.83729940816007, + 8.317902690248063, + 6.803819495024016, + 2.8346061456629363, + -1.0713649861035892, + -4.904621866088216, + -8.659859602511558, + -12.335874098900648, + -15.937847551233498, + -19.47508824256305, + -22.96088391375027, + -26.418362184845787, + -28.69414375458433, + -30.98358000900077, + -33.30235265147873, + -35.67016350351869, + -38.11070290487868, + -40.65150745236123, + -42.32951022169244, + -44.06839062395811, + -45.87605391724818, + -47.7594264992902, + -49.72340976887018, + -51.76945450280562, + -53.89372502533001, + -56.0849356345114, + -58.32216535162676, + -60.573266563551805, + -62.795227423055394, + -64.93532514854637, + -66.93733644417121, + -68.75026052086282, + -70.33631401999872, + -71.67659743285273, + -72.772325707707, + -73.6425076752174, + -74.31714368711614, + -74.83009288786991, + -75.21409216556663, + -75.49803301635977, + -75.70581619679602, + -75.8564227644772, + -76.05341754721876, + -76.14636437719876, + -76.17338135164876, + -76.1828618007721, + -76.1822409001381, + -76.17555297897066, + -76.15297725566163, + -76.12260363815177, + -76.08495035221415, + -76.0420344968499, + -75.99680382450087, + -75.92210979849808, + -75.84473748027725, + -75.71981304787923, + -75.68663009604822 ] }, "Cell[1]": { @@ -1623,391 +1621,389 @@ 0.0, 0.0021782700426607325, 0.004356540085321465, - 0.010144251315598807, - 0.01593196254587615, - 0.021719673776153494, - 0.030707749283625962, - 0.05122171773865329, - 0.07173568619368062, - 0.0808866402279297, - 0.09003759426217878, - 0.09918854829642786, + 0.009209371054258113, + 0.014062202023194761, + 0.01891503299213141, + 0.0271456900080463, + 0.045898929346240944, + 0.06465216868443559, + 0.07455914596408417, + 0.08446612324373275, + 0.09437310052338133, 0.09999999999999779, 0.10000000000000112, - 0.1000030830871392, - 0.10341300090558016, - 0.10987369384046246, - 0.11633438677534476, - 0.12279507971022706, - 0.12925577264510935, - 0.13571646557999165, - 0.14217715851487395, - 0.14863785144975625, - 0.15509854438463855, - 0.16155923731952085, - 0.1720481181210025, - 0.18253699892248418, - 0.19302587972396584, + 0.10000308344162252, + 0.10341132548916554, + 0.10987517599504681, + 0.11633902650092809, + 0.12280287700680936, + 0.12926672751269064, + 0.1357305780185719, + 0.1421944285244532, + 0.14865827903033446, + 0.15859246600409055, + 0.16852665297784664, + 0.17846083995160272, + 0.1883950269253588, + 0.1983292138991149, 0.19999999999999557, 0.20000000000000223, - 0.20091543391452527, - 0.2018308678290483, - 0.20361444233935574, - 0.2053980168496632, - 0.20718159135997063, - 0.21019561637880158, - 0.21320964139763252, - 0.21782485556023548, - 0.22244006972283845, - 0.2270552838854414, - 0.23167049804804438, - 0.23628571221064734, - 0.2432342358268311, - 0.2501827594430149, - 0.25713128305919863, - 0.2640798066753824, - 0.27102833029156614, - 0.2779768539077499, - 0.28492537752393365, - 0.2918739011401174, - 0.29882242475630116, + 0.20091547395172407, + 0.2018309479034459, + 0.20365904368137847, + 0.20548713945931102, + 0.20731523523724357, + 0.21033704645190943, + 0.21335885766657528, + 0.21798208768281976, + 0.22260531769906425, + 0.22722854771530873, + 0.23185177773155322, + 0.2364750077477977, + 0.24109823776404218, + 0.24985908653267958, + 0.25861993530131694, + 0.2673807840699543, + 0.27614163283859167, + 0.28490248160722903, + 0.2936633303758664, 0.2999999999999934, 0.3000000000000034, - 0.3006724199444088, - 0.3013448398888142, - 0.30283678825998744, - 0.30432873663116067, - 0.3058206850023339, - 0.3082167723871527, - 0.3121724011518111, - 0.3161280299164695, - 0.32008365868112787, - 0.32403928744578625, - 0.32799491621044463, - 0.33406178151604055, - 0.34012864682163646, - 0.3461955121272324, - 0.3522623774328283, - 0.3621397656783724, - 0.37201715392391654, - 0.38189454216946067, - 0.3917719304150048, - 0.4016493186605489, - 0.41152670690609305, - 0.4214040951516372, - 0.4312814833971813, - 0.44115887164272544, - 0.45103625988826956, - 0.4609136481338137, - 0.4707910363793578, - 0.48066842462490195, - 0.4905458128704461, - 0.5004232011159901, - 0.5103005893615342, - 0.5265337093780071, - 0.5427668293944801, - 0.558999949410953, - 0.5752330694274259, - 0.5914661894438988, - 0.6076993094603718, - 0.6239324294768447, - 0.6401655494933176, - 0.6563986695097905, - 0.6726317895262635, - 0.6888649095427364, - 0.7050980295592093, - 0.7213311495756822, - 0.7375642695921552, - 0.7537973896086281, - 0.770030509625101, - 0.7888841100590429, - 0.8017808793880951, - 0.8146776487171472, - 0.8275744180461994, - 0.8404711873752515, - 0.8533679567043037, - 0.8662647260333558, - 0.879161495362408, - 0.8920582646914601, - 0.9049550340205123, - 0.9294182305234298, - 0.9462090502315512, - 0.9629998699396727, - 0.9797906896477941, - 0.9965815093559156, - 1.013372329064037, - 1.0301631487721585, - 1.04695396848028, - 1.0806240181616504, - 1.101525991887505, - 1.1224279656133598, - 1.1433299393392145, - 1.1642319130650691, - 1.1851338867909238, - 1.2060358605167785, - 1.2631747851334303, - 1.320313709750082, - 1.377452634366734, - 1.4345915589833858, - 1.4684901834585067, - 1.5023888079336276, - 1.5362874324087485, - 1.5880903612542963, - 1.639893290099844, - 1.6916962189453917, - 1.7434991477909394, - 1.795302076636487, - 1.8471050054820348, - 1.8989079343275825, - 1.9507108631731302, - 2.0363633202090647, - 2.1220157772449992, - 2.2076682342809337, - 2.293320691316868, - 2.3789731483528027, - 2.464625605388737, - 2.5502780624246717, - 2.5940840186421377, - 2.6378899748596036, - 2.6816959310770696, - 2.7255018872945356, - 2.7693078435120015, - 2.8131137997294675, - 2.8418960304239897, - 2.870678261118512, - 2.8994604918130342, - 2.9282427225075565, - 2.9570249532020787, - 2.985807183896601, - 3.014589414591123, - 3.0433716452856454, - 3.0721538759801676, - 3.10093610667469, - 3.129718337369212, - 3.1585005680637344, - 3.1872827987582566, - 3.216065029452779, - 3.244847260147301, - 3.2736294908418233, - 3.3024117215363455, - 3.331193952230868, - 3.35997618292539, - 3.3887584136199123, - 3.4175406443144345, - 3.4463228750089567, - 3.475105105703479, - 3.503887336398001, - 3.5326695670925234, - 3.5787938424354193, - 3.6668895202843714, - 3.720654541316907, - 3.7744195623494425, - 3.828184583381978, - 3.8819496044145136, - 3.935714625447049, - 3.9894796464795848, - 4.04324466751212, - 4.124178086535243, - 4.300674919360661, - 4.47717175218608, - 4.6536685850114985, - 4.830165417836917, + 0.30067267332400544, + 0.3013453466480075, + 0.3028276792272832, + 0.3043100118065589, + 0.30579234438583464, + 0.3081893334358465, + 0.31213534228058365, + 0.3160813511253208, + 0.320027359970058, + 0.32397336881479516, + 0.32791937765953233, + 0.3339762759614212, + 0.3400331742633101, + 0.34609007256519897, + 0.35214697086708785, + 0.362109096180154, + 0.3720712214932202, + 0.38203334680628637, + 0.39199547211935254, + 0.4019575974324187, + 0.4119197227454849, + 0.42188184805855106, + 0.43184397337161723, + 0.4418060986846834, + 0.4517682239977496, + 0.46173034931081575, + 0.4716924746238819, + 0.4816545999369481, + 0.49161672525001426, + 0.5015788505630805, + 0.5115409758761467, + 0.5283037938614952, + 0.5450666118468437, + 0.5618294298321922, + 0.5785922478175407, + 0.5953550658028892, + 0.6121178837882377, + 0.6288807017735862, + 0.6456435197589347, + 0.6624063377442833, + 0.6791691557296318, + 0.6959319737149803, + 0.7126947917003288, + 0.7294576096856773, + 0.7462204276710258, + 0.7629832456563743, + 0.7797460636417228, + 0.7965088816270713, + 0.8132716996124199, + 0.8300345175977684, + 0.8467973355831169, + 0.8635601535684654, + 0.8803229715538139, + 0.8970857895391624, + 0.9138486075245109, + 0.9306114255098594, + 0.9473742434952079, + 0.9641370614805564, + 0.980899879465905, + 0.9976626974512535, + 1.014425515436602, + 1.0311883334219505, + 1.047951151407299, + 1.0647139693926475, + 1.081476787377996, + 1.0982396053633445, + 1.115002423348693, + 1.1423681390229952, + 1.1697338546972973, + 1.1970995703715994, + 1.2389386448914943, + 1.2807777194113892, + 1.322616793931284, + 1.364455868451179, + 1.4428816572707979, + 1.5213074460904168, + 1.5409138932953215, + 1.5605203405002261, + 1.5801267877051308, + 1.5997332349100355, + 1.6193396821149402, + 1.6389461293198448, + 1.6585525765247495, + 1.688127712376697, + 1.7177028482286443, + 1.7472779840805917, + 1.776853119932539, + 1.8550670616609963, + 1.9332810033894536, + 2.011494945117911, + 2.0897088868463682, + 2.1679228285748255, + 2.246136770303283, + 2.32435071203174, + 2.4025646537601975, + 2.4807785954886548, + 2.5322643078588487, + 2.5837500202290427, + 2.6352357325992366, + 2.6867214449694306, + 2.7382071573396245, + 2.7896928697098184, + 2.822359545726363, + 2.855026221742907, + 2.8876928977594516, + 2.920359573775996, + 2.9530262497925404, + 2.9856929258090847, + 3.018359601825629, + 3.0510262778421735, + 3.083692953858718, + 3.1163596298752623, + 3.1490263058918067, + 3.181692981908351, + 3.2143596579248954, + 3.24702633394144, + 3.279693009957984, + 3.3123596859745286, + 3.345026361991073, + 3.3776930380076173, + 3.4103597140241617, + 3.443026390040706, + 3.4756930660572505, + 3.508359742073795, + 3.5410264180903392, + 3.5736930941068836, + 3.6446252167239312, + 3.715557339340979, + 3.7643433642244144, + 3.81312938910785, + 3.8619154139912855, + 3.910701438874721, + 4.007774041380115, + 4.104846643885509, + 4.2019192463909025, + 4.298991848896296, + 4.39606445140169, + 4.550802142359061, + 4.705539833316433, + 4.940497460263208, 5.0 ], "v": [ -65.0, -64.34741061035629, - -63.69577760963717, - -61.968793023704, - -60.24765777485044, - -58.53275678097242, - -55.88205091818734, - -49.886194744983726, - -43.959723800401335, - -41.33663135742244, - -38.72384109212122, - -36.119064319355715, - -35.88846147439455, - -35.88846147439455, - -35.88758539978431, - -34.9192430169887, - -33.08567532428186, - -31.25218682639946, - -29.417405457191027, - -27.579574883863675, - -25.736569977369914, - -23.885894266243284, - -22.02471523314786, - -20.14982251998646, - -18.257643910308083, - -15.138529423502895, - -11.946023934389963, - -8.660137711088346, - -6.413521782611106, - -6.413521782611106, - -6.388157800170669, - -6.361252148199639, - -6.3048848117152545, - -6.243163533495824, - -6.175551531173829, - -6.047107225362163, - -5.900436564068157, - -5.639353561561381, - -5.3327528120797165, - -4.979078177949866, - -4.576928394758785, - -4.125114608031427, - -3.349201145605125, - -2.456143150122469, - -1.4445461581326984, - -0.31428035447735136, - 0.9333942616857096, - 2.2958034908600236, - 3.768657111624778, - 5.34594136942601, - 7.019801240318386, - 7.312450495800458, - 7.312450495800458, - 7.481057084802978, - 7.650444806600119, - 8.028791046797698, - 8.410413638772336, - 8.795489057418083, - 9.421025542804903, - 10.471512142794365, - 11.542307292266926, - 12.630852567688223, - 13.73432884610969, - 14.849741904719735, - 16.576485898857662, - 18.312866749103982, - 20.04650462162177, - 21.7646366545609, - 24.49692463490876, - 27.105078659111985, - 29.544644529029117, - 31.779817029222038, - 33.78515341180088, - 35.54667165517954, - 37.061600453402924, - 38.3370193271629, - 39.387838582527266, - 40.2344304133845, - 40.90025052316357, - 41.409730507515285, - 41.78661567664529, - 42.05281092732239, - 42.227707703004185, - 42.32790949531359, - 42.36509419843715, - 42.28421062938336, - 42.118186178275955, - 41.88767404505023, - 41.60585312292347, - 41.281833856218384, - 40.922090125331735, - 40.5310490974115, - 40.111661180208365, - 39.66600287194666, - 39.19570518399509, - 38.70215125968095, - 38.18654295209039, - 37.64993986417911, - 37.09330423801233, - 36.517540477004054, - 35.825981410353535, - 35.339416989715, - 34.842349745759186, - 34.33518382409842, - 33.818318311715394, - 33.29214516572613, - 32.75705022690199, - 32.213414030040454, - 31.6616118273926, - 31.102013497312704, - 30.020420350648223, - 29.263834781118813, - 28.49656239500648, - 27.719353392338164, - 26.93293857558875, - 26.138025206096238, - 25.3353018722904, - 24.52544008543101, - 22.882521721550283, - 21.851669518366688, - 20.81377444498822, - 19.769892764224885, - 18.721028662741016, - 17.668129482802634, - 16.612085988256005, - 13.71559649741143, - 10.816666424708892, - 7.927822859887102, - 5.058872917150171, - 3.3694198159621935, - 1.69070052768067, - 0.02367487329090986, - -2.4995137539507457, - -4.991620875449845, - -7.451659657940135, - -9.879540010975312, - -12.276006780724435, - -14.642546788666136, - -16.98143455878558, - -19.29585087098723, - -23.081882601069104, - -26.839183652126994, - -30.615926911930913, - -34.47495221204521, - -38.513637834862415, - -42.85046595000351, - -47.63582558360295, - -50.29962476771411, - -53.11333607130135, - -56.056620458446645, - -59.085833525757344, - -62.11887885740127, - -65.03425986722009, - -66.8179364058848, - -68.45489553090746, - -69.91723682686201, - -71.18803612278307, - -72.26313937070918, - -73.15046179668862, - -73.86704668875203, - -74.43517607447791, - -74.87878903692652, - -75.22088583292954, - -75.4820162931164, - -75.67963883419051, - -75.82805824144091, - -75.93868999204037, - -76.02047086723191, - -76.08030222647965, - -76.1234633155344, - -76.15396690564478, - -76.17485073003928, - -76.18840903726314, - -76.1963728573897, - -76.20004837217036, - -76.20042206155725, - -76.1982400531819, - -76.19406775058988, - -76.18429407868597, - -76.15907140987329, - -76.14049224515105, - -76.12026003274708, - -76.09893343620007, - -76.07681976507138, - -76.05402899080902, - -76.03060016486896, - -76.00657044311373, - -75.96934767116855, - -75.88399010643575, - -75.79312962226788, - -75.6967772849036, - -75.59479020759454, - -75.49122378347786 + -63.69577263696476, + -62.247147666678785, + -60.80264214143863, + -59.36255157375306, + -56.930287152825315, + -51.434437934698906, + -45.99873616514653, + -43.14978576987668, + -40.31415357144797, + -37.489522484986864, + -35.88930351195419, + -35.88930351195419, + -35.88842737326104, + -34.92060350309073, + -33.08592182963408, + -31.251409591010844, + -29.41570801196035, + -27.577021784007012, + -25.733194535159683, + -23.881721512730973, + -22.01974422249498, + -19.130129413480844, + -16.195476154437703, + -13.200624371160274, + -10.1287140436806, + -6.962252666355457, + -6.419170606347077, + -6.419170606347077, + -6.393838467343887, + -6.36696966099421, + -6.3091643516336795, + -6.245736031794958, + -6.176110786028196, + -6.046633561483418, + -5.898816703147136, + -5.6359949223525865, + -5.3274422573068305, + -4.97161622692276, + -4.5671155107594394, + -4.112748193165098, + -3.6075340733965255, + -2.5082552965774445, + -1.220754717718838, + 0.25519264196457386, + 1.916124890880268, + 3.7546272933732294, + 5.759081232514183, + 7.303412783882414, + 7.303412783882414, + 7.472054055489596, + 7.641477959828602, + 8.01730991570712, + 8.396379313975306, + 8.778860906012618, + 9.404445190341931, + 10.45207624596046, + 11.519962711522373, + 12.605549278028883, + 13.70604574504307, + 14.818488193403288, + 16.542161281091087, + 18.27563619748716, + 20.0066223406808, + 21.722468945958926, + 24.479310547616773, + 27.11022516474935, + 29.569608910091524, + 31.820758542700517, + 33.83782572906053, + 35.60673386388523, + 37.12490395101259, + 38.399906193743575, + 39.44734407098349, + 40.28836412309032, + 40.947172409022386, + 41.44881350311904, + 41.817589713430024, + 42.07580320116537, + 42.243085364129634, + 42.336144708155146, + 42.3616326558426, + 42.26544482026064, + 42.08231334544078, + 41.83360393222554, + 41.53256372939127, + 41.18825111413234, + 40.807116141220426, + 40.39362806886694, + 39.95076359189717, + 39.480620496817544, + 38.984833218110616, + 38.46480442946123, + 37.92178362122792, + 37.35689471067398, + 36.7711677740339, + 36.16557404796061, + 35.54104975333364, + 34.898506245986106, + 34.238833321552704, + 33.56290151756614, + 32.871564656496155, + 32.16566165017474, + 31.446017024449887, + 30.71344054347832, + 29.968726513638018, + 29.212653042857962, + 28.445978856122554, + 27.66944879818683, + 26.88379165831454, + 26.089711846821295, + 25.287890215792054, + 24.478990553177898, + 23.663657196280244, + 22.842511637905254, + 22.01615180402012, + 21.1851526840736, + 19.819982926520176, + 18.446181761941045, + 17.065864579864392, + 14.94729593865137, + 12.824260592312687, + 10.7022188304426, + 8.585845988180115, + 4.646985070591015, + 0.7604474939723352, + -0.2013949392978782, + -1.158977171795005, + -2.112210737103982, + -3.0610029136374446, + -4.005279338577635, + -4.944995705637577, + -5.8801236143354245, + -7.281985035318003, + -8.673360178521383, + -10.054339249704324, + -11.425100100736817, + -15.003109345449403, + -18.519404883370875, + -21.986560525846766, + -25.423777330330175, + -28.858681444477856, + -32.33557768277415, + -35.91489906879013, + -39.67357461115064, + -43.71677361580658, + -46.58954289710508, + -49.65970780865457, + -52.9361081168667, + -56.39578612940259, + -59.961498836786696, + -63.48653237563576, + -65.60910394392323, + -67.57515113282871, + -69.33505016333838, + -70.85508582810212, + -72.12248306121046, + -73.14530316148641, + -73.94763902712725, + -74.56248645682261, + -75.02501959212762, + -75.36794525426812, + -75.61923375114581, + -75.80147948003422, + -75.93232446500639, + -76.02524972846064, + -76.09036388852057, + -76.13513052588254, + -76.16500569578425, + -76.18396181957858, + -76.19488885692894, + -76.19988834902712, + -76.20048860279282, + -76.19780195306416, + -76.19264001783056, + -76.1855967281419, + -76.1658781383693, + -76.1421850863898, + -76.12410908375328, + -76.10500924071012, + -76.08517422688114, + -76.06474766940758, + -76.02262794288129, + -75.97865641187012, + -75.93281377253217, + -75.88517311484324, + -75.83585088760532, + -75.753809309412, + -75.66753614522446, + -75.52821902070409, + -75.4913233507669 ] }, "Cell[2]": { @@ -2015,391 +2011,389 @@ 0.0, 0.0021782700426607325, 0.004356540085321465, - 0.010144251315598807, - 0.01593196254587615, - 0.021719673776153494, - 0.030707749283625962, - 0.05122171773865329, - 0.07173568619368062, - 0.0808866402279297, - 0.09003759426217878, - 0.09918854829642786, + 0.009209371054258113, + 0.014062202023194761, + 0.01891503299213141, + 0.0271456900080463, + 0.045898929346240944, + 0.06465216868443559, + 0.07455914596408417, + 0.08446612324373275, + 0.09437310052338133, 0.09999999999999779, 0.10000000000000112, - 0.1000030830871392, - 0.10341300090558016, - 0.10987369384046246, - 0.11633438677534476, - 0.12279507971022706, - 0.12925577264510935, - 0.13571646557999165, - 0.14217715851487395, - 0.14863785144975625, - 0.15509854438463855, - 0.16155923731952085, - 0.1720481181210025, - 0.18253699892248418, - 0.19302587972396584, + 0.10000308344162252, + 0.10341132548916554, + 0.10987517599504681, + 0.11633902650092809, + 0.12280287700680936, + 0.12926672751269064, + 0.1357305780185719, + 0.1421944285244532, + 0.14865827903033446, + 0.15859246600409055, + 0.16852665297784664, + 0.17846083995160272, + 0.1883950269253588, + 0.1983292138991149, 0.19999999999999557, 0.20000000000000223, - 0.20091543391452527, - 0.2018308678290483, - 0.20361444233935574, - 0.2053980168496632, - 0.20718159135997063, - 0.21019561637880158, - 0.21320964139763252, - 0.21782485556023548, - 0.22244006972283845, - 0.2270552838854414, - 0.23167049804804438, - 0.23628571221064734, - 0.2432342358268311, - 0.2501827594430149, - 0.25713128305919863, - 0.2640798066753824, - 0.27102833029156614, - 0.2779768539077499, - 0.28492537752393365, - 0.2918739011401174, - 0.29882242475630116, + 0.20091547395172407, + 0.2018309479034459, + 0.20365904368137847, + 0.20548713945931102, + 0.20731523523724357, + 0.21033704645190943, + 0.21335885766657528, + 0.21798208768281976, + 0.22260531769906425, + 0.22722854771530873, + 0.23185177773155322, + 0.2364750077477977, + 0.24109823776404218, + 0.24985908653267958, + 0.25861993530131694, + 0.2673807840699543, + 0.27614163283859167, + 0.28490248160722903, + 0.2936633303758664, 0.2999999999999934, 0.3000000000000034, - 0.3006724199444088, - 0.3013448398888142, - 0.30283678825998744, - 0.30432873663116067, - 0.3058206850023339, - 0.3082167723871527, - 0.3121724011518111, - 0.3161280299164695, - 0.32008365868112787, - 0.32403928744578625, - 0.32799491621044463, - 0.33406178151604055, - 0.34012864682163646, - 0.3461955121272324, - 0.3522623774328283, - 0.3621397656783724, - 0.37201715392391654, - 0.38189454216946067, - 0.3917719304150048, - 0.4016493186605489, - 0.41152670690609305, - 0.4214040951516372, - 0.4312814833971813, - 0.44115887164272544, - 0.45103625988826956, - 0.4609136481338137, - 0.4707910363793578, - 0.48066842462490195, - 0.4905458128704461, - 0.5004232011159901, - 0.5103005893615342, - 0.5265337093780071, - 0.5427668293944801, - 0.558999949410953, - 0.5752330694274259, - 0.5914661894438988, - 0.6076993094603718, - 0.6239324294768447, - 0.6401655494933176, - 0.6563986695097905, - 0.6726317895262635, - 0.6888649095427364, - 0.7050980295592093, - 0.7213311495756822, - 0.7375642695921552, - 0.7537973896086281, - 0.770030509625101, - 0.7888841100590429, - 0.8017808793880951, - 0.8146776487171472, - 0.8275744180461994, - 0.8404711873752515, - 0.8533679567043037, - 0.8662647260333558, - 0.879161495362408, - 0.8920582646914601, - 0.9049550340205123, - 0.9294182305234298, - 0.9462090502315512, - 0.9629998699396727, - 0.9797906896477941, - 0.9965815093559156, - 1.013372329064037, - 1.0301631487721585, - 1.04695396848028, - 1.0806240181616504, - 1.101525991887505, - 1.1224279656133598, - 1.1433299393392145, - 1.1642319130650691, - 1.1851338867909238, - 1.2060358605167785, - 1.2631747851334303, - 1.320313709750082, - 1.377452634366734, - 1.4345915589833858, - 1.4684901834585067, - 1.5023888079336276, - 1.5362874324087485, - 1.5880903612542963, - 1.639893290099844, - 1.6916962189453917, - 1.7434991477909394, - 1.795302076636487, - 1.8471050054820348, - 1.8989079343275825, - 1.9507108631731302, - 2.0363633202090647, - 2.1220157772449992, - 2.2076682342809337, - 2.293320691316868, - 2.3789731483528027, - 2.464625605388737, - 2.5502780624246717, - 2.5940840186421377, - 2.6378899748596036, - 2.6816959310770696, - 2.7255018872945356, - 2.7693078435120015, - 2.8131137997294675, - 2.8418960304239897, - 2.870678261118512, - 2.8994604918130342, - 2.9282427225075565, - 2.9570249532020787, - 2.985807183896601, - 3.014589414591123, - 3.0433716452856454, - 3.0721538759801676, - 3.10093610667469, - 3.129718337369212, - 3.1585005680637344, - 3.1872827987582566, - 3.216065029452779, - 3.244847260147301, - 3.2736294908418233, - 3.3024117215363455, - 3.331193952230868, - 3.35997618292539, - 3.3887584136199123, - 3.4175406443144345, - 3.4463228750089567, - 3.475105105703479, - 3.503887336398001, - 3.5326695670925234, - 3.5787938424354193, - 3.6668895202843714, - 3.720654541316907, - 3.7744195623494425, - 3.828184583381978, - 3.8819496044145136, - 3.935714625447049, - 3.9894796464795848, - 4.04324466751212, - 4.124178086535243, - 4.300674919360661, - 4.47717175218608, - 4.6536685850114985, - 4.830165417836917, + 0.30067267332400544, + 0.3013453466480075, + 0.3028276792272832, + 0.3043100118065589, + 0.30579234438583464, + 0.3081893334358465, + 0.31213534228058365, + 0.3160813511253208, + 0.320027359970058, + 0.32397336881479516, + 0.32791937765953233, + 0.3339762759614212, + 0.3400331742633101, + 0.34609007256519897, + 0.35214697086708785, + 0.362109096180154, + 0.3720712214932202, + 0.38203334680628637, + 0.39199547211935254, + 0.4019575974324187, + 0.4119197227454849, + 0.42188184805855106, + 0.43184397337161723, + 0.4418060986846834, + 0.4517682239977496, + 0.46173034931081575, + 0.4716924746238819, + 0.4816545999369481, + 0.49161672525001426, + 0.5015788505630805, + 0.5115409758761467, + 0.5283037938614952, + 0.5450666118468437, + 0.5618294298321922, + 0.5785922478175407, + 0.5953550658028892, + 0.6121178837882377, + 0.6288807017735862, + 0.6456435197589347, + 0.6624063377442833, + 0.6791691557296318, + 0.6959319737149803, + 0.7126947917003288, + 0.7294576096856773, + 0.7462204276710258, + 0.7629832456563743, + 0.7797460636417228, + 0.7965088816270713, + 0.8132716996124199, + 0.8300345175977684, + 0.8467973355831169, + 0.8635601535684654, + 0.8803229715538139, + 0.8970857895391624, + 0.9138486075245109, + 0.9306114255098594, + 0.9473742434952079, + 0.9641370614805564, + 0.980899879465905, + 0.9976626974512535, + 1.014425515436602, + 1.0311883334219505, + 1.047951151407299, + 1.0647139693926475, + 1.081476787377996, + 1.0982396053633445, + 1.115002423348693, + 1.1423681390229952, + 1.1697338546972973, + 1.1970995703715994, + 1.2389386448914943, + 1.2807777194113892, + 1.322616793931284, + 1.364455868451179, + 1.4428816572707979, + 1.5213074460904168, + 1.5409138932953215, + 1.5605203405002261, + 1.5801267877051308, + 1.5997332349100355, + 1.6193396821149402, + 1.6389461293198448, + 1.6585525765247495, + 1.688127712376697, + 1.7177028482286443, + 1.7472779840805917, + 1.776853119932539, + 1.8550670616609963, + 1.9332810033894536, + 2.011494945117911, + 2.0897088868463682, + 2.1679228285748255, + 2.246136770303283, + 2.32435071203174, + 2.4025646537601975, + 2.4807785954886548, + 2.5322643078588487, + 2.5837500202290427, + 2.6352357325992366, + 2.6867214449694306, + 2.7382071573396245, + 2.7896928697098184, + 2.822359545726363, + 2.855026221742907, + 2.8876928977594516, + 2.920359573775996, + 2.9530262497925404, + 2.9856929258090847, + 3.018359601825629, + 3.0510262778421735, + 3.083692953858718, + 3.1163596298752623, + 3.1490263058918067, + 3.181692981908351, + 3.2143596579248954, + 3.24702633394144, + 3.279693009957984, + 3.3123596859745286, + 3.345026361991073, + 3.3776930380076173, + 3.4103597140241617, + 3.443026390040706, + 3.4756930660572505, + 3.508359742073795, + 3.5410264180903392, + 3.5736930941068836, + 3.6446252167239312, + 3.715557339340979, + 3.7643433642244144, + 3.81312938910785, + 3.8619154139912855, + 3.910701438874721, + 4.007774041380115, + 4.104846643885509, + 4.2019192463909025, + 4.298991848896296, + 4.39606445140169, + 4.550802142359061, + 4.705539833316433, + 4.940497460263208, 5.0 ], "v": [ -65.0, -64.12990281759853, - -63.26108085514461, - -60.95849454025222, - -58.66371131167813, - -56.37724618894741, - -52.843091520435436, - -44.84835934442173, - -36.942928251120556, - -33.44186908761291, - -29.95167937132297, - -26.467510519917848, - -26.15881647395241, - -26.15881647395241, - -26.157643633628915, - -24.86021459784613, - -22.4006947485779, - -19.936373079105127, - -17.463953086348475, - -14.979717063405174, - -12.479456580286016, - -9.958573587394934, - -7.4120629992227345, - -4.834880325381694, - -2.222032841162231, - 2.107328307044544, - 6.556519997640082, - 11.132408714979132, - 14.243212053096183, - 14.243212053096183, - 14.655728929306376, - 15.069015619927175, - 15.876114382157992, - 16.685570350832624, - 17.497405634976783, - 18.874103674743047, - 20.25588097133528, - 22.378313881426585, - 24.503781003652204, - 26.625324977702746, - 28.734923324680025, - 30.823757399320694, - 33.90812286732075, - 36.88934785964578, - 39.73229289889535, - 42.40257856064212, - 44.86880933596741, - 47.104625467143435, - 49.09049607284498, - 50.814886866667, - 52.27475062875583, - 52.49586712780552, - 52.49586712780552, - 52.35253718483665, - 52.210715748117465, - 51.90104611191855, - 51.59808386435186, - 51.30242998421664, - 50.84344231592383, - 50.128518434465946, - 49.46641564271963, - 48.85610531410972, - 48.296034231265224, - 47.78422479768615, - 47.0876676766299, - 46.490244726730175, - 45.98168129367532, - 45.55123768301496, - 44.99096304413519, - 44.568872538649444, - 44.24888446123369, - 44.00103701187808, - 43.8017537397982, - 43.63299571354023, - 43.481436067602665, - 43.33752719866017, - 43.19462451275408, - 43.04824086905373, - 42.89544914120467, - 42.73442257255937, - 42.56409206110039, - 42.383897402966234, - 42.193611124544965, - 41.99321660734147, - 41.64224515446991, - 41.265196984655134, - 40.86309104861804, - 40.43697586349108, - 39.987909456834096, - 39.516904077173656, - 39.024879674200115, - 38.51267140343401, - 37.98106947025903, - 37.43084828522574, - 36.862771248123885, - 36.27758505367094, - 35.67601811015329, - 35.05878498581637, - 34.42659149799595, - 33.78013674437784, - 33.01234455294899, - 32.47714808421834, - 31.934222535649187, - 31.38390222777336, - 30.82651880944937, - 30.262399161416223, - 29.691865120767428, - 29.115233539524972, - 28.53281614449785, - 27.944919332820227, - 26.815784779802982, - 26.031032450587293, - 25.239065158954993, - 24.440489200992584, - 23.635891754376058, - 22.825838871254245, - 22.010877623666335, - 21.191536819836887, - 19.537363867010725, - 18.504333914769177, - 17.467637590654704, - 16.428081302658672, - 15.38642482795634, - 14.343379880523056, - 13.299610953802748, - 10.447347027922822, - 7.605098631111991, - 4.781767472910655, - 1.9839465577904296, - 0.3383923574477213, - -1.2957167182513856, - -2.9178774034465556, - -5.372859275500897, - -7.798184573215271, - -10.193765187084765, - -12.560397215263608, - -14.899652751639508, - -17.213862290184892, - -19.50623972305589, - -21.78111030804375, - -25.521347171408273, - -29.26444937609969, - -33.07281830597689, - -37.02654140447806, - -41.24523949125499, - -45.863715776380765, - -51.029258866362945, - -53.90127075950137, - -56.896485725847775, - -59.9560634791395, - -62.990490655268864, - -65.87105920539892, - -68.45604805031753, - -69.93398587860938, - -71.21596101584015, - -72.29909368206721, - -73.19175259124641, - -73.91102081556376, - -74.47947525173088, - -74.92169505913687, - -75.26138372786906, - -75.519632918335, - -75.71424542527929, - -75.85973350472443, - -75.9676402754986, - -76.04697663618035, - -76.1046753884487, - -76.1460151255437, - -76.1749883682527, - -76.1946036038519, - -76.20712332878362, - -76.21424741864892, - -76.2172528926556, - -76.21709980750872, - -76.21451101172394, - -76.21003185642476, - -76.20407472559542, - -76.19695221508294, - -76.18369615529879, - -76.15429609674106, - -76.13430106980246, - -76.11317346435614, - -76.09122329347164, - -76.06862128841006, - -76.04542848133043, - -76.02166609212514, - -75.99735383134913, - -75.95976233088936, - -75.87372742498222, - -75.78221648842496, - -75.68518443739727, - -75.58250427085713, - -75.4782717428856 + -63.26107424638339, + -61.32962419957862, + -59.40366874719685, + -57.48360378351708, + -54.24069087780647, + -46.912889897997076, + -39.66364946258162, + -35.86270823764225, + -32.07709034872574, + -28.30197404266554, + -26.16077107578851, + -26.16077107578851, + -26.159598192818333, + -24.862916003807978, + -22.401767773145917, + -19.936020594178206, + -17.462412395949883, + -14.977143270716082, + -12.475937486806922, + -9.954121423082118, + -7.4067351151495595, + -3.4302895277367385, + 0.6350832097037246, + 4.80455060527549, + 9.087456929588804, + 13.482825127804547, + 14.232821897621657, + 14.232821897621657, + 14.64532926163172, + 15.058612794345107, + 15.885856783887649, + 16.7155763479329, + 17.547783053877957, + 18.928235887754415, + 20.313742619397757, + 22.439997444449613, + 24.569086820917093, + 26.694024221830475, + 28.806721179984223, + 30.898279490965773, + 32.95913887049465, + 36.743800901797584, + 40.31130965283871, + 43.59356268119363, + 46.53065351366326, + 49.077505433482365, + 51.20876842735231, + 52.488253438611565, + 52.488253438611565, + 52.345003681084584, + 52.20326441077931, + 51.895848265121806, + 51.595047702053236, + 51.30145092569329, + 50.84248354277067, + 50.12951418313292, + 49.469063186464076, + 48.86011940164566, + 48.30115137750037, + 47.79020428372216, + 47.09403443411548, + 46.49673131989482, + 45.9880723964635, + 45.55738253534123, + 44.99157911027983, + 44.56636467566621, + 44.24468527193633, + 43.99600285318934, + 43.79620126520686, + 43.626932875623865, + 43.474692754292384, + 43.32983845201297, + 43.185686668232265, + 43.03774752263865, + 42.88311128375689, + 42.71999338878867, + 42.547341615482445, + 42.36461223347313, + 42.171584594039, + 41.96827189377379, + 41.60337724468131, + 41.210746597566605, + 40.79155239651937, + 40.34701978717825, + 39.878289524053926, + 39.38639367047911, + 38.872278548980354, + 38.33687407684451, + 37.7810771792411, + 37.20575027422955, + 36.6117118646556, + 35.99976050376299, + 35.370689697220335, + 34.725287245533806, + 34.0643304501903, + 33.38858479035238, + 32.69880537535326, + 31.995738017752636, + 31.28011875537648, + 30.552672545893515, + 29.814112015064133, + 29.065136481424098, + 28.306431081546183, + 27.53866585953671, + 26.762494843985014, + 25.978555191728304, + 25.1874652930921, + 24.38982714796038, + 23.58622517085304, + 22.777222183225824, + 21.96335981116757, + 21.14516156713812, + 20.32313180014027, + 19.497754213807085, + 18.669491665872247, + 17.838786632092, + 16.47848181034511, + 15.114508770110955, + 13.74845465756167, + 11.659143036517285, + 9.57290880068782, + 7.493675724866839, + 5.4247352386675365, + 1.583213771042525, + -2.2003632848097445, + -3.136226293848539, + -4.067903178809945, + -4.995355606009951, + -5.91854972165494, + -6.837467752473437, + -7.7521135623590265, + -8.66250527406061, + -10.027793679451579, + -11.383627999779627, + -12.730249182090736, + -14.067981868090785, + -17.566252233838238, + -21.0165229543029, + -24.435717519043106, + -27.84933498076317, + -31.293705559857, + -34.82566345496347, + -38.52096229413497, + -42.47171769984209, + -46.79358511808651, + -49.892984724979605, + -53.204127760137105, + -56.69848345617973, + -60.29254731596278, + -63.831527067502854, + -67.10280984393243, + -68.93564757582809, + -70.53113494710885, + -71.87122837774842, + -72.9590762140266, + -73.81564054943172, + -74.47312999219669, + -74.9677310809691, + -75.33400478926686, + -75.60185098714588, + -75.79560012688772, + -75.93431693929672, + -76.03254557249925, + -76.10117606508618, + -76.14824575105234, + -76.17962133940848, + -76.19955662662058, + -76.21112763677414, + -76.21655919256469, + -76.21746166210005, + -76.21500110655415, + -76.21002323183748, + -76.2031430978095, + -76.19480979964138, + -76.18535234943569, + -76.1620840771778, + -76.13623256895481, + -76.1172473670025, + -76.09751706214126, + -76.0772016373848, + -76.05638076553284, + -76.01360517616487, + -75.96909525591686, + -75.92283287958668, + -75.87484907557283, + -75.82519878488432, + -75.74261878632598, + -75.65577228946262, + -75.5155577656026, + -75.4784320077078 ] } }, @@ -3227,347 +3221,305 @@ 0.0, 0.0007893817721078212, 0.0015787635442156423, - 0.003422478628235086, - 0.00526619371225453, - 0.007109908796273974, - 0.010271861410657116, - 0.020364350733288607, - 0.025463892160995642, - 0.030563433588702678, - 0.03566297501640971, - 0.04338543095615344, - 0.05110788689589715, - 0.05883034283564087, - 0.07148713771988026, - 0.08414393260411965, - 0.09680072748835904, + 0.0032940962863290593, + 0.005009429028442477, + 0.006724761770555894, + 0.009756363489589855, + 0.01919459525370049, + 0.024273735450643888, + 0.02935287564758729, + 0.03443201584453069, + 0.04291549730970577, + 0.05139897877488085, + 0.05988246024005593, + 0.06836594170523101, + 0.08151219145461693, + 0.09465844120400284, 0.09999999999999779, 0.10000000000000112, - 0.10095640317974434, - 0.10191280635948757, - 0.1041541437766779, - 0.10639548119386821, - 0.10863681861105853, - 0.11254071227140908, - 0.1245760568857235, - 0.13050429542101094, - 0.13643253395629837, - 0.1423607724915858, - 0.14828901102687322, - 0.15421724956216065, - 0.1658544639373996, - 0.17749167831263857, - 0.18912889268787753, - 0.20076610706311648, - 0.2184167287220536, - 0.2360673503809907, - 0.2537179720399278, - 0.2713685936988649, - 0.289019215357802, - 0.3066698370167391, - 0.3243204586756762, - 0.3419710803346133, - 0.3596217019935504, - 0.37727232365248753, - 0.4053254288027655, - 0.4333785339530435, - 0.46143163910332147, - 0.48948474425359945, - 0.5175378494038775, - 0.5455909545541555, - 0.5736440597044336, - 0.6016971648547116, - 0.6297502700049896, - 0.6578033751552677, - 0.6858564803055457, - 0.7139095854558237, - 0.7419626906061018, - 0.7700157957563798, - 0.7980689009066578, - 0.8261220060569359, - 0.8456853040561582, - 0.8652486020553805, - 0.8848119000546028, - 0.904375198053825, - 0.9180277908964931, - 0.9316803837391612, - 0.9453329765818292, - 0.9589855694244973, - 0.9726381622671654, - 0.9862907551098334, - 0.9999433479525015, - 1.0135959407951696, - 1.0272485336378376, - 1.0409011264805057, - 1.0545537193231738, - 1.0682063121658418, - 1.08185890500851, - 1.095511497851178, - 1.109164090693846, - 1.122816683536514, - 1.1364692763791822, - 1.1501218692218502, - 1.1637744620645183, - 1.1862420911672444, - 1.2087097202699706, - 1.2311773493726967, - 1.2536449784754229, - 1.276112607578149, - 1.2985802366808752, - 1.3210478657836013, - 1.3435154948863275, - 1.3659831239890536, - 1.3884507530917798, - 1.4250960696862285, - 1.4389131664769423, - 1.4527302632676562, - 1.4784254212523666, - 1.5182100253163118, - 1.557994629380257, - 1.597779233444202, - 1.6375638375081472, - 1.70613285848363, - 1.7747018794591127, - 1.8121446404729922, - 1.8495874014868716, - 1.887030162500751, - 1.9244729235146305, - 1.96191568452851, - 1.9993584455423894, - 2.0604374671880077, - 2.1766662978652707, - 2.240910170317285, - 2.3051540427692996, - 2.369397915221314, - 2.4336417876733285, - 2.497885660125343, - 2.5621295325773574, - 2.626373405029372, - 2.6906172774813863, - 2.754861149933401, - 2.8191050223854153, - 2.859282417857852, - 2.899459813330289, - 2.939637208802726, - 2.979814604275163, - 3.0199919997476, - 3.060169395220037, - 3.1003467906924738, - 3.1405241861649107, - 3.1807015816373476, - 3.2208789771097845, - 3.2452271933295096, - 3.2695754095492346, - 3.2939236257689597, - 3.3182718419886847, - 3.34262005820841, - 3.366968274428135, - 3.39131649064786, - 3.415664706867585, - 3.44001292308731, - 3.464361139307035, - 3.48870935552676, - 3.513057571746485, - 3.53740578796621, - 3.5617540041859352, - 3.5861022204056603, - 3.6104504366253853, - 3.6347986528451104, - 3.685740908915245, - 3.715361332546349, - 3.7449817561774528, - 3.7746021798085567, - 3.8042226034396607, - 3.8338430270707646, - 3.8634634507018686, - 3.8930838743329725, - 3.9227042979640765, - 3.9523247215951804, - 3.9973989051402543, - 4.042473088685329, - 4.0875472722304025, - 4.17192700353129, - 4.256306734832178, - 4.340686466133065, - 4.425066197433953, - 4.5094459287348405, - 4.652662634360083, - 4.7958793399853255, - 4.939096045610568, + 0.10095639241471274, + 0.10191278482942437, + 0.10396730915452722, + 0.10602183347963007, + 0.10807635780473292, + 0.1117756829145787, + 0.1238073182751872, + 0.12972869680759555, + 0.1356500753400039, + 0.14157145387241224, + 0.1509486486742028, + 0.16032584347599335, + 0.1697030382777839, + 0.18475624661375703, + 0.19980945494973015, + 0.21486266328570328, + 0.2299158716216764, + 0.24496907995764952, + 0.26002228829362267, + 0.2750754966295958, + 0.29822042988818964, + 0.3213653631467835, + 0.34451029640537734, + 0.3676552296639712, + 0.39080016292256503, + 0.4139450961811589, + 0.4370900294397527, + 0.4602349626983466, + 0.49562321303773194, + 0.5310114633771172, + 0.5663997137165026, + 0.6017879640558879, + 0.6371762143952732, + 0.6725644647346585, + 0.7079527150740438, + 0.7433409654134291, + 0.7787292157528144, + 0.8141174660921997, + 0.8362639250072751, + 0.8584103839223505, + 0.8805568428374259, + 0.895526605266569, + 0.9104963676957122, + 0.9254661301248553, + 0.9404358925539985, + 0.9554056549831417, + 0.9703754174122848, + 0.985345179841428, + 1.0003149422705713, + 1.0152847046997144, + 1.0302544671288576, + 1.0452242295580008, + 1.060193991987144, + 1.075163754416287, + 1.0901335168454303, + 1.1051032792745734, + 1.1200730417037166, + 1.1350428041328597, + 1.150012566562003, + 1.164982328991146, + 1.1799520914202892, + 1.1949218538494324, + 1.2098916162785756, + 1.2248613787077187, + 1.2398311411368619, + 1.254800903566005, + 1.2697706659951482, + 1.2847404284242914, + 1.2997101908534345, + 1.3236202939969726, + 1.3475303971405106, + 1.3714405002840486, + 1.4085108339544852, + 1.4455811676249217, + 1.4826515012953583, + 1.5197218349657948, + 1.5567921686362314, + 1.593862502306668, + 1.658032265176383, + 1.7222020280460981, + 1.7863717909158132, + 1.8505415537855283, + 1.9147113166552434, + 1.9788810795249585, + 2.0430508423946736, + 2.1072206052643887, + 2.171390368134104, + 2.235560131003819, + 2.352572808782798, + 2.469585486561777, + 2.586598164340756, + 2.703610842119735, + 2.7713965900387527, + 2.8391823379577703, + 2.906968085876788, + 2.9747538337958055, + 3.042539581714823, + 3.1103253296338407, + 3.155077956246997, + 3.1998305828601534, + 3.24458320947331, + 3.289335836086466, + 3.3340884626996226, + 3.378841089312779, + 3.4093522468826163, + 3.4398634044524536, + 3.470374562022291, + 3.5008857195921284, + 3.5313968771619657, + 3.561908034731803, + 3.5924191923016404, + 3.6229303498714778, + 3.653441507441315, + 3.6839526650111525, + 3.71446382258099, + 3.744974980150827, + 3.8098420398636605, + 3.874709099576494, + 3.917793537928994, + 3.960877976281494, + 4.003962414633994, + 4.047046852986495, + 4.1187153320583105, + 4.190383811130126, + 4.262052290201942, + 4.333720769273758, + 4.405389248345574, + 4.524688272996024, + 4.643987297646475, + 4.842006361424335, 5.0 ], "v": [ -65.0, -64.76421420008288, - -64.52947640906834, - -63.98495583648082, - -63.44537689259295, - -62.911060045517914, - -62.00702142543469, - -59.21888431820922, - -57.865318135480315, - -56.54595375232454, - -55.2590124941819, - -53.36818794781773, - -51.54283802507739, - -49.777791719535436, - -47.002860779306864, - -44.35734446696438, - -41.823434407041866, - -41.198512706846024, - -41.198512706846024, - -41.298446125022, - -41.39733757076499, - -41.62535272566281, - -41.84843096682458, - -42.06625960341608, - -42.43309427043536, - -43.47011732213717, - -43.92995559854171, - -44.358930118649695, - -44.758691636700846, - -45.13080159856515, - -45.476734797158926, - -46.08528901337663, - -46.6077081606387, - -47.05256052797603, - -47.4280259376114, - -47.88075081946406, - -48.211438813963774, - -48.43823733701573, - -48.575825489629125, - -48.63608347077714, - -48.628546287408284, - -48.560805882282324, - -48.43880451313948, - -48.26706855048568, - -48.04889509601082, - -47.6115754927354, - -47.0662430634791, - -46.41232351428716, - -45.6437367343486, - -44.74973847477336, - -43.71468606709284, - -42.517813786979254, - -41.131944084662386, - -39.52222353732754, - -37.6442017462701, - -35.44182769325116, - -32.844956767967226, - -29.76728435458211, - -26.105471283989385, - -21.742335996926542, - -16.560217729058447, - -12.409074271620517, - -7.801544195811291, - -2.7612827386348755, - 2.6425911841302447, - 6.563284211007511, - 10.536297449299509, - 14.486240731172513, - 18.329917054105383, - 21.982468792134643, - 25.36531043155885, - 28.414613222300076, - 31.085835680591025, - 33.35772550691209, - 35.23214573750054, - 36.73021051862406, - 37.8866730725838, - 38.74418100310368, - 39.34815799662136, - 39.742713738358134, - 39.96783273508006, - 40.057865153338795, - 40.041089687747565, - 39.94000051284745, - 39.63484683583312, - 39.20169890221466, - 38.67222629584908, - 38.066883560003895, - 37.399624450494485, - 36.67940224906042, - 35.911735616690606, - 35.10065045536399, - 34.2498065479678, - 33.36262208742448, - 31.84540609972063, - 31.252721636873556, - 30.649508612699794, - 29.502018033143035, - 27.666873702784322, - 25.769999340899616, - 23.82313536223553, - 21.837970599257012, - 18.3488512758876, - 14.816034567655523, - 12.877432062559807, - 10.937929533572225, - 9.003318140882783, - 7.077424920229746, - 5.1624754231869066, - 3.260332939400946, - 0.1895881926295892, - -5.526721403408522, - -8.607239076585477, - -11.63194928582485, - -14.603399058001509, - -17.525437389088097, - -20.403899121435096, - -23.24731240484925, - -26.06783205191934, - -28.882053080548832, - -31.714788339499375, - -34.591693157820075, - -36.4310994498348, - -38.31442777444443, - -40.25323594934186, - -42.260331296034906, - -44.34967143547101, - -46.53468410191945, - -48.826261748605766, - -51.230144625761426, - -53.741565030330214, - -56.34338267768542, - -57.95161712819298, - -59.569916683013766, - -61.183152767512865, - -62.77350046579418, - -64.32123737127782, - -65.80586644343762, - -67.20750249493067, - -68.50848388957937, - -69.69491218452622, - -70.75820220527268, - -71.69422534383737, - -72.50456456394109, - -73.19549056192177, - -73.77658791411562, - -74.25938456042158, - -74.65623785741127, - -74.97944183225773, - -75.46552533494871, - -75.6595844676443, - -75.80616696808835, - -75.91587893960971, - -75.99712788877147, - -76.05657117935695, - -76.09940695394313, - -76.12961265165961, - -76.15019881030922, - -76.16343859270837, - -76.17326654582294, - -76.17439463526566, - -76.16954192822693, - -76.15079338478047, - -76.1244169519833, - -76.09173690156574, - -76.05518453961476, - -76.01813253381333, - -75.95369311532802, - -75.88702679326961, - -75.81608443089125, - -75.78420221814488 + -64.52947254567428, + -64.022625498137, + -63.52005917645368, + -63.02206514907472, + -62.153176123351415, + -59.5345481751247, + -58.17829541573205, + -56.856401289132435, + -55.56707202073047, + -53.48157168896621, + -51.4754474422978, + -49.54187734151502, + -47.67440610353771, + -44.897553181179696, + -42.245036872492385, + -41.19828423472763, + -41.19828423472763, + -41.29821869323342, + -41.39711641304378, + -41.60641738232262, + -41.811566192552135, + -42.012281810946, + -42.362464145559926, + -43.408191551310246, + -43.87162401301964, + -44.303993081483746, + -44.7070004967657, + -45.288953626641685, + -45.80663928495675, + -46.26552424512782, + -46.891495822890676, + -47.39703843979254, + -47.79797549621721, + -48.10772584394654, + -48.33771638826647, + -48.49767838574658, + -48.59586097844589, + -48.641731335602536, + -48.57783079378015, + -48.41899608471908, + -48.175603922386166, + -47.85414928837932, + -47.45821947828357, + -46.98888181620015, + -46.444974306860225, + -45.46102804823806, + -44.272257639110535, + -42.84378492086666, + -41.126076665299394, + -39.050915538846226, + -36.52577315890279, + -33.42692105724293, + -29.592332375529182, + -24.81832226502048, + -18.870997854976466, + -14.448783396901883, + -9.446295840316143, + -3.8751218057723813, + 0.17793703384608356, + 4.408376832107902, + 8.744965894031587, + 13.096449824942004, + 17.356582258892324, + 21.413190025861873, + 25.16027424393428, + 28.510542999053214, + 31.405249129171267, + 33.81895408677367, + 35.75845339920369, + 37.25683084687716, + 38.364746426187125, + 39.14129108700444, + 39.6462140842486, + 39.93446185919456, + 40.053154850986346, + 40.04058825524428, + 39.9266548368526, + 39.73380993012293, + 39.47863691889179, + 39.173270500490126, + 38.826484593682416, + 38.444564381123165, + 38.03203920818988, + 37.592252295360105, + 37.12775142407457, + 36.64053936127587, + 35.81921893680831, + 34.94932340936043, + 34.03520356485248, + 32.5394198481864, + 30.959993610158598, + 29.30758325753142, + 27.592770515044005, + 25.825651077017554, + 24.015360688739207, + 20.80308891750128, + 17.523435053122594, + 14.209087370118471, + 10.886766512101925, + 7.5782142854265215, + 4.298027594062349, + 1.0573725742286388, + -2.134680890542512, + -5.272765048368741, + -8.355457753620898, + -13.834601879816784, + -19.14715665417126, + -24.333450989025398, + -29.459364029613607, + -32.45433960286614, + -35.51570630403499, + -38.6844399851956, + -42.015432783552825, + -45.57538023891547, + -49.42475527515563, + -52.14100096658002, + -54.985656708441375, + -57.9250139670072, + -60.895014933401114, + -63.798409053590355, + -66.51434831390789, + -68.19409051169313, + -69.6988015676237, + -71.01005202677155, + -72.12210157311978, + -73.04132193007528, + -73.78427506585118, + -74.37316214442062, + -74.83236749038804, + -75.18568613779475, + -75.45470431314999, + -75.65755277320167, + -75.80900498865687, + -76.0127041345277, + -76.11662224768564, + -76.15129394300578, + -76.1688829076698, + -76.17568379648955, + -76.17538030322933, + -76.16509171319096, + -76.14675249438541, + -76.12279557805671, + -76.09527102014067, + -76.0658430553171, + -76.01434826018226, + -75.95999497595469, + -75.86412754138561, + -75.78223890638951 ] }, "Cell[1]": { @@ -3575,347 +3527,305 @@ 0.0, 0.0007893817721078212, 0.0015787635442156423, - 0.003422478628235086, - 0.00526619371225453, - 0.007109908796273974, - 0.010271861410657116, - 0.020364350733288607, - 0.025463892160995642, - 0.030563433588702678, - 0.03566297501640971, - 0.04338543095615344, - 0.05110788689589715, - 0.05883034283564087, - 0.07148713771988026, - 0.08414393260411965, - 0.09680072748835904, + 0.0032940962863290593, + 0.005009429028442477, + 0.006724761770555894, + 0.009756363489589855, + 0.01919459525370049, + 0.024273735450643888, + 0.02935287564758729, + 0.03443201584453069, + 0.04291549730970577, + 0.05139897877488085, + 0.05988246024005593, + 0.06836594170523101, + 0.08151219145461693, + 0.09465844120400284, 0.09999999999999779, 0.10000000000000112, - 0.10095640317974434, - 0.10191280635948757, - 0.1041541437766779, - 0.10639548119386821, - 0.10863681861105853, - 0.11254071227140908, - 0.1245760568857235, - 0.13050429542101094, - 0.13643253395629837, - 0.1423607724915858, - 0.14828901102687322, - 0.15421724956216065, - 0.1658544639373996, - 0.17749167831263857, - 0.18912889268787753, - 0.20076610706311648, - 0.2184167287220536, - 0.2360673503809907, - 0.2537179720399278, - 0.2713685936988649, - 0.289019215357802, - 0.3066698370167391, - 0.3243204586756762, - 0.3419710803346133, - 0.3596217019935504, - 0.37727232365248753, - 0.4053254288027655, - 0.4333785339530435, - 0.46143163910332147, - 0.48948474425359945, - 0.5175378494038775, - 0.5455909545541555, - 0.5736440597044336, - 0.6016971648547116, - 0.6297502700049896, - 0.6578033751552677, - 0.6858564803055457, - 0.7139095854558237, - 0.7419626906061018, - 0.7700157957563798, - 0.7980689009066578, - 0.8261220060569359, - 0.8456853040561582, - 0.8652486020553805, - 0.8848119000546028, - 0.904375198053825, - 0.9180277908964931, - 0.9316803837391612, - 0.9453329765818292, - 0.9589855694244973, - 0.9726381622671654, - 0.9862907551098334, - 0.9999433479525015, - 1.0135959407951696, - 1.0272485336378376, - 1.0409011264805057, - 1.0545537193231738, - 1.0682063121658418, - 1.08185890500851, - 1.095511497851178, - 1.109164090693846, - 1.122816683536514, - 1.1364692763791822, - 1.1501218692218502, - 1.1637744620645183, - 1.1862420911672444, - 1.2087097202699706, - 1.2311773493726967, - 1.2536449784754229, - 1.276112607578149, - 1.2985802366808752, - 1.3210478657836013, - 1.3435154948863275, - 1.3659831239890536, - 1.3884507530917798, - 1.4250960696862285, - 1.4389131664769423, - 1.4527302632676562, - 1.4784254212523666, - 1.5182100253163118, - 1.557994629380257, - 1.597779233444202, - 1.6375638375081472, - 1.70613285848363, - 1.7747018794591127, - 1.8121446404729922, - 1.8495874014868716, - 1.887030162500751, - 1.9244729235146305, - 1.96191568452851, - 1.9993584455423894, - 2.0604374671880077, - 2.1766662978652707, - 2.240910170317285, - 2.3051540427692996, - 2.369397915221314, - 2.4336417876733285, - 2.497885660125343, - 2.5621295325773574, - 2.626373405029372, - 2.6906172774813863, - 2.754861149933401, - 2.8191050223854153, - 2.859282417857852, - 2.899459813330289, - 2.939637208802726, - 2.979814604275163, - 3.0199919997476, - 3.060169395220037, - 3.1003467906924738, - 3.1405241861649107, - 3.1807015816373476, - 3.2208789771097845, - 3.2452271933295096, - 3.2695754095492346, - 3.2939236257689597, - 3.3182718419886847, - 3.34262005820841, - 3.366968274428135, - 3.39131649064786, - 3.415664706867585, - 3.44001292308731, - 3.464361139307035, - 3.48870935552676, - 3.513057571746485, - 3.53740578796621, - 3.5617540041859352, - 3.5861022204056603, - 3.6104504366253853, - 3.6347986528451104, - 3.685740908915245, - 3.715361332546349, - 3.7449817561774528, - 3.7746021798085567, - 3.8042226034396607, - 3.8338430270707646, - 3.8634634507018686, - 3.8930838743329725, - 3.9227042979640765, - 3.9523247215951804, - 3.9973989051402543, - 4.042473088685329, - 4.0875472722304025, - 4.17192700353129, - 4.256306734832178, - 4.340686466133065, - 4.425066197433953, - 4.5094459287348405, - 4.652662634360083, - 4.7958793399853255, - 4.939096045610568, + 0.10095639241471274, + 0.10191278482942437, + 0.10396730915452722, + 0.10602183347963007, + 0.10807635780473292, + 0.1117756829145787, + 0.1238073182751872, + 0.12972869680759555, + 0.1356500753400039, + 0.14157145387241224, + 0.1509486486742028, + 0.16032584347599335, + 0.1697030382777839, + 0.18475624661375703, + 0.19980945494973015, + 0.21486266328570328, + 0.2299158716216764, + 0.24496907995764952, + 0.26002228829362267, + 0.2750754966295958, + 0.29822042988818964, + 0.3213653631467835, + 0.34451029640537734, + 0.3676552296639712, + 0.39080016292256503, + 0.4139450961811589, + 0.4370900294397527, + 0.4602349626983466, + 0.49562321303773194, + 0.5310114633771172, + 0.5663997137165026, + 0.6017879640558879, + 0.6371762143952732, + 0.6725644647346585, + 0.7079527150740438, + 0.7433409654134291, + 0.7787292157528144, + 0.8141174660921997, + 0.8362639250072751, + 0.8584103839223505, + 0.8805568428374259, + 0.895526605266569, + 0.9104963676957122, + 0.9254661301248553, + 0.9404358925539985, + 0.9554056549831417, + 0.9703754174122848, + 0.985345179841428, + 1.0003149422705713, + 1.0152847046997144, + 1.0302544671288576, + 1.0452242295580008, + 1.060193991987144, + 1.075163754416287, + 1.0901335168454303, + 1.1051032792745734, + 1.1200730417037166, + 1.1350428041328597, + 1.150012566562003, + 1.164982328991146, + 1.1799520914202892, + 1.1949218538494324, + 1.2098916162785756, + 1.2248613787077187, + 1.2398311411368619, + 1.254800903566005, + 1.2697706659951482, + 1.2847404284242914, + 1.2997101908534345, + 1.3236202939969726, + 1.3475303971405106, + 1.3714405002840486, + 1.4085108339544852, + 1.4455811676249217, + 1.4826515012953583, + 1.5197218349657948, + 1.5567921686362314, + 1.593862502306668, + 1.658032265176383, + 1.7222020280460981, + 1.7863717909158132, + 1.8505415537855283, + 1.9147113166552434, + 1.9788810795249585, + 2.0430508423946736, + 2.1072206052643887, + 2.171390368134104, + 2.235560131003819, + 2.352572808782798, + 2.469585486561777, + 2.586598164340756, + 2.703610842119735, + 2.7713965900387527, + 2.8391823379577703, + 2.906968085876788, + 2.9747538337958055, + 3.042539581714823, + 3.1103253296338407, + 3.155077956246997, + 3.1998305828601534, + 3.24458320947331, + 3.289335836086466, + 3.3340884626996226, + 3.378841089312779, + 3.4093522468826163, + 3.4398634044524536, + 3.470374562022291, + 3.5008857195921284, + 3.5313968771619657, + 3.561908034731803, + 3.5924191923016404, + 3.6229303498714778, + 3.653441507441315, + 3.6839526650111525, + 3.71446382258099, + 3.744974980150827, + 3.8098420398636605, + 3.874709099576494, + 3.917793537928994, + 3.960877976281494, + 4.003962414633994, + 4.047046852986495, + 4.1187153320583105, + 4.190383811130126, + 4.262052290201942, + 4.333720769273758, + 4.405389248345574, + 4.524688272996024, + 4.643987297646475, + 4.842006361424335, 5.0 ], "v": [ -65.0, -64.99904971205022, - -64.99717717353015, - -64.98951712452799, - -64.97752163987603, - -64.96091839481339, - -64.92169473230472, - -64.71206617079324, - -64.55838144525197, - -64.37539787645551, - -64.16481167484434, - -63.7968550829351, - -63.373974662345596, - -62.90096398429448, - -62.02857771619854, - -61.05041620070589, - -59.981126093123116, - -59.69808855513496, - -59.69808855513496, - -59.61367704225931, - -59.53018908534162, - -59.33783220272969, - -59.149815099948896, - -58.96638953865862, - -58.65780965061497, - -57.78613347071198, - -57.39978393027075, - -57.03880776513495, - -56.70141602069599, - -56.385943952334266, - -56.090836371060966, - -55.56489287391181, - -55.102203304276735, - -54.694000335814245, - -54.3320417679672, - -53.855848739039814, - -53.448907785469, - -53.09351261711826, - -52.77535111815305, - -52.482700414821025, - -52.205895068774765, - -51.936895097315166, - -51.668963531004124, - -51.39640050332589, - -51.11432060839794, - -50.636094114197434, - -50.108373375922184, - -49.51740691890731, - -48.85010873249784, - -48.09257859033705, - -47.22924091626363, - -46.24145253038025, - -45.10642174370257, - -43.79562866458008, - -42.27314338479341, - -40.493199416192816, - -38.39729435823711, - -35.910468015894324, - -32.93730401583728, - -29.358217614099967, - -25.02914777739994, - -21.480229947449576, - -17.432872204769456, - -12.84424087314773, - -7.695248876814925, - -3.781591423838735, - 0.36284707805211397, - 4.6875417278374725, - 9.119490078019032, - 13.563787615959253, - 17.909064030199097, - 22.03829827833126, - 25.840631178511835, - 29.226129590840344, - 32.137069681795815, - 34.552396602822554, - 36.48548090806752, - 37.97671786131499, - 39.08335459581087, - 39.869212275225976, - 40.39645587517342, - 40.72039235540714, - 40.8871244593061, - 40.93326249645885, - 40.81837422718299, - 40.53626992404279, - 40.13568333290077, - 39.645106254781574, - 39.082752563338964, - 38.460200608963746, - 37.78456646303734, - 37.06064307546757, - 36.29233952968763, - 35.483141715591486, - 34.08369608198712, - 33.532339508498744, - 32.96880089096263, - 31.89086936976822, - 30.15287311161293, - 28.340209910196467, - 26.465334060846043, - 24.541083005948035, - 21.13099413802547, - 17.650508788035122, - 15.728479109363503, - 13.79858350082314, - 11.868098919666291, - 9.941352229559472, - 8.02089013685794, - 6.108932116128345, - 3.0142204854166437, - -2.7688852681522675, - -5.89474340516657, - -8.968930487078238, - -11.992596444763183, - -14.968401975913975, - -17.900836593176706, - -20.79703049444748, - -23.667352489398837, - -26.52642503111697, - -29.396861347849423, - -32.30205900924603, - -34.15392752898534, - -36.045555550869125, - -37.98901303475342, - -39.998154187919, - -42.089106892207006, - -44.278639012764174, - -46.58283323887954, - -49.0145672729365, - -51.579129748075545, - -54.26980994269659, - -55.95354537903262, - -57.66602455105605, - -59.39324987837098, - -61.11716070101707, - -62.81612337510371, - -64.46588770817074, - -66.04112834460861, - -67.51754375209553, - -68.87420396975206, - -70.0959444892046, - -71.17378570148223, - -72.10609311542918, - -72.89807043116159, - -73.56000838130612, - -74.10545094842354, - -74.54948306321171, - -74.90733377821488, - -75.43688348353403, - -75.6447677684372, - -75.79997532174224, - -75.91496491794535, - -75.99937525991913, - -76.06068238062367, - -76.10459450655637, - -76.13540493067742, - -76.1563160552946, - -76.16971803818653, - -76.1796220388661, - -76.18075026953838, - -76.17588574167151, - -76.15715012331412, - -76.13079620602632, - -76.09820004977047, - -76.06164927202202, - -76.02463832679481, - -75.9602341446575, - -75.89328728192429, - -75.82246782287712, - -75.79064801770951 + -64.99718129050467, + -64.99026809844628, + -64.97959945187262, + -64.96492505863912, + -64.9291674724393, + -64.7428323184306, + -64.59672574633055, + -64.42113984575676, + -64.21778932829791, + -63.8205963743522, + -63.35677994321457, + -62.83267413818679, + -62.25413877649007, + -61.26186121443971, + -60.16807650878812, + -59.69827628600249, + -59.69827628600249, + -59.61386361435488, + -59.53036941854299, + -59.35378872448493, + -59.18085955144615, + -59.01181226582528, + -58.71717765222444, + -57.83810715462726, + -57.448784801656785, + -57.085051597069636, + -56.745076204041695, + -56.25123789400428, + -55.80708443520983, + -55.40693726302065, + -54.84405890985066, + -54.36297306656959, + -53.947884385393195, + -53.585570238738796, + -53.264857726554006, + -52.976248554510896, + -52.71165077399567, + -52.3362685143783, + -51.980907225162916, + -51.62924616063698, + -51.26832212929025, + -50.88772382088573, + -50.47854925715617, + -50.03284959529747, + -49.54311842495861, + -48.69199857212902, + -47.691814442089566, + -46.50915870993949, + -45.10158726034201, + -43.41319674792064, + -41.36899064765108, + -38.86711498517919, + -35.768539408719626, + -31.884795952063428, + -26.967564797583886, + -23.22997050216354, + -18.88733636789879, + -13.868741067515128, + -10.070120564298069, + -5.946788976472861, + -1.5240279697045773, + 3.1458932858469044, + 7.97882798988835, + 12.858165073094092, + 17.641204263382708, + 22.173485602825252, + 26.3092494197451, + 29.933154324775757, + 32.97680362722059, + 35.42490840769177, + 37.3097795304873, + 38.69723144155403, + 39.66948555363508, + 40.3102762091474, + 40.694981182628304, + 40.88598875977458, + 40.93199101157329, + 40.869231926081696, + 40.72390376581798, + 40.51459514701051, + 40.25430843250599, + 39.952056785065125, + 39.61411308473947, + 39.24492929553997, + 38.84775823343555, + 38.425054095290385, + 37.70165106099082, + 36.923927606551295, + 36.09655956053041, + 34.725100082336745, + 33.25820955872299, + 31.706559792599727, + 30.081183416143016, + 28.39264610898679, + 26.65044933853648, + 23.532421841950846, + 20.31928272583736, + 17.04712495369028, + 13.746334049285387, + 10.442406607173789, + 7.15188395046705, + 3.8884763559143987, + 0.6644369644903177, + -2.512679475227458, + -5.640017905956912, + -11.21077591978988, + -16.621259761043646, + -21.90343134774417, + -27.112540972917206, + -30.14557265915401, + -33.23427432236745, + -36.41810593746848, + -39.75442535715846, + -43.31855733954644, + -47.189416313632734, + -49.94427741787519, + -52.86265232092451, + -55.92625810498488, + -59.083438415770914, + -62.23936861924056, + -65.25872838552614, + -67.15843082928576, + -68.87794223745817, + -70.38562743041118, + -71.66612580013492, + -72.72123772867945, + -73.56787501602274, + -74.23221361209498, + -74.74412470476085, + -75.1329518235252, + -75.42509612096707, + -75.6426006517115, + -75.80311732106836, + -76.01607568826525, + -76.12324059594931, + -76.15807661795547, + -76.17542393648546, + -76.18204300604081, + -76.18173544175711, + -76.1715846878378, + -76.15325997958399, + -76.12918031420314, + -76.10158287342368, + -76.07214765874849, + -76.02088213831466, + -75.96673189386004, + -75.87086105432375, + -75.7888059780194 ] } } diff --git a/test/pytest_coreneuron/test_nrntest_fast.py b/test/pytest_coreneuron/test_nrntest_fast.py index 0cde7ad95d..9e416650f3 100644 --- a/test/pytest_coreneuron/test_nrntest_fast.py +++ b/test/pytest_coreneuron/test_nrntest_fast.py @@ -2,6 +2,7 @@ Tests that used to live in the fast/ subdirectory of the https://github.com/neuronsimulator/nrntest repository """ + import os import math @@ -9,6 +10,8 @@ import pytest from neuron import h + +h.use_exp_pow_precision(1) # help with mac identity to linux. see issue 3123 from neuron.tests.utils import ( cvode_enabled, cvode_use_global_timestep, @@ -22,12 +25,41 @@ h.load_file("stdrun.hoc") +# Sundials specific tolerances +cv2tol = { + "t13:cvode:t": 5e-8, + "t13:cvode:v": 6e-7, + "t14:cvode:t:1": 8e-10, + "t14:cvode:t:2:ld": 2e-10, + "t14:cvode:t:2": 8e-10, + "t14:cvode:v:1": 2e-9, + "t14:cvode:v:2:ld": 4e-10, + "t14:cvode:v:2": 2e-9, +} +cv3tol = { + "t13:cvode:t": 2e-6, + "t13:cvode:v": 6e-7, + "t14:cvode:t:1": 1e-9, + "t14:cvode:t:2:ld": 1e-9, + "t14:cvode:t:2": 1e-9, + "t14:cvode:v:1": 6e-9, + "t14:cvode:v:2:ld": 1e-9, + "t14:cvode:v:2": 4e-9, +} +cvtol = cv2tol + @pytest.fixture(scope="module") def chk(): """Manage access to JSON reference data.""" dir_path = os.path.dirname(os.path.realpath(__file__)) - checker = Chk(os.path.join(dir_path, "test_nrntest_fast.json")) + fname = "test_nrntest_fast.json" + if True: + if h.CVode().version().split(".")[0] == "3": + global cvtol + cvtol = cv3tol + + checker = Chk(os.path.join(dir_path, fname)) yield checker # Save results to disk if they've changed; this is called after all tests # using chk have executed @@ -92,12 +124,13 @@ def t13_model_data(request): # cvode_use_global_timestep takes care of enabling global # synchronisation of the variable timestep method across ranks # even though the cells have no connectivity - with hh_table_disabled(), parallel_context() as pc, num_threads( - pc, threads=threads - ), cvode_enabled(method.startswith("cvode")) as cv, cvode_use_global_timestep( - cv, True - ), cvode_use_long_double( - cv, method == "cvode_long_double" + with ( + hh_table_disabled(), + parallel_context() as pc, + num_threads(pc, threads=threads), + cvode_enabled(method.startswith("cvode")) as cv, + cvode_use_global_timestep(cv, True), + cvode_use_long_double(cv, method == "cvode_long_double"), ): h.run() data[threads] = {str(cell): cell.data() for cell in cells} @@ -218,7 +251,7 @@ def test_t13(chk, t13_model_data, field, threads): tolerance = 1e-10 elif method.startswith("cvode"): if field == "t": - tolerance = 5e-8 + tolerance = cvtol["t13:cvode:t"] # NVHPC has a different tolerance threshold if get_c_compiler().endswith("nvc"): tolerance = 6.1e-8 @@ -261,10 +294,12 @@ def t14_model_data(request): i: CellWithGapJunction(i) for i in range(n_cells) if i % num_ranks == this_rank } for threads in thread_values: - with hh_table_disabled(), parallel_context() as pc, num_threads( - pc, threads=threads - ), cvode_enabled(method.startswith("cvode")) as cv, cvode_use_long_double( - cv, method == "cvode_long_double" + with ( + hh_table_disabled(), + parallel_context() as pc, + num_threads(pc, threads=threads), + cvode_enabled(method.startswith("cvode")) as cv, + cvode_use_long_double(cv, method == "cvode_long_double"), ): for i in range(n_cells): next_i = (i + 1) % n_cells @@ -296,26 +331,26 @@ def test_t14(chk, t14_model_data, field, threads): elif method.startswith("cvode"): if field == "t": if threads == 1: - tolerance = 8e-10 + tolerance = cvtol["t14:cvode:t:1"] # NVHPC has a different tolerance threshold if get_c_compiler().endswith("nvc"): tolerance = 1e-9 else: if "long_double" in method: - tolerance = 2e-10 + tolerance = cvtol["t14:cvode:t:2:ld"] else: - tolerance = 8e-10 + tolerance = cvtol["t14:cvode:t:2"] elif field == "v": if threads == 1: - tolerance = 2e-9 + tolerance = cvtol["t14:cvode:v:1"] else: if "long_double" in method: - tolerance = 4e-10 + tolerance = cvtol["t14:cvode:v:2:ld"] # NVHPC has a different tolerance threshold if get_c_compiler().endswith("nvc"): tolerance = 6e-10 else: - tolerance = 2e-9 + tolerance = cvtol["t14:cvode:v:2"] compare_time_and_voltage_trajectories( chk, t14_model_data, field, threads, "t14", tolerance diff --git a/test/rxd/compare_rxd_dat.py b/test/rxd/compare_rxd_dat.py new file mode 100755 index 0000000000..f26d098556 --- /dev/null +++ b/test/rxd/compare_rxd_dat.py @@ -0,0 +1,85 @@ +#!/usr/bin/env python3 +import sys +import os +import argparse +import numpy as np +import matplotlib.pyplot as plt + + +def load_dat(filepath): + """Load RxD .dat binary file (typically float64, possibly with metadata)""" + try: + data = np.fromfile(filepath, dtype=np.float64) + print(f"Loaded {filepath}: {len(data)} floats") + return data + except Exception as e: + print(f"Error loading {filepath}: {e}") + return None + + +def compare_two_files(file1, file2, title="RxD Data Comparison", plot=True, tol=1e-10): + d1 = load_dat(file1) + d2 = load_dat(file2) + if d1 is None or d2 is None: + return + + min_len = min(len(d1), len(d2)) + diff = d1[:min_len] - d2[:min_len] + max_abs_diff = np.max(np.abs(diff)) + rms_diff = np.sqrt(np.mean(diff**2)) + mean_abs_diff = np.mean(np.abs(diff)) + + print( + f"\n=== Comparison: {os.path.basename(file1)} vs {os.path.basename(file2)} ===" + ) + print(f"Lengths: {len(d1)} vs {len(d2)}") + print(f"Max abs diff : {max_abs_diff:.2e}") + print(f"RMS diff : {rms_diff:.2e}") + print(f"Mean abs diff: {mean_abs_diff:.2e}") + print(f"Tolerance : {tol}") + + if max_abs_diff > tol: + print("X Differences exceed tolerance!") + else: + print("Within tolerance.") + + if plot: + plt.figure(figsize=(14, 10)) + + # Raw traces (downsampled) + step = max(1, min_len // 5000) # adaptive downsampling + plt.subplot(3, 1, 1) + plt.plot(d1[::step], label=os.path.basename(file1), alpha=0.85) + plt.plot(d2[::step], label=os.path.basename(file2), alpha=0.85) + plt.title(f"{title} - Traces (downsampled)") + plt.legend() + plt.grid(True) + + # Difference + plt.subplot(3, 1, 2) + plt.plot(diff[::step]) + plt.title("Pointwise Difference") + plt.grid(True) + + # Absolute diff (log) + plt.subplot(3, 1, 3) + plt.plot(np.abs(diff[::step])) + plt.axhline(tol, color="r", linestyle="--", label=f"Tol = {tol}") + plt.yscale("log") + plt.title("Absolute Difference (log scale)") + plt.legend() + plt.grid(True) + + plt.tight_layout() + plt.show() + + +if __name__ == "__main__": + parser = argparse.ArgumentParser(description="Compare two RxD .dat binary files") + parser.add_argument("file1", help="First .dat file") + parser.add_argument("file2", help="Second .dat file") + parser.add_argument("--no-plot", action="store_true") + parser.add_argument("--tol", type=float, default=1e-10) + args = parser.parse_args() + + compare_two_files(args.file1, args.file2, plot=not args.no_plot, tol=args.tol) diff --git a/test/rxd/compare_rxd_testdata_dirs.py b/test/rxd/compare_rxd_testdata_dirs.py new file mode 100755 index 0000000000..940229f358 --- /dev/null +++ b/test/rxd/compare_rxd_testdata_dirs.py @@ -0,0 +1,116 @@ +#!/usr/bin/env python3 +import sys +import os +import argparse +import hashlib +import subprocess +from pathlib import Path + + +def get_all_dat_files(dir1: Path, dir2: Path): + """Return union of .dat files from both directories (recursive).""" + files1 = {p.relative_to(dir1): p for p in dir1.rglob("*.dat")} + files2 = {p.relative_to(dir2): p for p in dir2.rglob("*.dat")} + + all_rel = sorted(set(files1.keys()) | set(files2.keys())) + return all_rel, files1, files2 + + +def files_differ(file1: Path, file2: Path) -> bool: + """Quick check if two files differ (size + hash).""" + if not file1.exists() or not file2.exists(): + return True + if file1.stat().st_size != file2.stat().st_size: + return True + with open(file1, "rb") as f1, open(file2, "rb") as f2: + return hashlib.md5(f1.read()).digest() != hashlib.md5(f2.read()).digest() + + +def main(): + parser = argparse.ArgumentParser( + description="Compare two RxD testdata directories pairwise" + ) + parser.add_argument( + "dir1", type=Path, help="First testdata directory (e.g. master)" + ) + parser.add_argument( + "dir2", type=Path, help="Second testdata directory (e.g. slds or new)" + ) + parser.add_argument( + "--compare-script", + type=Path, + default=Path("compare_rxd_dat.py"), + help="Path to compare_rxd_dat.py", + ) + parser.add_argument("--tol", type=float, default=1e-10) + parser.add_argument("--no-plot", action="store_true") + args = parser.parse_args() + + if not args.dir1.exists() or not args.dir2.exists(): + print("Error: One or both directories do not exist.") + sys.exit(1) + + compare_script = args.compare_script.resolve() + if not compare_script.exists(): + print(f"Error: {compare_script} not found. Please create it first.") + compare_script = Path(f"{os.path.dirname(__file__)}/compare_rxd_dat.py") + print(f" Trying: {compare_script}") + if not compare_script.exists(): + sys.exit(1) + + rel_files, files1, files2 = get_all_dat_files(args.dir1, args.dir2) + + print(f"Found {len(rel_files)} unique .dat files across both directories.\n") + + # Collect commands for differing pairs + commands = [] + missing = [] + for rel in rel_files: + f1 = files1.get(rel) + f2 = files2.get(rel) + + if f1 is None: + missing.append(f"Missing in dir1: {rel}") + continue + if f2 is None: + missing.append(f"Missing in dir2: {rel}") + continue + + if files_differ(f1, f2): + cmd = [str(compare_script), str(f1), str(f2), "--tol", str(args.tol)] + if args.no_plot: + cmd.append("--no-plot") + commands.append((rel, cmd)) + + # Report missing files + for m in missing: + print(f"X {m}") + if missing: + print() + + if not commands: + print("All corresponding files are identical (or no overlapping files).") + return + + print(f"Will compare {len(commands)} differing pairs.\n") + print("Commands that will be run:") + for _, cmd in commands: + print(" " + " ".join(cmd)) + print("\n" + "=" * 80) + + # Interactive loop + for i, (rel, cmd) in enumerate(commands, 1): + print(f"\n[{i}/{len(commands)}] Comparing: {rel}") + print("Running:", " ".join(cmd)) + + print( + "\nClose the matplot window to continue to next pair (or Ctrl+C to stop)..." + ) + try: + subprocess.run(cmd, check=True) + except subprocess.CalledProcessError as e: + print(f"Comparison script failed with exit code {e.returncode}") + + +if __name__ == "__main__": + main() diff --git a/test/rxd/hybrid/test_pure_diffusion_hybrid.py b/test/rxd/hybrid/test_pure_diffusion_hybrid.py index cd5bd2c02b..8fd2263103 100644 --- a/test/rxd/hybrid/test_pure_diffusion_hybrid.py +++ b/test/rxd/hybrid/test_pure_diffusion_hybrid.py @@ -35,9 +35,11 @@ def ics_diffusion_hybrid(neuron_instance): ca = rxd.Species( r, d=diff_constant, - initial=lambda node: 1 - if (0.8 < node.x and node in dend1) or (node.x < 0.2 and node in dend2) - else 0, + initial=lambda node: ( + 1 + if (0.8 < node.x and node in dend1) or (node.x < 0.2 and node in dend2) + else 0 + ), ) model = ([dend1, dend2, dend3], r, ca) yield (neuron_instance, model) diff --git a/test/rxd/testdata b/test/rxd/testdata index fb90febf33..b8d97dd92b 160000 --- a/test/rxd/testdata +++ b/test/rxd/testdata @@ -1 +1 @@ -Subproject commit fb90febf33a84798bdf78cac62a838736e255870 +Subproject commit b8d97dd92bcf3bf7a5a5a7f0fc10ba546b8a0825 diff --git a/test/rxd/testutils.py b/test/rxd/testutils.py index 55a6ead1b6..02849cb7d7 100644 --- a/test/rxd/testutils.py +++ b/test/rxd/testutils.py @@ -4,7 +4,6 @@ import numpy - tol = float(os.environ.get("NRN_RXD_TEST_TOLERANCE", "1e-10")) dt_eps = 1e-20