From 59635c70809e77dfc43de2cc17f24756de89080f Mon Sep 17 00:00:00 2001 From: koldo Date: Sun, 7 Jun 2020 10:23:55 +0000 Subject: [PATCH] sundials: Added package for non linear equations and differential algebraic equations solving git-svn-id: svn://ultimatepp.org/upp/trunk@14564 f0d560ea-af0d-0410-9eb7-867de7ffcac7 --- bazaar/plugin/sundials/include/ida/ida.h | 215 + .../plugin/sundials/include/ida/ida_bbdpre.h | 65 + .../plugin/sundials/include/ida/ida_direct.h | 61 + bazaar/plugin/sundials/include/ida/ida_ls.h | 137 + .../plugin/sundials/include/ida/ida_spils.h | 80 + .../plugin/sundials/include/kinsol/kinsol.h | 150 + .../sundials/include/kinsol/kinsol_bbdpre.h | 66 + .../sundials/include/kinsol/kinsol_direct.h | 59 + .../sundials/include/kinsol/kinsol_ls.h | 117 + .../sundials/include/kinsol/kinsol_spils.h | 73 + .../nvector/cuda/ThreadPartitioning.hpp | 386 ++ .../sundials/include/nvector/cuda/Vector.hpp | 371 ++ .../sundials/include/nvector/nvector_cuda.h | 189 + .../include/nvector/nvector_manyvector.h | 163 + .../sundials/include/nvector/nvector_openmp.h | 203 + .../include/nvector/nvector_openmpdev.h | 207 + .../sundials/include/nvector/nvector_raja.h | 166 + .../sundials/include/nvector/nvector_serial.h | 192 + .../include/nvector/nvector_trilinos.h | 141 + .../sundials/include/nvector/raja/Vector.hpp | 128 + .../sundials/include/sundials/sundials_band.h | 181 + .../include/sundials/sundials_config.h | 135 + .../include/sundials/sundials_dense.h | 212 + .../include/sundials/sundials_direct.h | 339 ++ .../include/sundials/sundials_fconfig.h | 51 + .../include/sundials/sundials_fnvector.h | 42 + .../include/sundials/sundials_futils.h | 38 + .../include/sundials/sundials_iterative.h | 263 ++ .../include/sundials/sundials_lapack.h | 256 ++ .../include/sundials/sundials_linearsolver.h | 204 + .../sundials/include/sundials/sundials_math.h | 193 + .../include/sundials/sundials_matrix.h | 135 + .../include/sundials/sundials_mpi_types.h | 39 + .../sundials/sundials_nonlinearsolver.h | 197 + .../include/sundials/sundials_nvector.h | 264 ++ .../sundials/sundials_nvector_senswrapper.h | 104 + .../include/sundials/sundials_types.h | 160 + .../include/sundials/sundials_version.h | 38 + .../include/sunlinsol/sunlinsol_band.h | 76 + .../sunlinsol/sunlinsol_cusolversp_batchqr.h | 111 + .../include/sunlinsol/sunlinsol_dense.h | 80 + .../include/sunlinsol/sunlinsol_lapackband.h | 87 + .../include/sunlinsol/sunlinsol_lapackdense.h | 87 + .../include/sunlinsol/sunlinsol_pcg.h | 113 + .../include/sunlinsol/sunlinsol_spbcgs.h | 120 + .../include/sunlinsol/sunlinsol_spfgmr.h | 132 + .../include/sunlinsol/sunlinsol_spgmr.h | 131 + .../include/sunlinsol/sunlinsol_sptfqmr.h | 122 + .../include/sunlinsol/sunlinsol_superludist.h | 119 + .../include/sunmatrix/sunmatrix_band.h | 129 + .../include/sunmatrix/sunmatrix_cusparse.h | 121 + .../include/sunmatrix/sunmatrix_dense.h | 105 + .../include/sunmatrix/sunmatrix_sparse.h | 146 + .../sunnonlinsol/sunnonlinsol_fixedpoint.h | 120 + .../sunnonlinsol/sunnonlinsol_newton.h | 111 + .../sunnonlinsol/sunnonlinsol_petscsnes.h | 97 + bazaar/plugin/sundials/src/ida/ida.c | 3488 +++++++++++++++++ bazaar/plugin/sundials/src/ida/ida_bbdpre.c | 665 ++++ .../plugin/sundials/src/ida/ida_bbdpre_impl.h | 88 + bazaar/plugin/sundials/src/ida/ida_direct.c | 56 + bazaar/plugin/sundials/src/ida/ida_ic.c | 704 ++++ bazaar/plugin/sundials/src/ida/ida_impl.h | 527 +++ bazaar/plugin/sundials/src/ida/ida_io.c | 1241 ++++++ bazaar/plugin/sundials/src/ida/ida_ls.c | 1587 ++++++++ bazaar/plugin/sundials/src/ida/ida_ls_impl.h | 195 + bazaar/plugin/sundials/src/ida/ida_nls.c | 286 ++ bazaar/plugin/sundials/src/ida/ida_spils.c | 81 + .../sundials/src/kinsol/fcmix/fkinbbd.h | 317 ++ .../sundials/src/kinsol/fcmix/fkinsol.h | 783 ++++ .../sundials/src/kinsol/fmod/fkinsol_mod.c | 1036 +++++ bazaar/plugin/sundials/src/kinsol/kinsol.c | 2702 +++++++++++++ .../sundials/src/kinsol/kinsol_bbdpre.c | 582 +++ .../sundials/src/kinsol/kinsol_bbdpre_impl.h | 82 + .../sundials/src/kinsol/kinsol_direct.c | 55 + .../plugin/sundials/src/kinsol/kinsol_impl.h | 489 +++ bazaar/plugin/sundials/src/kinsol/kinsol_io.c | 1073 +++++ bazaar/plugin/sundials/src/kinsol/kinsol_ls.c | 1332 +++++++ .../sundials/src/kinsol/kinsol_ls_impl.h | 184 + .../plugin/sundials/src/kinsol/kinsol_spils.c | 73 + .../manyvector/fmod/fnvector_manyvector_mod.c | 899 +++++ .../nvector/manyvector/nvector_manyvector.c | 1837 +++++++++ .../nvector/serial/fmod/fnvector_serial_mod.c | 945 +++++ .../src/nvector/serial/fnvector_serial.c | 154 + .../src/nvector/serial/fnvector_serial.h | 92 + .../src/nvector/serial/nvector_serial.c | 2117 ++++++++++ .../src/sundials/fmod/fsundials_futils_mod.c | 255 ++ .../fmod/fsundials_linearsolver_mod.c | 488 +++ .../src/sundials/fmod/fsundials_matrix_mod.c | 357 ++ .../fmod/fsundials_nonlinearsolver_mod.c | 401 ++ .../src/sundials/fmod/fsundials_nvector_mod.c | 921 +++++ .../src/sundials/fmod/fsundials_types_mod.c | 219 ++ .../sundials/src/sundials/sundials_band.c | 264 ++ .../sundials/src/sundials/sundials_cuda.h | 101 + .../sundials/src/sundials/sundials_debug.h | 40 + .../sundials/src/sundials/sundials_dense.c | 400 ++ .../sundials/src/sundials/sundials_direct.c | 355 ++ .../sundials/src/sundials/sundials_futils.c | 29 + .../src/sundials/sundials_iterative.c | 298 ++ .../src/sundials/sundials_linearsolver.c | 209 + .../sundials/src/sundials/sundials_math.c | 53 + .../sundials/src/sundials/sundials_matrix.c | 175 + .../src/sundials/sundials_nonlinearsolver.c | 214 + .../sundials/src/sundials/sundials_nvector.c | 763 ++++ .../sundials/sundials_nvector_senswrapper.c | 544 +++ .../sundials/src/sundials/sundials_version.c | 48 + .../sunlinsol/band/fmod/fsunlinsol_band_mod.c | 349 ++ .../src/sunlinsol/band/fsunlinsol_band.c | 96 + .../src/sunlinsol/band/fsunlinsol_band.h | 62 + .../src/sunlinsol/band/sunlinsol_band.c | 250 ++ .../dense/fmod/fsunlinsol_dense_mod.c | 349 ++ .../src/sunlinsol/dense/fsunlinsol_dense.c | 96 + .../src/sunlinsol/dense/fsunlinsol_dense.h | 62 + .../src/sunlinsol/dense/sunlinsol_dense.c | 234 ++ .../sunlinsol/pcg/fmod/fsunlinsol_pcg_mod.c | 495 +++ .../src/sunlinsol/pcg/fsunlinsol_pcg.c | 191 + .../src/sunlinsol/pcg/fsunlinsol_pcg.h | 80 + .../src/sunlinsol/pcg/sunlinsol_pcg.c | 497 +++ .../spbcgs/fmod/fsunlinsol_spbcgs_mod.c | 495 +++ .../src/sunlinsol/spbcgs/fsunlinsol_spbcgs.c | 191 + .../src/sunlinsol/spbcgs/fsunlinsol_spbcgs.h | 80 + .../src/sunlinsol/spbcgs/sunlinsol_spbcgs.c | 676 ++++ .../spfgmr/fmod/fsunlinsol_spfgmr_mod.c | 523 +++ .../src/sunlinsol/spfgmr/fsunlinsol_spfgmr.c | 241 ++ .../src/sunlinsol/spfgmr/fsunlinsol_spfgmr.h | 88 + .../src/sunlinsol/spfgmr/sunlinsol_spfgmr.c | 741 ++++ .../spgmr/fmod/fsunlinsol_spgmr_mod.c | 523 +++ .../src/sunlinsol/spgmr/fsunlinsol_spgmr.c | 241 ++ .../src/sunlinsol/spgmr/fsunlinsol_spgmr.h | 88 + .../src/sunlinsol/spgmr/sunlinsol_spgmr.c | 783 ++++ .../sptfqmr/fmod/fsunlinsol_sptfqmr_mod.c | 495 +++ .../sunlinsol/sptfqmr/fsunlinsol_sptfqmr.c | 191 + .../sunlinsol/sptfqmr/fsunlinsol_sptfqmr.h | 80 + .../src/sunlinsol/sptfqmr/sunlinsol_sptfqmr.c | 804 ++++ .../sunmatrix/band/fmod/fsunmatrix_band_mod.c | 485 +++ .../src/sunmatrix/band/fsunmatrix_band.c | 90 + .../src/sunmatrix/band/fsunmatrix_band.h | 62 + .../src/sunmatrix/band/sunmatrix_band.c | 489 +++ .../dense/fmod/fsunmatrix_dense_mod.c | 429 ++ .../src/sunmatrix/dense/fsunmatrix_dense.c | 83 + .../src/sunmatrix/dense/fsunmatrix_dense.h | 62 + .../src/sunmatrix/dense/sunmatrix_dense.c | 355 ++ .../sparse/fmod/fsunmatrix_sparse_mod.c | 541 +++ .../src/sunmatrix/sparse/fsunmatrix_sparse.c | 94 + .../src/sunmatrix/sparse/fsunmatrix_sparse.h | 65 + .../src/sunmatrix/sparse/sunmatrix_sparse.c | 1233 ++++++ .../fmod/fsunnonlinsol_fixedpoint_mod.c | 415 ++ .../fixedpoint/fsunnonlinsol_fixedpoint.c | 95 + .../fixedpoint/fsunnonlinsol_fixedpoint.h | 56 + .../fixedpoint/sunnonlinsol_fixedpoint.c | 700 ++++ .../newton/fmod/fsunnonlinsol_newton_mod.c | 425 ++ .../newton/fsunnonlinsol_newton.c | 95 + .../newton/fsunnonlinsol_newton.h | 56 + .../sunnonlinsol/newton/sunnonlinsol_newton.c | 460 +++ bazaar/plugin/sundials/sundials.upp | 231 ++ 154 files changed, 53353 insertions(+) create mode 100644 bazaar/plugin/sundials/include/ida/ida.h create mode 100644 bazaar/plugin/sundials/include/ida/ida_bbdpre.h create mode 100644 bazaar/plugin/sundials/include/ida/ida_direct.h create mode 100644 bazaar/plugin/sundials/include/ida/ida_ls.h create mode 100644 bazaar/plugin/sundials/include/ida/ida_spils.h create mode 100644 bazaar/plugin/sundials/include/kinsol/kinsol.h create mode 100644 bazaar/plugin/sundials/include/kinsol/kinsol_bbdpre.h create mode 100644 bazaar/plugin/sundials/include/kinsol/kinsol_direct.h create mode 100644 bazaar/plugin/sundials/include/kinsol/kinsol_ls.h create mode 100644 bazaar/plugin/sundials/include/kinsol/kinsol_spils.h create mode 100644 bazaar/plugin/sundials/include/nvector/cuda/ThreadPartitioning.hpp create mode 100644 bazaar/plugin/sundials/include/nvector/cuda/Vector.hpp create mode 100644 bazaar/plugin/sundials/include/nvector/nvector_cuda.h create mode 100644 bazaar/plugin/sundials/include/nvector/nvector_manyvector.h create mode 100644 bazaar/plugin/sundials/include/nvector/nvector_openmp.h create mode 100644 bazaar/plugin/sundials/include/nvector/nvector_openmpdev.h create mode 100644 bazaar/plugin/sundials/include/nvector/nvector_raja.h create mode 100644 bazaar/plugin/sundials/include/nvector/nvector_serial.h create mode 100644 bazaar/plugin/sundials/include/nvector/nvector_trilinos.h create mode 100644 bazaar/plugin/sundials/include/nvector/raja/Vector.hpp create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_band.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_config.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_dense.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_direct.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_fconfig.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_fnvector.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_futils.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_iterative.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_lapack.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_linearsolver.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_math.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_matrix.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_mpi_types.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_nonlinearsolver.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_nvector.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_nvector_senswrapper.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_types.h create mode 100644 bazaar/plugin/sundials/include/sundials/sundials_version.h create mode 100644 bazaar/plugin/sundials/include/sunlinsol/sunlinsol_band.h create mode 100644 bazaar/plugin/sundials/include/sunlinsol/sunlinsol_cusolversp_batchqr.h create mode 100644 bazaar/plugin/sundials/include/sunlinsol/sunlinsol_dense.h create mode 100644 bazaar/plugin/sundials/include/sunlinsol/sunlinsol_lapackband.h create mode 100644 bazaar/plugin/sundials/include/sunlinsol/sunlinsol_lapackdense.h create mode 100644 bazaar/plugin/sundials/include/sunlinsol/sunlinsol_pcg.h create mode 100644 bazaar/plugin/sundials/include/sunlinsol/sunlinsol_spbcgs.h create mode 100644 bazaar/plugin/sundials/include/sunlinsol/sunlinsol_spfgmr.h create mode 100644 bazaar/plugin/sundials/include/sunlinsol/sunlinsol_spgmr.h create mode 100644 bazaar/plugin/sundials/include/sunlinsol/sunlinsol_sptfqmr.h create mode 100644 bazaar/plugin/sundials/include/sunlinsol/sunlinsol_superludist.h create mode 100644 bazaar/plugin/sundials/include/sunmatrix/sunmatrix_band.h create mode 100644 bazaar/plugin/sundials/include/sunmatrix/sunmatrix_cusparse.h create mode 100644 bazaar/plugin/sundials/include/sunmatrix/sunmatrix_dense.h create mode 100644 bazaar/plugin/sundials/include/sunmatrix/sunmatrix_sparse.h create mode 100644 bazaar/plugin/sundials/include/sunnonlinsol/sunnonlinsol_fixedpoint.h create mode 100644 bazaar/plugin/sundials/include/sunnonlinsol/sunnonlinsol_newton.h create mode 100644 bazaar/plugin/sundials/include/sunnonlinsol/sunnonlinsol_petscsnes.h create mode 100644 bazaar/plugin/sundials/src/ida/ida.c create mode 100644 bazaar/plugin/sundials/src/ida/ida_bbdpre.c create mode 100644 bazaar/plugin/sundials/src/ida/ida_bbdpre_impl.h create mode 100644 bazaar/plugin/sundials/src/ida/ida_direct.c create mode 100644 bazaar/plugin/sundials/src/ida/ida_ic.c create mode 100644 bazaar/plugin/sundials/src/ida/ida_impl.h create mode 100644 bazaar/plugin/sundials/src/ida/ida_io.c create mode 100644 bazaar/plugin/sundials/src/ida/ida_ls.c create mode 100644 bazaar/plugin/sundials/src/ida/ida_ls_impl.h create mode 100644 bazaar/plugin/sundials/src/ida/ida_nls.c create mode 100644 bazaar/plugin/sundials/src/ida/ida_spils.c create mode 100644 bazaar/plugin/sundials/src/kinsol/fcmix/fkinbbd.h create mode 100644 bazaar/plugin/sundials/src/kinsol/fcmix/fkinsol.h create mode 100644 bazaar/plugin/sundials/src/kinsol/fmod/fkinsol_mod.c create mode 100644 bazaar/plugin/sundials/src/kinsol/kinsol.c create mode 100644 bazaar/plugin/sundials/src/kinsol/kinsol_bbdpre.c create mode 100644 bazaar/plugin/sundials/src/kinsol/kinsol_bbdpre_impl.h create mode 100644 bazaar/plugin/sundials/src/kinsol/kinsol_direct.c create mode 100644 bazaar/plugin/sundials/src/kinsol/kinsol_impl.h create mode 100644 bazaar/plugin/sundials/src/kinsol/kinsol_io.c create mode 100644 bazaar/plugin/sundials/src/kinsol/kinsol_ls.c create mode 100644 bazaar/plugin/sundials/src/kinsol/kinsol_ls_impl.h create mode 100644 bazaar/plugin/sundials/src/kinsol/kinsol_spils.c create mode 100644 bazaar/plugin/sundials/src/nvector/manyvector/fmod/fnvector_manyvector_mod.c create mode 100644 bazaar/plugin/sundials/src/nvector/manyvector/nvector_manyvector.c create mode 100644 bazaar/plugin/sundials/src/nvector/serial/fmod/fnvector_serial_mod.c create mode 100644 bazaar/plugin/sundials/src/nvector/serial/fnvector_serial.c create mode 100644 bazaar/plugin/sundials/src/nvector/serial/fnvector_serial.h create mode 100644 bazaar/plugin/sundials/src/nvector/serial/nvector_serial.c create mode 100644 bazaar/plugin/sundials/src/sundials/fmod/fsundials_futils_mod.c create mode 100644 bazaar/plugin/sundials/src/sundials/fmod/fsundials_linearsolver_mod.c create mode 100644 bazaar/plugin/sundials/src/sundials/fmod/fsundials_matrix_mod.c create mode 100644 bazaar/plugin/sundials/src/sundials/fmod/fsundials_nonlinearsolver_mod.c create mode 100644 bazaar/plugin/sundials/src/sundials/fmod/fsundials_nvector_mod.c create mode 100644 bazaar/plugin/sundials/src/sundials/fmod/fsundials_types_mod.c create mode 100644 bazaar/plugin/sundials/src/sundials/sundials_band.c create mode 100644 bazaar/plugin/sundials/src/sundials/sundials_cuda.h create mode 100644 bazaar/plugin/sundials/src/sundials/sundials_debug.h create mode 100644 bazaar/plugin/sundials/src/sundials/sundials_dense.c create mode 100644 bazaar/plugin/sundials/src/sundials/sundials_direct.c create mode 100644 bazaar/plugin/sundials/src/sundials/sundials_futils.c create mode 100644 bazaar/plugin/sundials/src/sundials/sundials_iterative.c create mode 100644 bazaar/plugin/sundials/src/sundials/sundials_linearsolver.c create mode 100644 bazaar/plugin/sundials/src/sundials/sundials_math.c create mode 100644 bazaar/plugin/sundials/src/sundials/sundials_matrix.c create mode 100644 bazaar/plugin/sundials/src/sundials/sundials_nonlinearsolver.c create mode 100644 bazaar/plugin/sundials/src/sundials/sundials_nvector.c create mode 100644 bazaar/plugin/sundials/src/sundials/sundials_nvector_senswrapper.c create mode 100644 bazaar/plugin/sundials/src/sundials/sundials_version.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/band/fmod/fsunlinsol_band_mod.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/band/fsunlinsol_band.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/band/fsunlinsol_band.h create mode 100644 bazaar/plugin/sundials/src/sunlinsol/band/sunlinsol_band.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/dense/fmod/fsunlinsol_dense_mod.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/dense/fsunlinsol_dense.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/dense/fsunlinsol_dense.h create mode 100644 bazaar/plugin/sundials/src/sunlinsol/dense/sunlinsol_dense.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/pcg/fmod/fsunlinsol_pcg_mod.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/pcg/fsunlinsol_pcg.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/pcg/fsunlinsol_pcg.h create mode 100644 bazaar/plugin/sundials/src/sunlinsol/pcg/sunlinsol_pcg.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/spbcgs/fmod/fsunlinsol_spbcgs_mod.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/spbcgs/fsunlinsol_spbcgs.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/spbcgs/fsunlinsol_spbcgs.h create mode 100644 bazaar/plugin/sundials/src/sunlinsol/spbcgs/sunlinsol_spbcgs.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/spfgmr/fmod/fsunlinsol_spfgmr_mod.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/spfgmr/fsunlinsol_spfgmr.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/spfgmr/fsunlinsol_spfgmr.h create mode 100644 bazaar/plugin/sundials/src/sunlinsol/spfgmr/sunlinsol_spfgmr.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/spgmr/fmod/fsunlinsol_spgmr_mod.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/spgmr/fsunlinsol_spgmr.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/spgmr/fsunlinsol_spgmr.h create mode 100644 bazaar/plugin/sundials/src/sunlinsol/spgmr/sunlinsol_spgmr.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/sptfqmr/fmod/fsunlinsol_sptfqmr_mod.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/sptfqmr/fsunlinsol_sptfqmr.c create mode 100644 bazaar/plugin/sundials/src/sunlinsol/sptfqmr/fsunlinsol_sptfqmr.h create mode 100644 bazaar/plugin/sundials/src/sunlinsol/sptfqmr/sunlinsol_sptfqmr.c create mode 100644 bazaar/plugin/sundials/src/sunmatrix/band/fmod/fsunmatrix_band_mod.c create mode 100644 bazaar/plugin/sundials/src/sunmatrix/band/fsunmatrix_band.c create mode 100644 bazaar/plugin/sundials/src/sunmatrix/band/fsunmatrix_band.h create mode 100644 bazaar/plugin/sundials/src/sunmatrix/band/sunmatrix_band.c create mode 100644 bazaar/plugin/sundials/src/sunmatrix/dense/fmod/fsunmatrix_dense_mod.c create mode 100644 bazaar/plugin/sundials/src/sunmatrix/dense/fsunmatrix_dense.c create mode 100644 bazaar/plugin/sundials/src/sunmatrix/dense/fsunmatrix_dense.h create mode 100644 bazaar/plugin/sundials/src/sunmatrix/dense/sunmatrix_dense.c create mode 100644 bazaar/plugin/sundials/src/sunmatrix/sparse/fmod/fsunmatrix_sparse_mod.c create mode 100644 bazaar/plugin/sundials/src/sunmatrix/sparse/fsunmatrix_sparse.c create mode 100644 bazaar/plugin/sundials/src/sunmatrix/sparse/fsunmatrix_sparse.h create mode 100644 bazaar/plugin/sundials/src/sunmatrix/sparse/sunmatrix_sparse.c create mode 100644 bazaar/plugin/sundials/src/sunnonlinsol/fixedpoint/fmod/fsunnonlinsol_fixedpoint_mod.c create mode 100644 bazaar/plugin/sundials/src/sunnonlinsol/fixedpoint/fsunnonlinsol_fixedpoint.c create mode 100644 bazaar/plugin/sundials/src/sunnonlinsol/fixedpoint/fsunnonlinsol_fixedpoint.h create mode 100644 bazaar/plugin/sundials/src/sunnonlinsol/fixedpoint/sunnonlinsol_fixedpoint.c create mode 100644 bazaar/plugin/sundials/src/sunnonlinsol/newton/fmod/fsunnonlinsol_newton_mod.c create mode 100644 bazaar/plugin/sundials/src/sunnonlinsol/newton/fsunnonlinsol_newton.c create mode 100644 bazaar/plugin/sundials/src/sunnonlinsol/newton/fsunnonlinsol_newton.h create mode 100644 bazaar/plugin/sundials/src/sunnonlinsol/newton/sunnonlinsol_newton.c create mode 100644 bazaar/plugin/sundials/sundials.upp diff --git a/bazaar/plugin/sundials/include/ida/ida.h b/bazaar/plugin/sundials/include/ida/ida.h new file mode 100644 index 000000000..e34054369 --- /dev/null +++ b/bazaar/plugin/sundials/include/ida/ida.h @@ -0,0 +1,215 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Allan G. Taylor, Alan C. Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the main IDA solver. + * -----------------------------------------------------------------*/ + +#ifndef _IDA_H +#define _IDA_H + +#include +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* ----------------- + * IDA Constants + * ----------------- */ + +/* itask */ +#define IDA_NORMAL 1 +#define IDA_ONE_STEP 2 + +/* icopt */ +#define IDA_YA_YDP_INIT 1 +#define IDA_Y_INIT 2 + +/* return values */ + +#define IDA_SUCCESS 0 +#define IDA_TSTOP_RETURN 1 +#define IDA_ROOT_RETURN 2 + +#define IDA_WARNING 99 + +#define IDA_TOO_MUCH_WORK -1 +#define IDA_TOO_MUCH_ACC -2 +#define IDA_ERR_FAIL -3 +#define IDA_CONV_FAIL -4 + +#define IDA_LINIT_FAIL -5 +#define IDA_LSETUP_FAIL -6 +#define IDA_LSOLVE_FAIL -7 +#define IDA_RES_FAIL -8 +#define IDA_REP_RES_ERR -9 +#define IDA_RTFUNC_FAIL -10 +#define IDA_CONSTR_FAIL -11 + +#define IDA_FIRST_RES_FAIL -12 +#define IDA_LINESEARCH_FAIL -13 +#define IDA_NO_RECOVERY -14 +#define IDA_NLS_INIT_FAIL -15 +#define IDA_NLS_SETUP_FAIL -16 +#define IDA_NLS_FAIL -17 + +#define IDA_MEM_NULL -20 +#define IDA_MEM_FAIL -21 +#define IDA_ILL_INPUT -22 +#define IDA_NO_MALLOC -23 +#define IDA_BAD_EWT -24 +#define IDA_BAD_K -25 +#define IDA_BAD_T -26 +#define IDA_BAD_DKY -27 +#define IDA_VECTOROP_ERR -28 + +#define IDA_UNRECOGNIZED_ERROR -99 + + +/* ------------------------------ + * User-Supplied Function Types + * ------------------------------ */ + +typedef int (*IDAResFn)(realtype tt, N_Vector yy, N_Vector yp, + N_Vector rr, void *user_data); + +typedef int (*IDARootFn)(realtype t, N_Vector y, N_Vector yp, + realtype *gout, void *user_data); + +typedef int (*IDAEwtFn)(N_Vector y, N_Vector ewt, void *user_data); + +typedef void (*IDAErrHandlerFn)(int error_code, + const char *module, const char *function, + char *msg, void *user_data); + +/* ------------------- + * Exported Functions + * ------------------- */ + +/* Initialization functions */ +SUNDIALS_EXPORT void *IDACreate(void); + +SUNDIALS_EXPORT int IDAInit(void *ida_mem, IDAResFn res, realtype t0, + N_Vector yy0, N_Vector yp0); +SUNDIALS_EXPORT int IDAReInit(void *ida_mem, realtype t0, N_Vector yy0, + N_Vector yp0); + +/* Tolerance input functions */ +SUNDIALS_EXPORT int IDASStolerances(void *ida_mem, realtype reltol, + realtype abstol); +SUNDIALS_EXPORT int IDASVtolerances(void *ida_mem, realtype reltol, + N_Vector abstol); +SUNDIALS_EXPORT int IDAWFtolerances(void *ida_mem, IDAEwtFn efun); + +/* Initial condition calculation function */ +SUNDIALS_EXPORT int IDACalcIC(void *ida_mem, int icopt, realtype tout1); + +/* Initial condition calculation optional input functions */ +SUNDIALS_EXPORT int IDASetNonlinConvCoefIC(void *ida_mem, realtype epiccon); +SUNDIALS_EXPORT int IDASetMaxNumStepsIC(void *ida_mem, int maxnh); +SUNDIALS_EXPORT int IDASetMaxNumJacsIC(void *ida_mem, int maxnj); +SUNDIALS_EXPORT int IDASetMaxNumItersIC(void *ida_mem, int maxnit); +SUNDIALS_EXPORT int IDASetLineSearchOffIC(void *ida_mem, booleantype lsoff); +SUNDIALS_EXPORT int IDASetStepToleranceIC(void *ida_mem, realtype steptol); +SUNDIALS_EXPORT int IDASetMaxBacksIC(void *ida_mem, int maxbacks); + +/* Optional input functions */ +SUNDIALS_EXPORT int IDASetErrHandlerFn(void *ida_mem, IDAErrHandlerFn ehfun, + void *eh_data); +SUNDIALS_EXPORT int IDASetErrFile(void *ida_mem, FILE *errfp); +SUNDIALS_EXPORT int IDASetUserData(void *ida_mem, void *user_data); +SUNDIALS_EXPORT int IDASetMaxOrd(void *ida_mem, int maxord); +SUNDIALS_EXPORT int IDASetMaxNumSteps(void *ida_mem, long int mxsteps); +SUNDIALS_EXPORT int IDASetInitStep(void *ida_mem, realtype hin); +SUNDIALS_EXPORT int IDASetMaxStep(void *ida_mem, realtype hmax); +SUNDIALS_EXPORT int IDASetStopTime(void *ida_mem, realtype tstop); +SUNDIALS_EXPORT int IDASetNonlinConvCoef(void *ida_mem, realtype epcon); +SUNDIALS_EXPORT int IDASetMaxErrTestFails(void *ida_mem, int maxnef); +SUNDIALS_EXPORT int IDASetMaxNonlinIters(void *ida_mem, int maxcor); +SUNDIALS_EXPORT int IDASetMaxConvFails(void *ida_mem, int maxncf); +SUNDIALS_EXPORT int IDASetSuppressAlg(void *ida_mem, booleantype suppressalg); +SUNDIALS_EXPORT int IDASetId(void *ida_mem, N_Vector id); +SUNDIALS_EXPORT int IDASetConstraints(void *ida_mem, N_Vector constraints); + +SUNDIALS_EXPORT int IDASetNonlinearSolver(void *ida_mem, + SUNNonlinearSolver NLS); + +/* Rootfinding initialization function */ +SUNDIALS_EXPORT int IDARootInit(void *ida_mem, int nrtfn, IDARootFn g); + +/* Rootfinding optional input functions */ +SUNDIALS_EXPORT int IDASetRootDirection(void *ida_mem, int *rootdir); +SUNDIALS_EXPORT int IDASetNoInactiveRootWarn(void *ida_mem); + +/* Solver function */ +SUNDIALS_EXPORT int IDASolve(void *ida_mem, realtype tout, realtype *tret, + N_Vector yret, N_Vector ypret, int itask); + +/* Utility functions to update/compute y and yp based on ycor */ +SUNDIALS_EXPORT int IDAComputeY(void *ida_mem, N_Vector ycor, N_Vector y); +SUNDIALS_EXPORT int IDAComputeYp(void *ida_mem, N_Vector ycor, N_Vector yp); + +/* Dense output function */ +SUNDIALS_EXPORT int IDAGetDky(void *ida_mem, realtype t, int k, N_Vector dky); + +/* Optional output functions */ +SUNDIALS_EXPORT int IDAGetWorkSpace(void *ida_mem, long int *lenrw, + long int *leniw); +SUNDIALS_EXPORT int IDAGetNumSteps(void *ida_mem, long int *nsteps); +SUNDIALS_EXPORT int IDAGetNumResEvals(void *ida_mem, long int *nrevals); +SUNDIALS_EXPORT int IDAGetNumLinSolvSetups(void *ida_mem, long int *nlinsetups); +SUNDIALS_EXPORT int IDAGetNumErrTestFails(void *ida_mem, long int *netfails); +SUNDIALS_EXPORT int IDAGetNumBacktrackOps(void *ida_mem, long int *nbacktr); +SUNDIALS_EXPORT int IDAGetConsistentIC(void *ida_mem, N_Vector yy0_mod, + N_Vector yp0_mod); +SUNDIALS_EXPORT int IDAGetLastOrder(void *ida_mem, int *klast); +SUNDIALS_EXPORT int IDAGetCurrentOrder(void *ida_mem, int *kcur); +SUNDIALS_EXPORT int IDAGetCurrentCj(void *ida_mem, realtype *cj); +SUNDIALS_EXPORT int IDAGetCurrentY(void *ida_mem, N_Vector *ycur); +SUNDIALS_EXPORT int IDAGetCurrentYp(void *ida_mem, N_Vector *ypcur); +SUNDIALS_EXPORT int IDAGetActualInitStep(void *ida_mem, realtype *hinused); +SUNDIALS_EXPORT int IDAGetLastStep(void *ida_mem, realtype *hlast); +SUNDIALS_EXPORT int IDAGetCurrentStep(void *ida_mem, realtype *hcur); +SUNDIALS_EXPORT int IDAGetCurrentTime(void *ida_mem, realtype *tcur); +SUNDIALS_EXPORT int IDAGetTolScaleFactor(void *ida_mem, realtype *tolsfact); +SUNDIALS_EXPORT int IDAGetErrWeights(void *ida_mem, N_Vector eweight); +SUNDIALS_EXPORT int IDAGetEstLocalErrors(void *ida_mem, N_Vector ele); +SUNDIALS_EXPORT int IDAGetNumGEvals(void *ida_mem, long int *ngevals); +SUNDIALS_EXPORT int IDAGetRootInfo(void *ida_mem, int *rootsfound); +SUNDIALS_EXPORT int IDAGetIntegratorStats(void *ida_mem, long int *nsteps, + long int *nrevals, + long int *nlinsetups, + long int *netfails, + int *qlast, int *qcur, + realtype *hinused, realtype *hlast, + realtype *hcur, realtype *tcur); +SUNDIALS_EXPORT int IDAGetNumNonlinSolvIters(void *ida_mem, long int *nniters); +SUNDIALS_EXPORT int IDAGetNumNonlinSolvConvFails(void *ida_mem, + long int *nncfails); +SUNDIALS_EXPORT int IDAGetNonlinSolvStats(void *ida_mem, long int *nniters, + long int *nncfails); +SUNDIALS_EXPORT char *IDAGetReturnFlagName(long int flag); + +/* Free function */ +SUNDIALS_EXPORT void IDAFree(void **ida_mem); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/ida/ida_bbdpre.h b/bazaar/plugin/sundials/include/ida/ida_bbdpre.h new file mode 100644 index 000000000..e59a07d1f --- /dev/null +++ b/bazaar/plugin/sundials/include/ida/ida_bbdpre.h @@ -0,0 +1,65 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU, + * Alan C. Hindmarsh, Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the IDABBDPRE module, for a + * band-block-diagonal preconditioner, i.e. a block-diagonal + * matrix with banded blocks. + * -----------------------------------------------------------------*/ + +#ifndef _IDABBDPRE_H +#define _IDABBDPRE_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/* User-supplied function Types */ + +typedef int (*IDABBDLocalFn)(sunindextype Nlocal, realtype tt, + N_Vector yy, N_Vector yp, N_Vector gval, + void *user_data); + +typedef int (*IDABBDCommFn)(sunindextype Nlocal, realtype tt, + N_Vector yy, N_Vector yp, void *user_data); + +/* Exported Functions */ + +SUNDIALS_EXPORT int IDABBDPrecInit(void *ida_mem, sunindextype Nlocal, + sunindextype mudq, sunindextype mldq, + sunindextype mukeep, sunindextype mlkeep, + realtype dq_rel_yy, + IDABBDLocalFn Gres, IDABBDCommFn Gcomm); + +SUNDIALS_EXPORT int IDABBDPrecReInit(void *ida_mem, + sunindextype mudq, sunindextype mldq, + realtype dq_rel_yy); + +/* Optional output functions */ + +SUNDIALS_EXPORT int IDABBDPrecGetWorkSpace(void *ida_mem, + long int *lenrwBBDP, + long int *leniwBBDP); + +SUNDIALS_EXPORT int IDABBDPrecGetNumGfnEvals(void *ida_mem, + long int *ngevalsBBDP); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/ida/ida_direct.h b/bazaar/plugin/sundials/include/ida/ida_direct.h new file mode 100644 index 000000000..db2880eca --- /dev/null +++ b/bazaar/plugin/sundials/include/ida/ida_direct.h @@ -0,0 +1,61 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * Header file for the deprecated direct linear solver interface in + * IDA; these routines now just wrap the updated IDA generic + * linear solver interface in ida_ls.h. + * -----------------------------------------------------------------*/ + +#ifndef _IDADLS_H +#define _IDADLS_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/*================================================================= + Function Types (typedefs for equivalent types in ida_ls.h) + =================================================================*/ + +typedef IDALsJacFn IDADlsJacFn; + +/*=================================================================== + Exported Functions (wrappers for equivalent routines in ida_ls.h) + ===================================================================*/ + +SUNDIALS_EXPORT int IDADlsSetLinearSolver(void *ida_mem, SUNLinearSolver LS, + SUNMatrix A); + +SUNDIALS_EXPORT int IDADlsSetJacFn(void *ida_mem, IDADlsJacFn jac); + +SUNDIALS_EXPORT int IDADlsGetWorkSpace(void *ida_mem, long int *lenrwLS, + long int *leniwLS); + +SUNDIALS_EXPORT int IDADlsGetNumJacEvals(void *ida_mem, long int *njevals); + +SUNDIALS_EXPORT int IDADlsGetNumResEvals(void *ida_mem, long int *nrevalsLS); + +SUNDIALS_EXPORT int IDADlsGetLastFlag(void *ida_mem, long int *flag); + +SUNDIALS_EXPORT char *IDADlsGetReturnFlagName(long int flag); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/ida/ida_ls.h b/bazaar/plugin/sundials/include/ida/ida_ls.h new file mode 100644 index 000000000..5630533d5 --- /dev/null +++ b/bazaar/plugin/sundials/include/ida/ida_ls.h @@ -0,0 +1,137 @@ +/* ---------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * Alan Hindmarsh, Radu Serban and + * Aaron Collier @ LLNL + * ---------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ---------------------------------------------------------------- + * This is the header file for IDA's linear solver interface. + * ----------------------------------------------------------------*/ + +#ifndef _IDALS_H +#define _IDALS_H + +#include +#include +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/*================================================================= + IDALS Constants + =================================================================*/ + +#define IDALS_SUCCESS 0 +#define IDALS_MEM_NULL -1 +#define IDALS_LMEM_NULL -2 +#define IDALS_ILL_INPUT -3 +#define IDALS_MEM_FAIL -4 +#define IDALS_PMEM_NULL -5 +#define IDALS_JACFUNC_UNRECVR -6 +#define IDALS_JACFUNC_RECVR -7 +#define IDALS_SUNMAT_FAIL -8 +#define IDALS_SUNLS_FAIL -9 + + +/*================================================================= + IDALS user-supplied function prototypes + =================================================================*/ + +typedef int (*IDALsJacFn)(realtype t, realtype c_j, N_Vector y, + N_Vector yp, N_Vector r, SUNMatrix Jac, + void *user_data, N_Vector tmp1, + N_Vector tmp2, N_Vector tmp3); + +typedef int (*IDALsPrecSetupFn)(realtype tt, N_Vector yy, + N_Vector yp, N_Vector rr, + realtype c_j, void *user_data); + +typedef int (*IDALsPrecSolveFn)(realtype tt, N_Vector yy, + N_Vector yp, N_Vector rr, + N_Vector rvec, N_Vector zvec, + realtype c_j, realtype delta, + void *user_data); + +typedef int (*IDALsJacTimesSetupFn)(realtype tt, N_Vector yy, + N_Vector yp, N_Vector rr, + realtype c_j, void *user_data); + +typedef int (*IDALsJacTimesVecFn)(realtype tt, N_Vector yy, + N_Vector yp, N_Vector rr, + N_Vector v, N_Vector Jv, + realtype c_j, void *user_data, + N_Vector tmp1, N_Vector tmp2); + + +/*================================================================= + IDALS Exported functions + =================================================================*/ + +SUNDIALS_EXPORT int IDASetLinearSolver(void *ida_mem, + SUNLinearSolver LS, + SUNMatrix A); + + +/*----------------------------------------------------------------- + Optional inputs to the IDALS linear solver interface + -----------------------------------------------------------------*/ + +SUNDIALS_EXPORT int IDASetJacFn(void *ida_mem, IDALsJacFn jac); +SUNDIALS_EXPORT int IDASetPreconditioner(void *ida_mem, + IDALsPrecSetupFn pset, + IDALsPrecSolveFn psolve); +SUNDIALS_EXPORT int IDASetJacTimes(void *ida_mem, + IDALsJacTimesSetupFn jtsetup, + IDALsJacTimesVecFn jtimes); +SUNDIALS_EXPORT int IDASetEpsLin(void *ida_mem, realtype eplifac); +SUNDIALS_EXPORT int IDASetLinearSolutionScaling(void *ida_mem, + booleantype onoff); +SUNDIALS_EXPORT int IDASetIncrementFactor(void *ida_mem, + realtype dqincfac); + +/*----------------------------------------------------------------- + Optional outputs from the IDALS linear solver interface + -----------------------------------------------------------------*/ + +SUNDIALS_EXPORT int IDAGetLinWorkSpace(void *ida_mem, + long int *lenrwLS, + long int *leniwLS); +SUNDIALS_EXPORT int IDAGetNumJacEvals(void *ida_mem, + long int *njevals); +SUNDIALS_EXPORT int IDAGetNumPrecEvals(void *ida_mem, + long int *npevals); +SUNDIALS_EXPORT int IDAGetNumPrecSolves(void *ida_mem, + long int *npsolves); +SUNDIALS_EXPORT int IDAGetNumLinIters(void *ida_mem, + long int *nliters); +SUNDIALS_EXPORT int IDAGetNumLinConvFails(void *ida_mem, + long int *nlcfails); +SUNDIALS_EXPORT int IDAGetNumJTSetupEvals(void *ida_mem, + long int *njtsetups); +SUNDIALS_EXPORT int IDAGetNumJtimesEvals(void *ida_mem, + long int *njvevals); +SUNDIALS_EXPORT int IDAGetNumLinResEvals(void *ida_mem, + long int *nrevalsLS); +SUNDIALS_EXPORT int IDAGetLastLinFlag(void *ida_mem, + long int *flag); +SUNDIALS_EXPORT char *IDAGetLinReturnFlagName(long int flag); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/ida/ida_spils.h b/bazaar/plugin/sundials/include/ida/ida_spils.h new file mode 100644 index 000000000..68a2c1032 --- /dev/null +++ b/bazaar/plugin/sundials/include/ida/ida_spils.h @@ -0,0 +1,80 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * Alan Hindmarsh, Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * Header file for the deprecated Scaled, Preconditioned Iterative + * Linear Solver interface in IDA; these routines now just wrap + * the updated IDA generic linear solver interface in ida_ls.h. + * -----------------------------------------------------------------*/ + +#ifndef _IDASPILS_H +#define _IDASPILS_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/*=============================================================== + Function Types (typedefs for equivalent types in ida_ls.h) + ===============================================================*/ + +typedef IDALsPrecSetupFn IDASpilsPrecSetupFn; +typedef IDALsPrecSolveFn IDASpilsPrecSolveFn; +typedef IDALsJacTimesSetupFn IDASpilsJacTimesSetupFn; +typedef IDALsJacTimesVecFn IDASpilsJacTimesVecFn; + +/*==================================================================== + Exported Functions (wrappers for equivalent routines in ida_ls.h) + ====================================================================*/ + +SUNDIALS_EXPORT int IDASpilsSetLinearSolver(void *ida_mem, SUNLinearSolver LS); + +SUNDIALS_EXPORT int IDASpilsSetPreconditioner(void *ida_mem, IDASpilsPrecSetupFn pset, + IDASpilsPrecSolveFn psolve); + +SUNDIALS_EXPORT int IDASpilsSetJacTimes(void *ida_mem, IDASpilsJacTimesSetupFn jtsetup, + IDASpilsJacTimesVecFn jtimes); + +SUNDIALS_EXPORT int IDASpilsSetEpsLin(void *ida_mem, realtype eplifac); + +SUNDIALS_EXPORT int IDASpilsSetIncrementFactor(void *ida_mem, realtype dqincfac); + +SUNDIALS_EXPORT int IDASpilsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS); + +SUNDIALS_EXPORT int IDASpilsGetNumPrecEvals(void *ida_mem, long int *npevals); + +SUNDIALS_EXPORT int IDASpilsGetNumPrecSolves(void *ida_mem, long int *npsolves); + +SUNDIALS_EXPORT int IDASpilsGetNumLinIters(void *ida_mem, long int *nliters); + +SUNDIALS_EXPORT int IDASpilsGetNumConvFails(void *ida_mem, long int *nlcfails); + +SUNDIALS_EXPORT int IDASpilsGetNumJTSetupEvals(void *ida_mem, long int *njtsetups); + +SUNDIALS_EXPORT int IDASpilsGetNumJtimesEvals(void *ida_mem, long int *njvevals); + +SUNDIALS_EXPORT int IDASpilsGetNumResEvals(void *ida_mem, long int *nrevalsLS); + +SUNDIALS_EXPORT int IDASpilsGetLastFlag(void *ida_mem, long int *flag); + +SUNDIALS_EXPORT char *IDASpilsGetReturnFlagName(long int flag); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/kinsol/kinsol.h b/bazaar/plugin/sundials/include/kinsol/kinsol.h new file mode 100644 index 000000000..10ac581c7 --- /dev/null +++ b/bazaar/plugin/sundials/include/kinsol/kinsol.h @@ -0,0 +1,150 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the main KINSOL solver. + * -----------------------------------------------------------------*/ + +#ifndef _KINSOL_H +#define _KINSOL_H + +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* ----------------- + * KINSOL Constants + * ----------------- */ + +/* return values */ + +#define KIN_SUCCESS 0 +#define KIN_INITIAL_GUESS_OK 1 +#define KIN_STEP_LT_STPTOL 2 + +#define KIN_WARNING 99 + +#define KIN_MEM_NULL -1 +#define KIN_ILL_INPUT -2 +#define KIN_NO_MALLOC -3 +#define KIN_MEM_FAIL -4 +#define KIN_LINESEARCH_NONCONV -5 +#define KIN_MAXITER_REACHED -6 +#define KIN_MXNEWT_5X_EXCEEDED -7 +#define KIN_LINESEARCH_BCFAIL -8 +#define KIN_LINSOLV_NO_RECOVERY -9 +#define KIN_LINIT_FAIL -10 +#define KIN_LSETUP_FAIL -11 +#define KIN_LSOLVE_FAIL -12 + +#define KIN_SYSFUNC_FAIL -13 +#define KIN_FIRST_SYSFUNC_ERR -14 +#define KIN_REPTD_SYSFUNC_ERR -15 + +#define KIN_VECTOROP_ERR -16 + +/* Enumeration for eta choice */ +#define KIN_ETACHOICE1 1 +#define KIN_ETACHOICE2 2 +#define KIN_ETACONSTANT 3 + +/* Enumeration for global strategy */ +#define KIN_NONE 0 +#define KIN_LINESEARCH 1 +#define KIN_PICARD 2 +#define KIN_FP 3 + +/* ------------------------------ + * User-Supplied Function Types + * ------------------------------ */ + +typedef int (*KINSysFn)(N_Vector uu, N_Vector fval, void *user_data ); + +typedef void (*KINErrHandlerFn)(int error_code, + const char *module, const char *function, + char *msg, void *user_data); + +typedef void (*KINInfoHandlerFn)(const char *module, const char *function, + char *msg, void *user_data); + +/* ------------------- + * Exported Functions + * ------------------- */ + +/* Creation function */ +SUNDIALS_EXPORT void *KINCreate(void); + +/* Initialization function */ +SUNDIALS_EXPORT int KINInit(void *kinmem, KINSysFn func, N_Vector tmpl); + +/* Solver function */ +SUNDIALS_EXPORT int KINSol(void *kinmem, N_Vector uu, int strategy, + N_Vector u_scale, N_Vector f_scale); + +/* Optional input functions */ +SUNDIALS_EXPORT int KINSetErrHandlerFn(void *kinmem, KINErrHandlerFn ehfun, + void *eh_data); +SUNDIALS_EXPORT int KINSetErrFile(void *kinmem, FILE *errfp); +SUNDIALS_EXPORT int KINSetInfoHandlerFn(void *kinmem, KINInfoHandlerFn ihfun, + void *ih_data); +SUNDIALS_EXPORT int KINSetInfoFile(void *kinmem, FILE *infofp); +SUNDIALS_EXPORT int KINSetUserData(void *kinmem, void *user_data); +SUNDIALS_EXPORT int KINSetPrintLevel(void *kinmemm, int printfl); +SUNDIALS_EXPORT int KINSetMAA(void *kinmem, long int maa); +SUNDIALS_EXPORT int KINSetDampingAA(void *kinmem, realtype beta); +SUNDIALS_EXPORT int KINSetNumMaxIters(void *kinmem, long int mxiter); +SUNDIALS_EXPORT int KINSetNoInitSetup(void *kinmem, booleantype noInitSetup); +SUNDIALS_EXPORT int KINSetNoResMon(void *kinmem, booleantype noNNIResMon); +SUNDIALS_EXPORT int KINSetMaxSetupCalls(void *kinmem, long int msbset); +SUNDIALS_EXPORT int KINSetMaxSubSetupCalls(void *kinmem, long int msbsetsub); +SUNDIALS_EXPORT int KINSetEtaForm(void *kinmem, int etachoice); +SUNDIALS_EXPORT int KINSetEtaConstValue(void *kinmem, realtype eta); +SUNDIALS_EXPORT int KINSetEtaParams(void *kinmem, realtype egamma, + realtype ealpha); +SUNDIALS_EXPORT int KINSetResMonParams(void *kinmem, realtype omegamin, + realtype omegamax); +SUNDIALS_EXPORT int KINSetResMonConstValue(void *kinmem, realtype omegaconst); +SUNDIALS_EXPORT int KINSetNoMinEps(void *kinmem, booleantype noMinEps); +SUNDIALS_EXPORT int KINSetMaxNewtonStep(void *kinmem, realtype mxnewtstep); +SUNDIALS_EXPORT int KINSetMaxBetaFails(void *kinmem, long int mxnbcf); +SUNDIALS_EXPORT int KINSetRelErrFunc(void *kinmem, realtype relfunc); +SUNDIALS_EXPORT int KINSetFuncNormTol(void *kinmem, realtype fnormtol); +SUNDIALS_EXPORT int KINSetScaledStepTol(void *kinmem, realtype scsteptol); +SUNDIALS_EXPORT int KINSetConstraints(void *kinmem, N_Vector constraints); +SUNDIALS_EXPORT int KINSetSysFunc(void *kinmem, KINSysFn func); + + +/* Optional output functions */ +SUNDIALS_EXPORT int KINGetWorkSpace(void *kinmem, long int *lenrw, + long int *leniw); +SUNDIALS_EXPORT int KINGetNumNonlinSolvIters(void *kinmem, long int *nniters); +SUNDIALS_EXPORT int KINGetNumFuncEvals(void *kinmem, long int *nfevals); +SUNDIALS_EXPORT int KINGetNumBetaCondFails(void *kinmem, long int *nbcfails); +SUNDIALS_EXPORT int KINGetNumBacktrackOps(void *kinmem, long int *nbacktr); +SUNDIALS_EXPORT int KINGetFuncNorm(void *kinmem, realtype *fnorm); +SUNDIALS_EXPORT int KINGetStepLength(void *kinmem, realtype *steplength); +SUNDIALS_EXPORT char *KINGetReturnFlagName(long int flag); + +/* Free function */ +SUNDIALS_EXPORT void KINFree(void **kinmem); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/kinsol/kinsol_bbdpre.h b/bazaar/plugin/sundials/include/kinsol/kinsol_bbdpre.h new file mode 100644 index 000000000..2d91769ac --- /dev/null +++ b/bazaar/plugin/sundials/include/kinsol/kinsol_bbdpre.h @@ -0,0 +1,66 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * Alan Hindmarsh, Radu Serban, and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the KINBBDPRE module, for a + * band-block-diagonal preconditioner, i.e. a block-diagonal + * matrix with banded blocks. + * -----------------------------------------------------------------*/ + +#ifndef _KINBBDPRE_H +#define _KINBBDPRE_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* KINBBDPRE return values */ + +#define KINBBDPRE_SUCCESS 0 +#define KINBBDPRE_PDATA_NULL -11 +#define KINBBDPRE_FUNC_UNRECVR -12 + +/* User-supplied function Types */ + +typedef int (*KINBBDCommFn)(sunindextype Nlocal, N_Vector u, + void *user_data); + +typedef int (*KINBBDLocalFn)(sunindextype Nlocal, N_Vector uu, + N_Vector gval, void *user_data); + +/* Exported Functions */ + +SUNDIALS_EXPORT int KINBBDPrecInit(void *kinmem, sunindextype Nlocal, + sunindextype mudq, sunindextype mldq, + sunindextype mukeep, sunindextype mlkeep, + realtype dq_rel_uu, + KINBBDLocalFn gloc, KINBBDCommFn gcomm); + +/* Optional output functions */ + +SUNDIALS_EXPORT int KINBBDPrecGetWorkSpace(void *kinmem, + long int *lenrwBBDP, + long int *leniwBBDP); + +SUNDIALS_EXPORT int KINBBDPrecGetNumGfnEvals(void *kinmem, + long int *ngevalsBBDP); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/kinsol/kinsol_direct.h b/bazaar/plugin/sundials/include/kinsol/kinsol_direct.h new file mode 100644 index 000000000..91dd42143 --- /dev/null +++ b/bazaar/plugin/sundials/include/kinsol/kinsol_direct.h @@ -0,0 +1,59 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * Header file for the deprecated direct linear solver interface in + * KINSOL; these routines now just wrap the updated KINSOL generic + * linear solver interface in kinsol_ls.h. + * -----------------------------------------------------------------*/ + +#ifndef _KINDLS_H +#define _KINDLS_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/*================================================================= + Function Types (typedefs for equivalent types in kinsol_ls.h) + =================================================================*/ + +typedef KINLsJacFn KINDlsJacFn; + +/*=================================================================== + Exported Functions (wrappers for equivalent routines in kinsol_ls.h) + ===================================================================*/ + +SUNDIALS_EXPORT int KINDlsSetLinearSolver(void *kinmem, SUNLinearSolver LS, SUNMatrix A); + +SUNDIALS_EXPORT int KINDlsSetJacFn(void *kinmem, KINDlsJacFn jac); + +SUNDIALS_EXPORT int KINDlsGetWorkSpace(void *kinmem, long int *lenrw, long int *leniw); + +SUNDIALS_EXPORT int KINDlsGetNumJacEvals(void *kinmem, long int *njevals); + +SUNDIALS_EXPORT int KINDlsGetNumFuncEvals(void *kinmem, long int *nfevals); + +SUNDIALS_EXPORT int KINDlsGetLastFlag(void *kinmem, long int *flag); + +SUNDIALS_EXPORT char *KINDlsGetReturnFlagName(long int flag); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/kinsol/kinsol_ls.h b/bazaar/plugin/sundials/include/kinsol/kinsol_ls.h new file mode 100644 index 000000000..d0a177756 --- /dev/null +++ b/bazaar/plugin/sundials/include/kinsol/kinsol_ls.h @@ -0,0 +1,117 @@ +/* ---------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * Scott Cohen, Alan Hindmarsh, Radu Serban, and + * Aaron Collier @ LLNL + * ---------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ---------------------------------------------------------------- + * This is the header file for KINSOL's linear solver interface. + * ----------------------------------------------------------------*/ + +#ifndef _KINLS_H +#define _KINLS_H + +#include +#include +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/*================================================================== + KINLS Constants + ==================================================================*/ + +#define KINLS_SUCCESS 0 + +#define KINLS_MEM_NULL -1 +#define KINLS_LMEM_NULL -2 +#define KINLS_ILL_INPUT -3 +#define KINLS_MEM_FAIL -4 +#define KINLS_PMEM_NULL -5 +#define KINLS_JACFUNC_ERR -6 +#define KINLS_SUNMAT_FAIL -7 +#define KINLS_SUNLS_FAIL -8 + + +/*=============================================================== + KINLS user-supplied function prototypes + ===============================================================*/ + +typedef int (*KINLsJacFn)(N_Vector u, N_Vector fu, SUNMatrix J, + void *user_data, N_Vector tmp1, N_Vector tmp2); + +typedef int (*KINLsPrecSetupFn)(N_Vector uu, N_Vector uscale, + N_Vector fval, N_Vector fscale, + void *user_data); + +typedef int (*KINLsPrecSolveFn)(N_Vector uu, N_Vector uscale, + N_Vector fval, N_Vector fscale, + N_Vector vv, void *user_data); + +typedef int (*KINLsJacTimesVecFn)(N_Vector v, N_Vector Jv, N_Vector uu, + booleantype *new_uu, void *J_data); + + +/*================================================================== + KINLS Exported functions + ==================================================================*/ + +SUNDIALS_EXPORT int KINSetLinearSolver(void *kinmem, SUNLinearSolver LS, + SUNMatrix A); + + +/*----------------------------------------------------------------- + Optional inputs to the KINLS linear solver interface + -----------------------------------------------------------------*/ + +SUNDIALS_EXPORT int KINSetJacFn(void *kinmem, KINLsJacFn jac); +SUNDIALS_EXPORT int KINSetPreconditioner(void *kinmem, + KINLsPrecSetupFn psetup, + KINLsPrecSolveFn psolve); +SUNDIALS_EXPORT int KINSetJacTimesVecFn(void *kinmem, + KINLsJacTimesVecFn jtv); + +/*----------------------------------------------------------------- + Optional outputs from the KINLS linear solver interface + -----------------------------------------------------------------*/ + +SUNDIALS_EXPORT int KINGetLinWorkSpace(void *kinmem, + long int *lenrwLS, + long int *leniwLS); +SUNDIALS_EXPORT int KINGetNumJacEvals(void *kinmem, + long int *njevals); +SUNDIALS_EXPORT int KINGetNumLinFuncEvals(void *kinmem, + long int *nfevals); +SUNDIALS_EXPORT int KINGetNumPrecEvals(void *kinmem, + long int *npevals); +SUNDIALS_EXPORT int KINGetNumPrecSolves(void *kinmem, + long int *npsolves); +SUNDIALS_EXPORT int KINGetNumLinIters(void *kinmem, + long int *nliters); +SUNDIALS_EXPORT int KINGetNumLinConvFails(void *kinmem, + long int *nlcfails); +SUNDIALS_EXPORT int KINGetNumJtimesEvals(void *kinmem, + long int *njvevals); +SUNDIALS_EXPORT int KINGetLastLinFlag(void *kinmem, + long int *flag); +SUNDIALS_EXPORT char *KINGetLinReturnFlagName(long int flag); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/kinsol/kinsol_spils.h b/bazaar/plugin/sundials/include/kinsol/kinsol_spils.h new file mode 100644 index 000000000..f6dc9de0a --- /dev/null +++ b/bazaar/plugin/sundials/include/kinsol/kinsol_spils.h @@ -0,0 +1,73 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * Scott Cohen, Alan Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * Header file for the deprecated Scaled Preconditioned Iterative + * Linear Solver interface in KINSOL; these routines now just wrap + * the updated KINSOL generic linear solver interface in kinsol_ls.h. + * -----------------------------------------------------------------*/ + +#ifndef _KINSPILS_H +#define _KINSPILS_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/*=============================================================== + Function Types (typedefs for equivalent types in kinsol_ls.h) + ===============================================================*/ + +typedef KINLsPrecSetupFn KINSpilsPrecSetupFn; +typedef KINLsPrecSolveFn KINSpilsPrecSolveFn; +typedef KINLsJacTimesVecFn KINSpilsJacTimesVecFn; + +/*==================================================================== + Exported Functions (wrappers for equivalent routines in kinsol_ls.h) + ====================================================================*/ + +SUNDIALS_EXPORT int KINSpilsSetLinearSolver(void *kinmem, SUNLinearSolver LS); + +SUNDIALS_EXPORT int KINSpilsSetPreconditioner(void *kinmem, KINSpilsPrecSetupFn psetup, + KINSpilsPrecSolveFn psolve); + +SUNDIALS_EXPORT int KINSpilsSetJacTimesVecFn(void *kinmem, KINSpilsJacTimesVecFn jtv); + +SUNDIALS_EXPORT int KINSpilsGetWorkSpace(void *kinmem, long int *lenrwLS, long int *leniwLS); + +SUNDIALS_EXPORT int KINSpilsGetNumPrecEvals(void *kinmem, long int *npevals); + +SUNDIALS_EXPORT int KINSpilsGetNumPrecSolves(void *kinmem, long int *npsolves); + +SUNDIALS_EXPORT int KINSpilsGetNumLinIters(void *kinmem, long int *nliters); + +SUNDIALS_EXPORT int KINSpilsGetNumConvFails(void *kinmem, long int *nlcfails); + +SUNDIALS_EXPORT int KINSpilsGetNumJtimesEvals(void *kinmem, long int *njvevals); + +SUNDIALS_EXPORT int KINSpilsGetNumFuncEvals(void *kinmem, long int *nfevals); + +SUNDIALS_EXPORT int KINSpilsGetLastFlag(void *kinmem, long int *flag); + +SUNDIALS_EXPORT char *KINSpilsGetReturnFlagName(long int flag); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/nvector/cuda/ThreadPartitioning.hpp b/bazaar/plugin/sundials/include/nvector/cuda/ThreadPartitioning.hpp new file mode 100644 index 000000000..4e830ac51 --- /dev/null +++ b/bazaar/plugin/sundials/include/nvector/cuda/ThreadPartitioning.hpp @@ -0,0 +1,386 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Slaven Peles @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + */ + + + +#ifndef _THREAD_PARTITIONING_HPP_ +#define _THREAD_PARTITIONING_HPP_ + +#include +#include + +#include + +namespace suncudavec +{ + +using SUNAllocFn = void* (*)(size_t); +using SUNFreeFn = void (*)(void*); + +template +class ThreadPartitioning +{ + +public: + ThreadPartitioning() + : block_(1), + grid_(1), + shMemSize_(0), + stream_(0), + bufferSize_(0), + allocfn_(nullptr), + freefn_(nullptr), + d_buffer_(nullptr), + h_buffer_(nullptr), + ownBuffer_(true) + {} + + ThreadPartitioning(unsigned block, + SUNAllocFn allocfn = nullptr, + SUNFreeFn freefn = nullptr) + : block_(block), + grid_(1), + shMemSize_(0), + stream_(0), + bufferSize_(0), + allocfn_(allocfn), + freefn_(freefn), + d_buffer_(nullptr), + h_buffer_(nullptr), + ownBuffer_(true) + {} + + explicit ThreadPartitioning(ThreadPartitioning& p) + : block_(p.block_), + grid_(p.grid_), + shMemSize_(p.shMemSize_), + stream_(p.stream_), + allocfn_(p.allocfn_), + freefn_(p.freefn_) + {} + + virtual ~ThreadPartitioning(){} + + unsigned grid() const + { + return grid_; + } + + unsigned block() const + { + return block_; + } + + unsigned shmem() const + { + return shMemSize_; + } + + cudaStream_t stream() const + { + return stream_; + } + + unsigned int bufferSize() + { + return bufferSize_; + } + + T* devBuffer() + { + return d_buffer_; + } + + const T* devBuffer() const + { + return d_buffer_; + } + + T* hostBuffer() + { + return h_buffer_; + } + + const T* hostBuffer() const + { + return h_buffer_; + } + + void setStream(const cudaStream_t& stream) + { + stream_ = stream; + } + + virtual void copyFromDevBuffer(unsigned int n) const + { + std::cerr << "Trying to copy buffer from base class in " + << "suncudavec::ThreadPartitioning::copyFromDevBuffer\n"; + } + + /* pure virtual functions to get the relevant partitioning information */ + virtual int calcPartitioning(I N, unsigned& grid, unsigned& block, unsigned& shMemSize, cudaStream_t& stream) = 0; + virtual int calcPartitioning(I N, unsigned& grid, unsigned& block, unsigned& shMemSize) = 0; + +protected: + unsigned block_; + unsigned grid_; + unsigned shMemSize_; + unsigned bufferSize_; + cudaStream_t stream_; + T* d_buffer_; + T* h_buffer_; + bool ownBuffer_; + + /* custom allocators for the internal buffers */ + SUNAllocFn allocfn_; + SUNFreeFn freefn_; + +}; // class ThreadPartitioning + + + +template +class StreamPartitioning : public ThreadPartitioning +{ + using ThreadPartitioning::block_; + using ThreadPartitioning::grid_; + using ThreadPartitioning::stream_; + +public: + StreamPartitioning(I N, unsigned block, cudaStream_t stream) + : ThreadPartitioning(block) + { + grid_ = (N + block_ - 1) / block_; + stream_ = stream; + } + + StreamPartitioning(I N, unsigned block) + : ThreadPartitioning(block) + { + grid_ = (N + block_ - 1) / block_; + } + + explicit StreamPartitioning(StreamPartitioning& p) + : ThreadPartitioning(p) + { + } + + virtual int calcPartitioning(I N, unsigned& grid, unsigned& block, unsigned& shMemSize, + cudaStream_t& stream) + { + block = block_; + grid = (N + block_ - 1) / block_; + shMemSize = 0; + stream = stream_; + + return 0; + } + + virtual int calcPartitioning(I N, unsigned& grid, unsigned& block, unsigned& shMemSize) + { + block = block_; + grid = (N + block_ - 1) / block_; + shMemSize = 0; + + return 0; + } + +}; // class StreamPartitioning + + +template +class ReducePartitioning : public ThreadPartitioning +{ + using ThreadPartitioning::block_; + using ThreadPartitioning::grid_; + using ThreadPartitioning::shMemSize_; + using ThreadPartitioning::stream_; + using ThreadPartitioning::bufferSize_; + using ThreadPartitioning::d_buffer_; + using ThreadPartitioning::h_buffer_; + using ThreadPartitioning::ownBuffer_; + using ThreadPartitioning::allocfn_; + using ThreadPartitioning::freefn_; + +public: + ReducePartitioning(I N, unsigned block, + SUNAllocFn allocfn = nullptr, SUNFreeFn freefn = nullptr) + : ThreadPartitioning(block, allocfn, freefn) + { + grid_ = (N + (block_ * 2 - 1)) / (block_ * 2); + shMemSize_ = block_*sizeof(T); + allocateBuffer(false, allocfn != nullptr); + } + + ReducePartitioning(I N, unsigned block, cudaStream_t stream, + SUNAllocFn allocfn = nullptr, SUNFreeFn freefn = nullptr) + : ThreadPartitioning(block, allocfn, freefn) + { + grid_ = (N + (block_ * 2 - 1)) / (block_ * 2); + shMemSize_ = block_*sizeof(T); + stream_ = stream; + allocateBuffer(false, allocfn != nullptr); + } + + ReducePartitioning(T *h_buffer, T *d_buffer, I N, unsigned block, cudaStream_t stream = 0) + : ThreadPartitioning(block) + { + grid_ = (N + (block_ * 2 - 1)) / (block_ * 2); + shMemSize_ = block_*sizeof(T); + stream_ = stream; + h_buffer_ = h_buffer; + d_buffer_ = d_buffer; + ownBuffer_ = false; + } + + explicit ReducePartitioning(ReducePartitioning& p) + : ThreadPartitioning(p) + { + shMemSize_ = p.shMemSize_; + /* if device buffer and host buffer are the same, then assume managed memory */ + allocateBuffer(p.d_buffer_ == p.h_buffer_, p.allocfn_ != nullptr); + } + + ~ReducePartitioning() + { + cudaError_t err; + + if (ownBuffer_ && bufferSize_ > 0) { + + if (d_buffer_ == h_buffer_) { + /* managed memory */ + if (freefn_) { + freefn_(d_buffer_); + } else { + err = cudaFree(d_buffer_); + if(err != cudaSuccess) + std::cerr << "Failed to free device vector " + << "in suncudavec::ReducePartitioning::~ReducePartitioning " + << "(CUDA error code " << err << ")\n"; + } + d_buffer_ = h_buffer_ = nullptr; + } else { + /* unmanaged memory */ + err = cudaFree(d_buffer_); + if(err != cudaSuccess) + std::cerr << "Failed to free device vector " + << "in suncudavec::ReducePartitioning::~ReducePartitioning " + << "(CUDA error code " << err << ")\n"; + free(h_buffer_); + d_buffer_ = nullptr; + h_buffer_ = nullptr; + } + + } + } + + virtual int calcPartitioning(I N, unsigned& grid, unsigned& block, unsigned& shMemSize, + cudaStream_t& stream) + { + block = block_; + grid = (N + (block_ * 2 - 1)) / (block_ * 2); + shMemSize = block_ * sizeof(T); + stream = stream_; + + return 0; + } + + virtual int calcPartitioning(I N, unsigned& grid, unsigned& block, unsigned& shMemSize) + { + block = block_; + grid = (N + (block_ * 2 - 1)) / (block_ * 2); + shMemSize = block_ * sizeof(T); + + return 0; + } + + virtual void copyFromDevBuffer(unsigned int n) const + { + cudaError_t err; + + /* If the host and device pointers are the same, then we don't need + to do a copy (this happens in the managed memory case), but we + still need to synchronize the device to adhere to the unified + memory access rules. */ + if (h_buffer_ == d_buffer_) { + err = cudaStreamSynchronize(stream_); + if(err != cudaSuccess) + std::cerr << "Failed to synchronize stream in " + << "suncudavec::ReducePartitioning::copyFromDevBuffer " + << "(CUDA error code " << err << ")\n"; + } else { + err = cudaMemcpyAsync(h_buffer_, d_buffer_, n*sizeof(T), cudaMemcpyDeviceToHost, + stream_); + if(err != cudaSuccess) + std::cerr << "Failed to copy vector from device to host in " + << "suncudavec::ReducePartitioning::copyFromDevBuffer " + << "(CUDA error code " << err << ")\n"; + } + } + + static unsigned calcBufferSize(I N, unsigned block) + { + return (N + (block * 2 - 1)) / (block * 2) * sizeof(T); + } + +private: + int allocateBuffer(bool use_managed_memory = false, bool custom_allocator = false) + { + cudaError_t err; + + bufferSize_ = grid_ * sizeof(T); + if (bufferSize_ == 0) return 0; + + if (custom_allocator) { + + d_buffer_ = static_cast(allocfn_(bufferSize_)); + if(d_buffer_ == NULL) + std::cerr << "Failed to allocate managed buffer with custom allocator in " + << "suncudavec::ReducePartitioning::allocateBuffer\n"; + h_buffer_ = d_buffer_; + + } else if (use_managed_memory) { + + err = cudaMallocManaged((void**) &d_buffer_, bufferSize_); + if(err != cudaSuccess) + std::cerr << "Failed to allocate internal managed buffer in " + << "suncudavec::ReducePartitioning::allocateBuffer " + << "(CUDA error code " << err << ")\n"; + h_buffer_ = d_buffer_; + + } else { + + h_buffer_ = static_cast(malloc(bufferSize_)); + if(h_buffer_ == NULL) + std::cerr << "Failed to allocate internal host buffer in " + << "suncudavec::ReducePartitioning::allocateBuffer\n"; + err = cudaMalloc((void**) &d_buffer_, bufferSize_); + if(err != cudaSuccess) + std::cerr << "Failed to allocate internal device buffer " + << "in suncudavec::ReducePartitioning::allocateBuffer " + << "(CUDA error code " << err << ")\n"; + + } + + return 0; + } + +}; // class ReducePartitioning + + +} // namespace suncudavec + +#endif // _THREAD_PARTITIONING_HPP_ diff --git a/bazaar/plugin/sundials/include/nvector/cuda/Vector.hpp b/bazaar/plugin/sundials/include/nvector/cuda/Vector.hpp new file mode 100644 index 000000000..2d3f9aaa9 --- /dev/null +++ b/bazaar/plugin/sundials/include/nvector/cuda/Vector.hpp @@ -0,0 +1,371 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Slaven Peles, and Cody J. Balos @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + */ + + +/* + * Vector class + * + * Manages vector data layout for CUDA implementation of N_Vector. + * + */ + +#ifndef _NVECTOR_CUDA_HPP_ +#define _NVECTOR_CUDA_HPP_ + +#include +#include + +#include +#include "ThreadPartitioning.hpp" + +#include +#include + +namespace suncudavec +{ + +template +class Vector : public _N_VectorContent_Cuda +{ + +public: + Vector(I N, + bool use_managed_memory = false, bool allocate_data = true, + T* const h_vec = nullptr, T* const d_vec = nullptr) + : size_(N), + mem_size_(N*sizeof(T)), + ownPartitioning_(true), + ownData_(allocate_data), + managed_mem_(use_managed_memory), + allocfn_(nullptr), + freefn_(nullptr), + h_vec_(h_vec), + d_vec_(d_vec) + { + // Set partitioning + partStream_ = new StreamPartitioning(N, 256); + partReduce_ = new ReducePartitioning(N, 256); + + // Allocate data arrays + if (allocate_data) + allocate(); + } + + Vector(I N, cudaStream_t stream, + bool use_managed_memory = false, bool allocate_data = true, + T* const h_vec = nullptr, T* const d_vec = nullptr) + : size_(N), + mem_size_(N*sizeof(T)), + ownPartitioning_(true), + ownData_(allocate_data), + managed_mem_(use_managed_memory), + allocfn_(nullptr), + freefn_(nullptr), + h_vec_(h_vec), + d_vec_(d_vec) + { + // Set partitioning + partStream_ = new StreamPartitioning(N, 256, stream); + partReduce_ = new ReducePartitioning(N, 256, stream); + + // Allocate data arrays + if (allocate_data) + allocate(); + } + + Vector(I N, + SUNAllocFn allocfn, SUNFreeFn freefn, + bool allocate_data = true) + : size_(N), + mem_size_(N*sizeof(T)), + ownPartitioning_(true), + ownData_(allocate_data), + managed_mem_(true), + allocfn_(allocfn), + freefn_(freefn), + h_vec_(nullptr), + d_vec_(nullptr) + { + // Set partitioning + partStream_ = new StreamPartitioning(N, 256); + partReduce_ = new ReducePartitioning(N, 256, allocfn, freefn); + + // Allocate data arrays + if (allocate_data) + allocate(); + } + + Vector(I N, cudaStream_t stream, + SUNAllocFn allocfn, SUNFreeFn freefn, + bool allocate_data = true) + : size_(N), + mem_size_(N*sizeof(T)), + ownPartitioning_(true), + ownData_(allocate_data), + managed_mem_(true), + allocfn_(allocfn), + freefn_(freefn), + h_vec_(nullptr), + d_vec_(nullptr) + { + // Set partitioning + partStream_ = new StreamPartitioning(N, 256, stream); + partReduce_ = new ReducePartitioning(N, 256, stream, allocfn, freefn); + + // Allocate data arrays + if (allocate_data) + allocate(); + } + + // Copy constructor does not copy data array values + explicit Vector(const Vector& v) + : size_(v.size()), + mem_size_(size_*sizeof(T)), + partStream_(v.partStream_), + partReduce_(v.partReduce_), + ownPartitioning_(false), + ownData_(true), + managed_mem_(v.managed_mem_), + allocfn_(v.allocfn_), + freefn_(v.freefn_), + h_vec_(nullptr), + d_vec_(nullptr) + { + allocate(); + } + + ~Vector() + { + cudaError_t err; + + if (ownPartitioning_) { + delete partReduce_; + delete partStream_; + } + + if (ownData_) { + if (freefn_) { + freefn_(d_vec_); + d_vec_ = nullptr; + h_vec_ = nullptr; + } else { + if (!managed_mem_) + free(h_vec_); + err = cudaFree(d_vec_); + if(err != cudaSuccess) + std::cerr << "Failed to free device vector " + << "in suncudavec::Vector::~Vector " + << "(error code " << err << ")\n"; + d_vec_ = nullptr; + h_vec_ = nullptr; + } + } + } + + void allocate() + { + if (allocfn_) { + allocateCustom(); + } else if (managed_mem_) { + allocateManaged(); + } else { + allocateUnmanaged(); + } + } + + void allocateManaged() + { + cudaError_t err; + err = cudaMallocManaged((void**) &d_vec_, mem_size_); + if (err != cudaSuccess) + std::cerr << "Failed to allocate managed vector " + << "in suncudavec::Vector::allocateManaged " + << "(error code " << err << ")\n"; + h_vec_ = d_vec_; + } + + void allocateUnmanaged() + { + cudaError_t err; + + h_vec_ = static_cast(malloc(mem_size_)); + if(h_vec_ == nullptr) + std::cerr << "Failed to allocate host vector " + << "in suncudavec::Vector::allocateUnmanaged\n"; + + err = cudaMalloc((void**) &d_vec_, mem_size_); + if(err != cudaSuccess) + std::cerr << "Failed to allocate device vector " + << "in suncudavec::Vector::allocateUnmanaged " + << "(error code " << err << ")\n"; + } + + void allocateCustom() + { + /* We assume managed memory when a custom allocator is provided */ + d_vec_ = (realtype *) allocfn_(mem_size_); + if (d_vec_ == nullptr) + std::cerr << "Failed to allocate vector with user-provied allocator " + << "in suncudavec::Vector::allocateCustom()\n"; + h_vec_ = d_vec_; + } + + int size() const + { + return size_; + } + + T* host() + { + // If the vector is using managed memory, and a user + // is accessing a data array, then we need to synchronzie + // to ensure all kernels have completed since a memcpy + // won't have to happen. + if (managed_mem_) + cudaStreamSynchronize(partReduce_->stream()); + return h_vec_; + } + + const T* host() const + { + // If the vector is using managed memory, and a user + // is accessing a data array, then we need to synchronzie + // to ensure all kernels have completed since a memcpy + // won't have to happen. + if (managed_mem_) + cudaStreamSynchronize(partReduce_->stream()); + return h_vec_; + } + + T* device() + { + // If the vector is using managed memory, and a user + // is accessing a data array, then we need to synchronzie + // to ensure all kernels have completed since a memcpy + // won't have to happen. + if (managed_mem_) + cudaStreamSynchronize(partReduce_->stream()); + return d_vec_; + } + + const T* device() const + { + // If the vector is using managed memory, and a user + // is accessing a data array, then we need to synchronzie + // to ensure all kernels have completed since a memcpy + // won't have to happen. + if (managed_mem_) + cudaStreamSynchronize(partReduce_->stream()); + return d_vec_; + } + + bool isManaged() const + { + return managed_mem_; + } + + void copyToDev() + { + cudaError_t err; + + /* If the host and device pointers are the same, then we don't need + to do a copy (this happens in the managed memory case), but we + still need to synchronize the device to adhere to the unified + memory access rules. */ + if (h_vec_ == d_vec_) { + err = cudaStreamSynchronize(partReduce_->stream()); + if(err != cudaSuccess) + std::cerr << "Failed to synchronize stream in " + << "suncudavec::Vector::copyToDev " + << "(error code " << err << ")\n"; + } else { + err = cudaMemcpyAsync(d_vec_, h_vec_, mem_size_, cudaMemcpyHostToDevice, + partReduce_->stream()); + if(err != cudaSuccess) + std::cerr << "Failed to copy vector from host to device in " + << "suncudavec::Vector::copyToDev " + << "(error code " << err << ")\n"; + } + } + + void copyFromDev() + { + cudaError_t err; + + /* If the host and device pointers are the same, then we don't need + to do a copy (this happens in the managed memory case), but we + still need to synchronize the device to adhere to the unified + memory access rules. */ + if (h_vec_ == d_vec_) { + err = cudaStreamSynchronize(partReduce_->stream()); + if(err != cudaSuccess) + std::cerr << "Failed to synchronize stream in " + << "suncudavec::Vector::copyFromDev " + << "(error code " << err << ")\n"; + } else { + err = cudaMemcpyAsync(h_vec_, d_vec_, mem_size_, cudaMemcpyDeviceToHost, + partReduce_->stream()); + if(err != cudaSuccess) + std::cerr << "Failed to copy vector from device to host in " + << "suncudavec::Vector::copyFromDev " + << "(error code " << err << ")\n"; + } + } + + void setPartitioning(ThreadPartitioning* stream, ThreadPartitioning* reduce) + { + if (ownPartitioning_) { + delete partStream_; + delete partReduce_; + } + partStream_ = stream; + partReduce_ = reduce; + ownPartitioning_ = false; + } + + ThreadPartitioning& partStream() const + { + return *partStream_; + } + + ThreadPartitioning& partReduce() const + { + return *partReduce_; + } + + +private: + I size_; + I mem_size_; + T* h_vec_; + T* d_vec_; + ThreadPartitioning* partStream_; + ThreadPartitioning* partReduce_; + bool ownPartitioning_; + bool ownData_; + bool managed_mem_; + SUNAllocFn allocfn_; + SUNFreeFn freefn_; + +}; + + +} // namespace suncudavec + + + + +#endif // _NVECTOR_CUDA_HPP_ diff --git a/bazaar/plugin/sundials/include/nvector/nvector_cuda.h b/bazaar/plugin/sundials/include/nvector/nvector_cuda.h new file mode 100644 index 000000000..93cadcb09 --- /dev/null +++ b/bazaar/plugin/sundials/include/nvector/nvector_cuda.h @@ -0,0 +1,189 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Slaven Peles and Cody J. Balos @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the CUDA implementation of the + * NVECTOR module. + * + * Notes: + * + * - The definition of the generic N_Vector structure can be found + * in the header file sundials_nvector.h. + * + * - The definitions of the types 'realtype' and 'sunindextype' can + * be found in the 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 + * be distinct. For example, the following call: + * + * N_VLinearSum_Cuda(a,x,b,y,y); + * + * (which stores the result of the operation a*x+b*y in y) + * is legal. + * -----------------------------------------------------------------*/ + +#ifndef _NVECTOR_CUDA_H +#define _NVECTOR_CUDA_H + +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ----------------------------------------------------------------- + * CUDA implementation of N_Vector + * ----------------------------------------------------------------- + */ + +/* + * CUDA implementation of the N_Vector 'content' is in C++ class + * Vector. The class inherits from structure _N_VectorContent_Cuda + * to create C <--> C++ interface. + */ + +struct _N_VectorContent_Cuda {}; + +typedef struct _N_VectorContent_Cuda *N_VectorContent_Cuda; + +/* + * ----------------------------------------------------------------- + * Functions exported by nvector_cuda + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VNew_Cuda(sunindextype length); + +SUNDIALS_EXPORT N_Vector N_VNewManaged_Cuda(sunindextype length); + +SUNDIALS_EXPORT N_Vector N_VNewEmpty_Cuda(); + +SUNDIALS_EXPORT N_Vector N_VMake_Cuda(sunindextype length, + realtype *h_vdata, + realtype *d_vdata); + +SUNDIALS_EXPORT N_Vector N_VMakeManaged_Cuda(sunindextype length, + realtype *vdata); + +SUNDIALS_EXPORT N_Vector N_VMakeWithManagedAllocator_Cuda(sunindextype length, + void* (*allocfn)(size_t), + void (*freefn)(void*)); + +SUNDIALS_EXPORT sunindextype N_VGetLength_Cuda(N_Vector v); + +SUNDIALS_EXPORT realtype *N_VGetHostArrayPointer_Cuda(N_Vector v); + +SUNDIALS_EXPORT realtype *N_VGetDeviceArrayPointer_Cuda(N_Vector v); + +SUNDIALS_EXPORT booleantype N_VIsManagedMemory_Cuda(N_Vector x); + +SUNDIALS_EXPORT void N_VSetCudaStream_Cuda(N_Vector x, cudaStream_t *stream); + +SUNDIALS_EXPORT void N_VCopyToDevice_Cuda(N_Vector v); + +SUNDIALS_EXPORT void N_VCopyFromDevice_Cuda(N_Vector v); + +SUNDIALS_EXPORT void N_VPrint_Cuda(N_Vector v); + +SUNDIALS_EXPORT void N_VPrintFile_Cuda(N_Vector v, FILE *outfile); + +SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Cuda(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VClone_Cuda(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy_Cuda(N_Vector v); +SUNDIALS_EXPORT void N_VSpace_Cuda(N_Vector v, sunindextype *lrw, sunindextype *liw); + +/* standard vector operations */ +SUNDIALS_EXPORT void N_VLinearSum_Cuda(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VConst_Cuda(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd_Cuda(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv_Cuda(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale_Cuda(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs_Cuda(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv_Cuda(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst_Cuda(N_Vector x, realtype b, N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd_Cuda(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm_Cuda(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm_Cuda(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask_Cuda(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT realtype N_VMin_Cuda(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm_Cuda(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm_Cuda(N_Vector x); +SUNDIALS_EXPORT void N_VCompare_Cuda(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest_Cuda(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask_Cuda(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient_Cuda(N_Vector num, N_Vector denom); + +/* fused vector operations */ +SUNDIALS_EXPORT int N_VLinearCombination_Cuda(int nvec, realtype* c, N_Vector* X, + N_Vector Z); +SUNDIALS_EXPORT int N_VScaleAddMulti_Cuda(int nvec, realtype* c, N_Vector X, + N_Vector* Y, N_Vector* Z); +SUNDIALS_EXPORT int N_VDotProdMulti_Cuda(int nvec, N_Vector x, N_Vector* Y, + realtype* dotprods); + +/* vector array operations */ +SUNDIALS_EXPORT int N_VLinearSumVectorArray_Cuda(int nvec, + realtype a, N_Vector* X, + realtype b, N_Vector* Y, + N_Vector* Z); +SUNDIALS_EXPORT int N_VScaleVectorArray_Cuda(int nvec, realtype* c, N_Vector* X, + N_Vector* Z); +SUNDIALS_EXPORT int N_VConstVectorArray_Cuda(int nvec, realtype c, N_Vector* Z); +SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray_Cuda(int nvec, int nsum, + realtype* a, N_Vector* X, + N_Vector** Y, N_Vector** Z); +SUNDIALS_EXPORT int N_VLinearCombinationVectorArray_Cuda(int nvec, int nsum, + realtype* c, + N_Vector** X, + N_Vector* Z); +SUNDIALS_EXPORT int N_VWrmsNormVectorArray_Cuda(int nvec, N_Vector* X, + N_Vector* W, realtype* nrm); +SUNDIALS_EXPORT int N_VWrmsNormMaskVectorArray_Cuda(int nvec, N_Vector* X, + N_Vector* W, N_Vector id, + realtype* nrm); + +/* OPTIONAL local reduction kernels (no parallel communication) */ +SUNDIALS_EXPORT realtype N_VWSqrSumLocal_Cuda(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWSqrSumMaskLocal_Cuda(N_Vector x, N_Vector w, N_Vector id); + + +/* + * ----------------------------------------------------------------- + * Enable / disable fused vector operations + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int N_VEnableFusedOps_Cuda(N_Vector v, booleantype tf); + +SUNDIALS_EXPORT int N_VEnableLinearCombination_Cuda(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleAddMulti_Cuda(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableDotProdMulti_Cuda(N_Vector v, booleantype tf); + +SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_Cuda(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleVectorArray_Cuda(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableConstVectorArray_Cuda(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableWrmsNormVectorArray_Cuda(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableWrmsNormMaskVectorArray_Cuda(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleAddMultiVectorArray_Cuda(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableLinearCombinationVectorArray_Cuda(N_Vector v, booleantype tf); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/nvector/nvector_manyvector.h b/bazaar/plugin/sundials/include/nvector/nvector_manyvector.h new file mode 100644 index 000000000..813fd56a6 --- /dev/null +++ b/bazaar/plugin/sundials/include/nvector/nvector_manyvector.h @@ -0,0 +1,163 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the main header file for the "ManyVector" implementation + * of the NVECTOR module. + * + * Notes: + * + * - The definition of the generic N_Vector structure can be found + * in the header file sundials_nvector.h. + * + * - The definitions of the types 'realtype' and 'sunindextype' can + * be found in the 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 + * be distinct. For example, the following call: + * + * N_VLinearSum_ManyVector(a,x,b,y,y); + * + * (which stores the result of the operation a*x+b*y in y) + * is legal. + * -----------------------------------------------------------------*/ + +#ifndef _NVECTOR_MANY_VECTOR_H +#define _NVECTOR_MANY_VECTOR_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* ----------------------------------------------------------------- + ManyVector implementation of N_Vector + ----------------------------------------------------------------- */ + +struct _N_VectorContent_ManyVector { + sunindextype num_subvectors; /* number of vectors attached */ + sunindextype global_length; /* overall manyvector length */ + N_Vector* subvec_array; /* pointer to N_Vector array */ + booleantype own_data; /* flag indicating data ownership */ +}; + +typedef struct _N_VectorContent_ManyVector *N_VectorContent_ManyVector; + +/* ----------------------------------------------------------------- + functions exported by ManyVector + ----------------------------------------------------------------- */ + +SUNDIALS_EXPORT N_Vector N_VNew_ManyVector(sunindextype num_subvectors, + N_Vector *vec_array); + +SUNDIALS_EXPORT N_Vector N_VGetSubvector_ManyVector(N_Vector v, + sunindextype vec_num); + +SUNDIALS_EXPORT realtype *N_VGetSubvectorArrayPointer_ManyVector(N_Vector v, + sunindextype vec_num); + +SUNDIALS_EXPORT int N_VSetSubvectorArrayPointer_ManyVector(realtype *v_data, N_Vector v, + sunindextype vec_num); + +SUNDIALS_EXPORT sunindextype N_VGetNumSubvectors_ManyVector(N_Vector v); + +/* standard vector operations */ +SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_ManyVector(N_Vector v); +SUNDIALS_EXPORT N_Vector N_VCloneEmpty_ManyVector(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VClone_ManyVector(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy_ManyVector(N_Vector v); +SUNDIALS_EXPORT void N_VSpace_ManyVector(N_Vector v, sunindextype *lrw, + sunindextype *liw); +SUNDIALS_EXPORT sunindextype N_VGetLength_ManyVector(N_Vector v); +SUNDIALS_EXPORT void N_VLinearSum_ManyVector(realtype a, N_Vector x, + realtype b, N_Vector y, + N_Vector z); +SUNDIALS_EXPORT void N_VConst_ManyVector(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd_ManyVector(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv_ManyVector(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale_ManyVector(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs_ManyVector(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv_ManyVector(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst_ManyVector(N_Vector x, realtype b, + N_Vector z); +SUNDIALS_EXPORT realtype N_VWrmsNorm_ManyVector(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask_ManyVector(N_Vector x, N_Vector w, + N_Vector id); +SUNDIALS_EXPORT realtype N_VWL2Norm_ManyVector(N_Vector x, N_Vector w); +SUNDIALS_EXPORT void N_VCompare_ManyVector(realtype c, N_Vector x, N_Vector z); + +/* fused vector operations */ +SUNDIALS_EXPORT int N_VLinearCombination_ManyVector(int nvec, realtype* c, + N_Vector* V, N_Vector z); +SUNDIALS_EXPORT int N_VScaleAddMulti_ManyVector(int nvec, realtype* a, + N_Vector x, N_Vector* Y, + N_Vector* Z); +SUNDIALS_EXPORT int N_VDotProdMulti_ManyVector(int nvec, N_Vector x, + N_Vector *Y, + realtype* dotprods); + +/* vector array operations */ +SUNDIALS_EXPORT int N_VLinearSumVectorArray_ManyVector(int nvec, + realtype a, N_Vector* X, + realtype b, N_Vector* Y, + N_Vector* Z); +SUNDIALS_EXPORT int N_VScaleVectorArray_ManyVector(int nvec, realtype* c, + N_Vector* X, N_Vector* Z); +SUNDIALS_EXPORT int N_VConstVectorArray_ManyVector(int nvecs, realtype c, + N_Vector* Z); +SUNDIALS_EXPORT int N_VWrmsNormVectorArray_ManyVector(int nvecs, N_Vector* X, + N_Vector* W, realtype* nrm); +SUNDIALS_EXPORT int N_VWrmsNormMaskVectorArray_ManyVector(int nvec, + N_Vector* X, + N_Vector* W, + N_Vector id, + realtype* nrm); + +/* OPTIONAL local reduction kernels (no parallel communication) */ +SUNDIALS_EXPORT realtype N_VDotProdLocal_ManyVector(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNormLocal_ManyVector(N_Vector x); +SUNDIALS_EXPORT realtype N_VMinLocal_ManyVector(N_Vector x); +SUNDIALS_EXPORT realtype N_VL1NormLocal_ManyVector(N_Vector x); +SUNDIALS_EXPORT realtype N_VWSqrSumLocal_ManyVector(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWSqrSumMaskLocal_ManyVector(N_Vector x, N_Vector w, + N_Vector id); +SUNDIALS_EXPORT booleantype N_VInvTestLocal_ManyVector(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMaskLocal_ManyVector(N_Vector c, N_Vector x, + N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotientLocal_ManyVector(N_Vector num, + N_Vector denom); + +/* ----------------------------------------------------------------- + Enable / disable fused vector operations + ----------------------------------------------------------------- */ + +SUNDIALS_EXPORT int N_VEnableFusedOps_ManyVector(N_Vector v, booleantype tf); + +SUNDIALS_EXPORT int N_VEnableLinearCombination_ManyVector(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleAddMulti_ManyVector(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableDotProdMulti_ManyVector(N_Vector v, booleantype tf); + +SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_ManyVector(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleVectorArray_ManyVector(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableConstVectorArray_ManyVector(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableWrmsNormVectorArray_ManyVector(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableWrmsNormMaskVectorArray_ManyVector(N_Vector v, booleantype tf); + +#ifdef __cplusplus +} +#endif +#endif diff --git a/bazaar/plugin/sundials/include/nvector/nvector_openmp.h b/bazaar/plugin/sundials/include/nvector/nvector_openmp.h new file mode 100644 index 000000000..4ad02f190 --- /dev/null +++ b/bazaar/plugin/sundials/include/nvector/nvector_openmp.h @@ -0,0 +1,203 @@ +/* ----------------------------------------------------------------- + * Programmer(s): David J. Gardner and Carol S. Woodward @ LLNL + * ----------------------------------------------------------------- + * Acknowledgements: This NVECTOR module is based on the NVECTOR + * Serial module by Scott D. Cohen, Alan C. + * Hindmarsh, Radu Serban, and Aaron Collier + * @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the OpenMP implementation of the + * NVECTOR module. + * + * Notes: + * + * - The definition of the generic N_Vector structure can be found + * in the header file sundials_nvector.h. + * + * - The definition of the type 'realtype' can be found in the + * 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 + * be distinct. For example, the following call: + * + * N_VLinearSum_OpenMP(a,x,b,y,y); + * + * (which stores the result of the operation a*x+b*y in y) + * is legal. + * -----------------------------------------------------------------*/ + +#ifndef _NVECTOR_OPENMP_H +#define _NVECTOR_OPENMP_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ----------------------------------------------------------------- + * OpenMP implementation of N_Vector + * ----------------------------------------------------------------- + */ + +struct _N_VectorContent_OpenMP { + sunindextype length; /* vector length */ + booleantype own_data; /* data ownership flag */ + realtype *data; /* data array */ + int num_threads; /* number of OpenMP threads */ +}; + +typedef struct _N_VectorContent_OpenMP *N_VectorContent_OpenMP; + +/* + * ----------------------------------------------------------------- + * Macros NV_CONTENT_OMP, NV_DATA_OMP, NV_OWN_DATA_OMP, + * NV_LENGTH_OMP, and NV_Ith_OMP + * ----------------------------------------------------------------- + */ + +#define NV_CONTENT_OMP(v) ( (N_VectorContent_OpenMP)(v->content) ) + +#define NV_LENGTH_OMP(v) ( NV_CONTENT_OMP(v)->length ) + +#define NV_NUM_THREADS_OMP(v) ( NV_CONTENT_OMP(v)->num_threads ) + +#define NV_OWN_DATA_OMP(v) ( NV_CONTENT_OMP(v)->own_data ) + +#define NV_DATA_OMP(v) ( NV_CONTENT_OMP(v)->data ) + +#define NV_Ith_OMP(v,i) ( NV_DATA_OMP(v)[i] ) + +/* + * ----------------------------------------------------------------- + * Functions exported by nvector_openmp + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VNew_OpenMP(sunindextype vec_length, int num_threads); + +SUNDIALS_EXPORT N_Vector N_VNewEmpty_OpenMP(sunindextype vec_length, int num_threads); + +SUNDIALS_EXPORT N_Vector N_VMake_OpenMP(sunindextype vec_length, realtype *v_data, + int num_threads); + +SUNDIALS_EXPORT N_Vector* N_VCloneVectorArray_OpenMP(int count, N_Vector w); + +SUNDIALS_EXPORT N_Vector* N_VCloneVectorArrayEmpty_OpenMP(int count, N_Vector w); + +SUNDIALS_EXPORT void N_VDestroyVectorArray_OpenMP(N_Vector* vs, int count); + +SUNDIALS_EXPORT sunindextype N_VGetLength_OpenMP(N_Vector v); + +SUNDIALS_EXPORT void N_VPrint_OpenMP(N_Vector v); + +SUNDIALS_EXPORT void N_VPrintFile_OpenMP(N_Vector v, FILE *outfile); + + +SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_OpenMP(N_Vector v); +SUNDIALS_EXPORT N_Vector N_VCloneEmpty_OpenMP(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VClone_OpenMP(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy_OpenMP(N_Vector v); +SUNDIALS_EXPORT void N_VSpace_OpenMP(N_Vector v, sunindextype *lrw, sunindextype *liw); +SUNDIALS_EXPORT realtype *N_VGetArrayPointer_OpenMP(N_Vector v); +SUNDIALS_EXPORT void N_VSetArrayPointer_OpenMP(realtype *v_data, N_Vector v); + +/* standard vector operations */ +SUNDIALS_EXPORT void N_VLinearSum_OpenMP(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VConst_OpenMP(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd_OpenMP(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv_OpenMP(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale_OpenMP(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs_OpenMP(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv_OpenMP(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst_OpenMP(N_Vector x, realtype b, N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd_OpenMP(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm_OpenMP(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm_OpenMP(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask_OpenMP(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT realtype N_VMin_OpenMP(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm_OpenMP(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm_OpenMP(N_Vector x); +SUNDIALS_EXPORT void N_VCompare_OpenMP(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest_OpenMP(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask_OpenMP(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient_OpenMP(N_Vector num, N_Vector denom); + +/* fused vector operations */ +SUNDIALS_EXPORT int N_VLinearCombination_OpenMP(int nvec, realtype* c, + N_Vector* V, N_Vector z); +SUNDIALS_EXPORT int N_VScaleAddMulti_OpenMP(int nvec, realtype* a, N_Vector x, + N_Vector* Y, N_Vector* Z); +SUNDIALS_EXPORT int N_VDotProdMulti_OpenMP(int nvec, N_Vector x, + N_Vector* Y, realtype* dotprods); + +/* vector array operations */ +SUNDIALS_EXPORT int N_VLinearSumVectorArray_OpenMP(int nvec, + realtype a, N_Vector* X, + realtype b, N_Vector* Y, + N_Vector* Z); +SUNDIALS_EXPORT int N_VScaleVectorArray_OpenMP(int nvec, realtype* c, + N_Vector* X, N_Vector* Z); +SUNDIALS_EXPORT int N_VConstVectorArray_OpenMP(int nvecs, realtype c, + N_Vector* Z); +SUNDIALS_EXPORT int N_VWrmsNormVectorArray_OpenMP(int nvecs, N_Vector* X, + N_Vector* W, realtype* nrm); +SUNDIALS_EXPORT int N_VWrmsNormMaskVectorArray_OpenMP(int nvecs, N_Vector* X, + N_Vector* W, N_Vector id, + realtype* nrm); +SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray_OpenMP(int nvec, int nsum, + realtype* a, + N_Vector* X, + N_Vector** Y, + N_Vector** Z); +SUNDIALS_EXPORT int N_VLinearCombinationVectorArray_OpenMP(int nvec, int nsum, + realtype* c, + N_Vector** X, + N_Vector* Z); + +/* OPTIONAL local reduction kernels (no parallel communication) */ +SUNDIALS_EXPORT realtype N_VWSqrSumLocal_OpenMP(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWSqrSumMaskLocal_OpenMP(N_Vector x, N_Vector w, + N_Vector id); + + +/* + * ----------------------------------------------------------------- + * Enable / disable fused vector operations + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int N_VEnableFusedOps_OpenMP(N_Vector v, booleantype tf); + +SUNDIALS_EXPORT int N_VEnableLinearCombination_OpenMP(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleAddMulti_OpenMP(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableDotProdMulti_OpenMP(N_Vector v, booleantype tf); + +SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_OpenMP(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleVectorArray_OpenMP(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableConstVectorArray_OpenMP(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableWrmsNormVectorArray_OpenMP(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableWrmsNormMaskVectorArray_OpenMP(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleAddMultiVectorArray_OpenMP(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableLinearCombinationVectorArray_OpenMP(N_Vector v, booleantype tf); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/nvector/nvector_openmpdev.h b/bazaar/plugin/sundials/include/nvector/nvector_openmpdev.h new file mode 100644 index 000000000..3bfec9771 --- /dev/null +++ b/bazaar/plugin/sundials/include/nvector/nvector_openmpdev.h @@ -0,0 +1,207 @@ +/* ------------------------------------------------------------------- + * Programmer(s): David J. Gardner and Shelby Lockhart @ LLNL + * ------------------------------------------------------------------- + * Acknowledgements: This NVECTOR module is based on the NVECTOR + * Serial module by Scott D. Cohen, Alan C. + * Hindmarsh, Radu Serban, and Aaron Collier + * @ LLNL + * ------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the OpenMP 4.5+ implementation of the + * NVECTOR module. + * + * Notes: + * + * - The definition of the generic N_Vector structure can be found + * in the header file sundials_nvector.h. + * + * - The definition of the type 'realtype' can be found in the + * 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 + * be distinct. For example, the following call: + * + * N_VLinearSum_OpenMPDEV(a,x,b,y,y); + * + * (which stores the result of the operation a*x+b*y in y) + * is legal. + * -----------------------------------------------------------------*/ + +#ifndef _NVECTOR_OPENMPDEV_H +#define _NVECTOR_OPENMPDEV_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ----------------------------------------------------------------- + * OpenMPDEV implementation of N_Vector + * ----------------------------------------------------------------- + */ + +struct _N_VectorContent_OpenMPDEV { + sunindextype length; /* vector length */ + booleantype own_data; /* data ownership flag */ + realtype *host_data; /* host data array */ + realtype *dev_data; /* device data array */ +}; + +typedef struct _N_VectorContent_OpenMPDEV *N_VectorContent_OpenMPDEV; + +/* + * ----------------------------------------------------------------- + * Macros NV_CONTENT_OMPDEV, NV_DATA_HOST_OMPDEV, NV_OWN_DATA_OMPDEV, + * NV_LENGTH_OMPDEV, and NV_Ith_OMPDEV + * ----------------------------------------------------------------- + */ + +#define NV_CONTENT_OMPDEV(v) ( (N_VectorContent_OpenMPDEV)(v->content) ) + +#define NV_LENGTH_OMPDEV(v) ( NV_CONTENT_OMPDEV(v)->length ) + +#define NV_OWN_DATA_OMPDEV(v) ( NV_CONTENT_OMPDEV(v)->own_data ) + +#define NV_DATA_HOST_OMPDEV(v) ( NV_CONTENT_OMPDEV(v)->host_data ) + +#define NV_DATA_DEV_OMPDEV(v) ( NV_CONTENT_OMPDEV(v)->dev_data ) + +/* + * ----------------------------------------------------------------- + * Functions exported by nvector_openmpdev + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VNew_OpenMPDEV(sunindextype vec_length); + +SUNDIALS_EXPORT N_Vector N_VNewEmpty_OpenMPDEV(sunindextype vec_length); + +SUNDIALS_EXPORT N_Vector N_VMake_OpenMPDEV(sunindextype vec_length, + realtype *h_data, + realtype *v_data); + +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray_OpenMPDEV(int count, N_Vector w); + +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArrayEmpty_OpenMPDEV(int count, N_Vector w); + +SUNDIALS_EXPORT void N_VDestroyVectorArray_OpenMPDEV(N_Vector *vs, int count); + +SUNDIALS_EXPORT sunindextype N_VGetLength_OpenMPDEV(N_Vector v); + +SUNDIALS_EXPORT realtype *N_VGetHostArrayPointer_OpenMPDEV(N_Vector v); + +SUNDIALS_EXPORT realtype *N_VGetDeviceArrayPointer_OpenMPDEV(N_Vector v); + +SUNDIALS_EXPORT void N_VPrint_OpenMPDEV(N_Vector v); + +SUNDIALS_EXPORT void N_VPrintFile_OpenMPDEV(N_Vector v, FILE *outfile); + +SUNDIALS_EXPORT void N_VCopyToDevice_OpenMPDEV(N_Vector v); + +SUNDIALS_EXPORT void N_VCopyFromDevice_OpenMPDEV(N_Vector v); + +SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_OpenMPDEV(N_Vector v); +SUNDIALS_EXPORT N_Vector N_VCloneEmpty_OpenMPDEV(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VClone_OpenMPDEV(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy_OpenMPDEV(N_Vector v); +SUNDIALS_EXPORT void N_VSpace_OpenMPDEV(N_Vector v, sunindextype *lrw, sunindextype *liw); + +/* standard vector operations */ +SUNDIALS_EXPORT void N_VLinearSum_OpenMPDEV(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VConst_OpenMPDEV(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd_OpenMPDEV(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv_OpenMPDEV(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale_OpenMPDEV(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs_OpenMPDEV(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv_OpenMPDEV(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst_OpenMPDEV(N_Vector x, realtype b, N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd_OpenMPDEV(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm_OpenMPDEV(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm_OpenMPDEV(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask_OpenMPDEV(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT realtype N_VMin_OpenMPDEV(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm_OpenMPDEV(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm_OpenMPDEV(N_Vector x); +SUNDIALS_EXPORT void N_VCompare_OpenMPDEV(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest_OpenMPDEV(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask_OpenMPDEV(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient_OpenMPDEV(N_Vector num, N_Vector denom); + +/* fused vector operations */ +SUNDIALS_EXPORT int N_VLinearCombination_OpenMPDEV(int nvec, realtype* c, + N_Vector* V, N_Vector z); +SUNDIALS_EXPORT int N_VScaleAddMulti_OpenMPDEV(int nvec, realtype* a, N_Vector x, + N_Vector* Y, N_Vector* Z); +SUNDIALS_EXPORT int N_VDotProdMulti_OpenMPDEV(int nvec, N_Vector x, + N_Vector *Y, realtype* dotprods); + +/* vector array operations */ +SUNDIALS_EXPORT int N_VLinearSumVectorArray_OpenMPDEV(int nvec, + realtype a, N_Vector* X, + realtype b, N_Vector* Y, + N_Vector* Z); +SUNDIALS_EXPORT int N_VScaleVectorArray_OpenMPDEV(int nvec, realtype* c, + N_Vector* X, N_Vector* Z); +SUNDIALS_EXPORT int N_VConstVectorArray_OpenMPDEV(int nvecs, realtype c, + N_Vector* Z); +SUNDIALS_EXPORT int N_VWrmsNormVectorArray_OpenMPDEV(int nvecs, N_Vector* X, + N_Vector* W, realtype* nrm); +SUNDIALS_EXPORT int N_VWrmsNormMaskVectorArray_OpenMPDEV(int nvecs, N_Vector* X, + N_Vector* W, N_Vector id, + realtype* nrm); +SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray_OpenMPDEV(int nvec, int nsum, + realtype* a, + N_Vector* X, + N_Vector** Y, + N_Vector** Z); +SUNDIALS_EXPORT int N_VLinearCombinationVectorArray_OpenMPDEV(int nvec, int nsum, + realtype* c, + N_Vector** X, + N_Vector* Z); + +/* OPTIONAL local reduction kernels (no parallel communication) */ +SUNDIALS_EXPORT realtype N_VWSqrSumLocal_OpenMPDEV(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWSqrSumMaskLocal_OpenMPDEV(N_Vector x, N_Vector w, + N_Vector id); + + +/* + * ----------------------------------------------------------------- + * Enable / disable fused vector operations + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int N_VEnableFusedOps_OpenMPDEV(N_Vector v, booleantype tf); + +SUNDIALS_EXPORT int N_VEnableLinearCombination_OpenMPDEV(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleAddMulti_OpenMPDEV(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableDotProdMulti_OpenMPDEV(N_Vector v, booleantype tf); + +SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_OpenMPDEV(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleVectorArray_OpenMPDEV(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableConstVectorArray_OpenMPDEV(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableWrmsNormVectorArray_OpenMPDEV(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableWrmsNormMaskVectorArray_OpenMPDEV(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleAddMultiVectorArray_OpenMPDEV(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableLinearCombinationVectorArray_OpenMPDEV(N_Vector v, booleantype tf); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/nvector/nvector_raja.h b/bazaar/plugin/sundials/include/nvector/nvector_raja.h new file mode 100644 index 000000000..da8f13ed4 --- /dev/null +++ b/bazaar/plugin/sundials/include/nvector/nvector_raja.h @@ -0,0 +1,166 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Slaven Peles @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the RAJA implementation of the + * NVECTOR module. + * + * Notes: + * + * - The definition of the generic N_Vector structure can be found + * in the header file sundials_nvector.h. + * + * - The definition of the type 'realtype' can be found in the + * 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 + * be distinct. For example, the following call: + * + * N_VLinearSum_Raja(a,x,b,y,y); + * + * (which stores the result of the operation a*x+b*y in y) + * is legal. + * -----------------------------------------------------------------*/ + +#ifndef _NVECTOR_RAJA_H +#define _NVECTOR_RAJA_H + +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ----------------------------------------------------------------- + * RAJA implementation of N_Vector + * ----------------------------------------------------------------- + */ + +/* RAJA 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_Raja {}; + +typedef struct _N_VectorContent_Raja *N_VectorContent_Raja; + +/* + * ----------------------------------------------------------------- + * Functions exported by nvector_raja + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VNew_Raja(sunindextype length); + +SUNDIALS_EXPORT N_Vector N_VNewEmpty_Raja(); + +SUNDIALS_EXPORT N_Vector N_VMake_Raja(N_VectorContent_Raja c); + +SUNDIALS_EXPORT sunindextype N_VGetLength_Raja(N_Vector v); + +SUNDIALS_EXPORT realtype *N_VGetHostArrayPointer_Raja(N_Vector v); + +SUNDIALS_EXPORT realtype *N_VGetDeviceArrayPointer_Raja(N_Vector v); + +SUNDIALS_EXPORT void N_VCopyToDevice_Raja(N_Vector v); + +SUNDIALS_EXPORT void N_VCopyFromDevice_Raja(N_Vector v); + +SUNDIALS_EXPORT void N_VPrint_Raja(N_Vector v); + +SUNDIALS_EXPORT void N_VPrintFile_Raja(N_Vector v, FILE *outfile); + +SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_Raja(N_Vector v); +SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Raja(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VClone_Raja(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy_Raja(N_Vector v); +SUNDIALS_EXPORT void N_VSpace_Raja(N_Vector v, sunindextype *lrw, sunindextype *liw); +SUNDIALS_EXPORT realtype *N_VGetArrayPointer_Raja(N_Vector v); +SUNDIALS_EXPORT void N_VSetArrayPointer_Raja(realtype *v_data, N_Vector v); + +/* standard vector operations */ +SUNDIALS_EXPORT void N_VLinearSum_Raja(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VConst_Raja(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd_Raja(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv_Raja(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale_Raja(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs_Raja(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv_Raja(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst_Raja(N_Vector x, realtype b, N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd_Raja(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm_Raja(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm_Raja(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask_Raja(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT realtype N_VMin_Raja(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm_Raja(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm_Raja(N_Vector x); +SUNDIALS_EXPORT void N_VCompare_Raja(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest_Raja(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask_Raja(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient_Raja(N_Vector num, N_Vector denom); + +/* fused vector operations */ +SUNDIALS_EXPORT int N_VLinearCombination_Raja(int nvec, realtype* c, N_Vector* X, + N_Vector z); +SUNDIALS_EXPORT int N_VScaleAddMulti_Raja(int nvec, realtype* c, N_Vector x, + N_Vector* Y, N_Vector* Z); + +/* vector array operations */ +SUNDIALS_EXPORT int N_VLinearSumVectorArray_Raja(int nvec, + realtype a, N_Vector* X, + realtype b, N_Vector* Y, + N_Vector* Z); +SUNDIALS_EXPORT int N_VScaleVectorArray_Raja(int nvec, realtype* c, N_Vector* X, + N_Vector* Z); +SUNDIALS_EXPORT int N_VConstVectorArray_Raja(int nvec, realtype c, N_Vector* Z); +SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray_Raja(int nvec, int nsum, + realtype* a, + N_Vector* X, N_Vector** Y, + N_Vector** Z); +SUNDIALS_EXPORT int N_VLinearCombinationVectorArray_Raja(int nvec, int nsum, + realtype* c, + N_Vector** X, + N_Vector* Z); + +/* OPTIONAL local reduction kernels (no parallel communication) */ +SUNDIALS_EXPORT realtype N_VWSqrSumLocal_Raja(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWSqrSumMaskLocal_Raja(N_Vector x, N_Vector w, N_Vector id); + +/* + * ----------------------------------------------------------------- + * Enable / disable fused vector operations + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int N_VEnableFusedOps_Raja(N_Vector v, booleantype tf); + +SUNDIALS_EXPORT int N_VEnableLinearCombination_Raja(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleAddMulti_Raja(N_Vector v, booleantype tf); + +SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_Raja(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleVectorArray_Raja(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableConstVectorArray_Raja(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleAddMultiVectorArray_Raja(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableLinearCombinationVectorArray_Raja(N_Vector v, booleantype tf); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/nvector/nvector_serial.h b/bazaar/plugin/sundials/include/nvector/nvector_serial.h new file mode 100644 index 000000000..bd78be57d --- /dev/null +++ b/bazaar/plugin/sundials/include/nvector/nvector_serial.h @@ -0,0 +1,192 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the serial implementation of the + * NVECTOR module. + * + * Notes: + * + * - The definition of the generic N_Vector structure can be found + * in the header file sundials_nvector.h. + * + * - The definition of the type 'realtype' can be found in the + * 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 + * 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 + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ----------------------------------------------------------------- + * SERIAL implementation of N_Vector + * ----------------------------------------------------------------- + */ + +struct _N_VectorContent_Serial { + sunindextype length; /* vector length */ + booleantype own_data; /* data ownership flag */ + realtype *data; /* data array */ +}; + +typedef struct _N_VectorContent_Serial *N_VectorContent_Serial; + +/* + * ----------------------------------------------------------------- + * Macros NV_CONTENT_S, NV_DATA_S, NV_OWN_DATA_S, + * NV_LENGTH_S, and NV_Ith_S + * ----------------------------------------------------------------- + */ + +#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] ) + +/* + * ----------------------------------------------------------------- + * Functions exported by nvector_serial + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VNew_Serial(sunindextype vec_length); + +SUNDIALS_EXPORT N_Vector N_VNewEmpty_Serial(sunindextype vec_length); + +SUNDIALS_EXPORT N_Vector N_VMake_Serial(sunindextype vec_length, realtype *v_data); + +SUNDIALS_EXPORT N_Vector* N_VCloneVectorArray_Serial(int count, N_Vector w); + +SUNDIALS_EXPORT N_Vector* N_VCloneVectorArrayEmpty_Serial(int count, N_Vector w); + +SUNDIALS_EXPORT void N_VDestroyVectorArray_Serial(N_Vector* vs, int count); + +SUNDIALS_EXPORT sunindextype N_VGetLength_Serial(N_Vector v); + +SUNDIALS_EXPORT void N_VPrint_Serial(N_Vector v); + +SUNDIALS_EXPORT void N_VPrintFile_Serial(N_Vector v, FILE *outfile); + +SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_Serial(N_Vector v); +SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Serial(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VClone_Serial(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy_Serial(N_Vector v); +SUNDIALS_EXPORT void N_VSpace_Serial(N_Vector v, sunindextype *lrw, sunindextype *liw); +SUNDIALS_EXPORT realtype *N_VGetArrayPointer_Serial(N_Vector v); +SUNDIALS_EXPORT void N_VSetArrayPointer_Serial(realtype *v_data, N_Vector v); + +/* standard vector operations */ +SUNDIALS_EXPORT void N_VLinearSum_Serial(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VConst_Serial(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd_Serial(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv_Serial(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale_Serial(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs_Serial(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv_Serial(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst_Serial(N_Vector x, realtype b, N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd_Serial(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm_Serial(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm_Serial(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask_Serial(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT realtype N_VMin_Serial(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm_Serial(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm_Serial(N_Vector x); +SUNDIALS_EXPORT void N_VCompare_Serial(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest_Serial(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask_Serial(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient_Serial(N_Vector num, N_Vector denom); + +/* fused vector operations */ +SUNDIALS_EXPORT int N_VLinearCombination_Serial(int nvec, realtype* c, N_Vector* V, + N_Vector z); +SUNDIALS_EXPORT int N_VScaleAddMulti_Serial(int nvec, realtype* a, N_Vector x, + N_Vector* Y, N_Vector* Z); +SUNDIALS_EXPORT int N_VDotProdMulti_Serial(int nvec, N_Vector x, + N_Vector* Y, realtype* dotprods); + +/* vector array operations */ +SUNDIALS_EXPORT int N_VLinearSumVectorArray_Serial(int nvec, + realtype a, N_Vector* X, + realtype b, N_Vector* Y, + N_Vector* Z); +SUNDIALS_EXPORT int N_VScaleVectorArray_Serial(int nvec, realtype* c, + N_Vector* X, N_Vector* Z); +SUNDIALS_EXPORT int N_VConstVectorArray_Serial(int nvecs, realtype c, + N_Vector* Z); +SUNDIALS_EXPORT int N_VWrmsNormVectorArray_Serial(int nvecs, N_Vector* X, + N_Vector* W, realtype* nrm); +SUNDIALS_EXPORT int N_VWrmsNormMaskVectorArray_Serial(int nvecs, N_Vector* X, + N_Vector* W, N_Vector id, + realtype* nrm); +SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray_Serial(int nvec, int nsum, + realtype* a, + N_Vector* X, + N_Vector** Y, + N_Vector** Z); +SUNDIALS_EXPORT int N_VLinearCombinationVectorArray_Serial(int nvec, int nsum, + realtype* c, + N_Vector** X, + N_Vector* Z); + +/* OPTIONAL local reduction kernels (no parallel communication) */ +SUNDIALS_EXPORT realtype N_VWSqrSumLocal_Serial(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWSqrSumMaskLocal_Serial(N_Vector x, N_Vector w, N_Vector id); + +/* + * ----------------------------------------------------------------- + * Enable / disable fused vector operations + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int N_VEnableFusedOps_Serial(N_Vector v, booleantype tf); + +SUNDIALS_EXPORT int N_VEnableLinearCombination_Serial(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleAddMulti_Serial(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableDotProdMulti_Serial(N_Vector v, booleantype tf); + +SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_Serial(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleVectorArray_Serial(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableConstVectorArray_Serial(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableWrmsNormVectorArray_Serial(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableWrmsNormMaskVectorArray_Serial(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableScaleAddMultiVectorArray_Serial(N_Vector v, booleantype tf); +SUNDIALS_EXPORT int N_VEnableLinearCombinationVectorArray_Serial(N_Vector v, booleantype tf); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/nvector/nvector_trilinos.h b/bazaar/plugin/sundials/include/nvector/nvector_trilinos.h new file mode 100644 index 000000000..4cce9ee1f --- /dev/null +++ b/bazaar/plugin/sundials/include/nvector/nvector_trilinos.h @@ -0,0 +1,141 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Slaven Peles @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the main header file for the Trilinos vector wrapper + * for NVECTOR module. + * + * Part I contains declarations specific to the Trilinos vector wrapper + * implementation. + * + * Part II contains the prototype for the constructor + * N_VMake_Trilinos as well as Trilinos-specific prototypes + * for various useful vector operations. + * + * Notes: + * + * - The definition of the generic N_Vector structure can be + * found in the header file sundials_nvector.h. + * + * - The definition of the type realtype can be found in the + * header file sundials_types.h, and it may be changed (at the + * build 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 + * be distinct. For example, the following call: + * + * N_VLinearSum_Trilinos(a,x,b,y,y); + * + * (which stores the result of the operation a*x+b*y in y) + * is legal. + * -----------------------------------------------------------------*/ + +#ifndef _NVECTOR_TRILINOS_H +#define _NVECTOR_TRILINOS_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/* + * ----------------------------------------------------------------- + * PART I: N_Vector interface to Trilinos vector + * ----------------------------------------------------------------- + */ + +/* + * Dummy _N_VectorContent_Trilinos structure is used for + * interfacing C with C++ code + */ + +struct _N_VectorContent_Trilinos {}; + +typedef struct _N_VectorContent_Trilinos *N_VectorContent_Trilinos; + +/* + * ----------------------------------------------------------------- + * PART II: functions exported by nvector_Trilinos + * + * CONSTRUCTORS: + * N_VNewEmpty_Trilinos + * ----------------------------------------------------------------- + */ + + +/* + * ----------------------------------------------------------------- + * Function : N_VNewEmpty_Trilinos + * ----------------------------------------------------------------- + * This function creates a new N_Vector wrapper for a Trilinos + * vector. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VNewEmpty_Trilinos(); + +/* + * ----------------------------------------------------------------- + * Trilinos implementations of the vector operations + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_Trilinos(N_Vector v); +SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Trilinos(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VClone_Trilinos(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy_Trilinos(N_Vector v); +SUNDIALS_EXPORT void N_VSpace_Trilinos(N_Vector v, sunindextype *lrw, sunindextype *liw); +SUNDIALS_EXPORT void *N_VGetCommunicator_Trilinos(N_Vector v); +SUNDIALS_EXPORT sunindextype N_VGetLength_Trilinos(N_Vector v); +SUNDIALS_EXPORT void N_VLinearSum_Trilinos(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VConst_Trilinos(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd_Trilinos(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv_Trilinos(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale_Trilinos(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs_Trilinos(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv_Trilinos(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst_Trilinos(N_Vector x, realtype b, N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd_Trilinos(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm_Trilinos(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm_Trilinos(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask_Trilinos(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT realtype N_VMin_Trilinos(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm_Trilinos(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm_Trilinos(N_Vector x); +SUNDIALS_EXPORT void N_VCompare_Trilinos(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest_Trilinos(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask_Trilinos(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient_Trilinos(N_Vector num, N_Vector denom); + +/* OPTIONAL local reduction kernels (no parallel communication) */ +SUNDIALS_EXPORT realtype N_VDotProdLocal_Trilinos(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNormLocal_Trilinos(N_Vector x); +SUNDIALS_EXPORT realtype N_VMinLocal_Trilinos(N_Vector x); +SUNDIALS_EXPORT realtype N_VL1NormLocal_Trilinos(N_Vector x); +SUNDIALS_EXPORT realtype N_VWSqrSumLocal_Trilinos(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWSqrSumMaskLocal_Trilinos(N_Vector x, N_Vector w, + N_Vector id); +SUNDIALS_EXPORT booleantype N_VInvTestLocal_Trilinos(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMaskLocal_Trilinos(N_Vector c, N_Vector x, + N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotientLocal_Trilinos(N_Vector num, + N_Vector denom); + +#ifdef __cplusplus +} +#endif + +#endif /* _NVECTOR_TRILINOS_H */ diff --git a/bazaar/plugin/sundials/include/nvector/raja/Vector.hpp b/bazaar/plugin/sundials/include/nvector/raja/Vector.hpp new file mode 100644 index 000000000..4ae004a60 --- /dev/null +++ b/bazaar/plugin/sundials/include/nvector/raja/Vector.hpp @@ -0,0 +1,128 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Slaven Peles @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + */ + + +/* + * Vector class + * + * Manages vector data layout for RAJA implementation of N_Vector. + * + */ + +#ifndef _NVECTOR_RAJA_HPP_ +#define _NVECTOR_RAJA_HPP_ + +#include +#include + +#include +#include + +namespace sunrajavec +{ + +template +class Vector : public _N_VectorContent_Raja +{ +public: + Vector(I N) + : size_(N), + mem_size_(N*sizeof(T)) + { + allocate(); + } + + // Copy constructor does not copy values + explicit Vector(const Vector& v) + : size_(v.size()), + mem_size_(size_*sizeof(T)) + { + allocate(); + } + + ~Vector() + { + cudaError_t err; + free(h_vec_); + err = cudaFree(d_vec_); + if(err != cudaSuccess) + std::cout << "Failed to free device vector (error code " << err << ")!\n"; + } + + + void allocate() + { + cudaError_t err; + h_vec_ = static_cast(malloc(mem_size_)); + if(h_vec_ == NULL) + std::cout << "Failed to allocate host vector!\n"; + err = cudaMalloc((void**) &d_vec_, mem_size_); + if(err != cudaSuccess) + std::cout << "Failed to allocate device vector (error code " << err << ")!\n"; + } + + int size() const + { + return size_; + } + + T* host() + { + return h_vec_; + } + + const T* host() const + { + return h_vec_; + } + + T* device() + { + return d_vec_; + } + + const T* device() const + { + return d_vec_; + } + + void copyToDev() + { + cudaError_t err = cudaMemcpy(d_vec_, h_vec_, mem_size_, cudaMemcpyHostToDevice); + if(err != cudaSuccess) + std::cerr << "Failed to copy vector from host to device (error code " << err << ")!\n"; + } + + void copyFromDev() + { + cudaError_t err = cudaMemcpy(h_vec_, d_vec_, mem_size_, cudaMemcpyDeviceToHost); + if(err != cudaSuccess) + std::cerr << "Failed to copy vector from device to host (error code " << err << ")!\n"; + } + +private: + I size_; + I mem_size_; + T* h_vec_; + T* d_vec_; +}; + + +} // namespace sunrajavec + + + +#endif // _NVECTOR_RAJA_HPP_ diff --git a/bazaar/plugin/sundials/include/sundials/sundials_band.h b/bazaar/plugin/sundials/include/sundials/sundials_band.h new file mode 100644 index 000000000..1f22f0112 --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_band.h @@ -0,0 +1,181 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for a generic BAND linear solver + * package, based on the DlsMat type defined in sundials_direct.h. + * + * There are two sets of band solver routines listed in + * this file: one set uses type DlsMat defined below and the + * other set uses the type realtype ** for band matrix arguments. + * Routines that work with the type DlsMat begin with "Band". + * Routines that work with realtype ** begin with "band". + * -----------------------------------------------------------------*/ + +#ifndef _SUNDIALS_BAND_H +#define _SUNDIALS_BAND_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ----------------------------------------------------------------- + * Function : BandGBTRF + * ----------------------------------------------------------------- + * Usage : ier = BandGBTRF(A, p); + * if (ier != 0) ... A is singular + * ----------------------------------------------------------------- + * BandGBTRF 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. + * + * BandGBTRF 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 BandGBTRF routine. + * + * BandGBTRF is only a wrapper around bandGBTRF. All work is done + * in bandGBTRF, which works directly on the data in the DlsMat A + * (i.e. in the field A->cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT sunindextype BandGBTRF(DlsMat A, sunindextype *p); +SUNDIALS_EXPORT sunindextype bandGBTRF(realtype **a, sunindextype n, + sunindextype mu, sunindextype ml, + sunindextype smu, sunindextype *p); + +/* + * ----------------------------------------------------------------- + * Function : BandGBTRS + * ----------------------------------------------------------------- + * Usage : BandGBTRS(A, p, b); + * ----------------------------------------------------------------- + * BandGBTRS solves the N-dimensional system A x = b using + * the LU factorization in A and the pivot information in p + * computed in BandGBTRF. The solution x is returned in b. This + * routine cannot fail if the corresponding call to BandGBTRF + * did not fail. + * + * BandGBTRS is only a wrapper around bandGBTRS which does all the + * work directly on the data in the DlsMat A (i.e. in A->cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void BandGBTRS(DlsMat A, sunindextype *p, realtype *b); +SUNDIALS_EXPORT void bandGBTRS(realtype **a, sunindextype n, sunindextype smu, + sunindextype ml, sunindextype *p, realtype *b); + +/* + * ----------------------------------------------------------------- + * 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. + * + * BandCopy is a wrapper around bandCopy which accesses the data + * in the DlsMat A and DlsMat B (i.e. the fields cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void BandCopy(DlsMat A, DlsMat B, sunindextype copymu, + sunindextype copyml); +SUNDIALS_EXPORT void bandCopy(realtype **a, realtype **b, sunindextype n, + sunindextype a_smu, sunindextype b_smu, + sunindextype copymu, sunindextype copyml); + +/* + * ----------------------------------------------------------------- + * Function: BandScale + * ----------------------------------------------------------------- + * Usage : BandScale(c, A); + * ----------------------------------------------------------------- + * A(i,j) <- c*A(i,j), j-(A->mu) <= i <= j+(A->ml). + * + * BandScale is a wrapper around bandScale which performs the actual + * scaling by accessing the data in the DlsMat A (i.e. the field + * A->cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void BandScale(realtype c, DlsMat A); +SUNDIALS_EXPORT void bandScale(realtype c, realtype **a, sunindextype n, + sunindextype mu, sunindextype ml, + sunindextype smu); + +/* + * ----------------------------------------------------------------- + * Function: bandAddIdentity + * ----------------------------------------------------------------- + * bandAddIdentity adds the identity matrix to the n-by-n matrix + * stored in the realtype** arrays. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void bandAddIdentity(realtype **a, sunindextype n, + sunindextype smu); + + +/* + * ----------------------------------------------------------------- + * Function: BandMatvec + * ----------------------------------------------------------------- + * BandMatvec computes the matrix-vector product y = A*x, where A + * is an M-by-N band matrix, x is a vector of length N, and y is a + * vector of length M. No error checking is performed on the length + * of the arrays x and y. Only y is modified in this routine. + * + * BandMatvec is a wrapper around bandMatvec which performs the + * actual product by accessing the data in the DlsMat A. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void BandMatvec(DlsMat A, realtype *x, realtype *y); +SUNDIALS_EXPORT void bandMatvec(realtype **a, realtype *x, realtype *y, + sunindextype n, sunindextype mu, + sunindextype ml, sunindextype smu); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sundials/sundials_config.h b/bazaar/plugin/sundials/include/sundials/sundials_config.h new file mode 100644 index 000000000..06c642288 --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_config.h @@ -0,0 +1,135 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * LLNS/SMU Copyright Start + * Copyright (c) 2002-2018, Southern Methodist University and + * Lawrence Livermore National Security + * + * This work was performed under the auspices of the U.S. Department + * of Energy by Southern Methodist University and Lawrence Livermore + * National Laboratory under Contract DE-AC52-07NA27344. + * Produced at Southern Methodist University and the Lawrence + * Livermore National Laboratory. + * + * All rights reserved. + * For details, see the LICENSE file. + * LLNS/SMU Copyright End + * ----------------------------------------------------------------- + * SUNDIALS configuration header file + * -----------------------------------------------------------------*/ + +/* Define SUNDIALS version numbers */ +#define SUNDIALS_VERSION "5.2.0" +#define SUNDIALS_VERSION_MAJOR 5 +#define SUNDIALS_VERSION_MINOR 2 +#define SUNDIALS_VERSION_PATCH 0 +#define SUNDIALS_VERSION_LABEL "" + +/* FCMIX: Define Fortran name-mangling macro for C identifiers. + * Depending on the inferred scheme, one of the following six + * macros will be defined: + * #define SUNDIALS_F77_FUNC(name,NAME) name + * #define SUNDIALS_F77_FUNC(name,NAME) name ## _ + * #define SUNDIALS_F77_FUNC(name,NAME) name ## __ + * #define SUNDIALS_F77_FUNC(name,NAME) NAME + * #define SUNDIALS_F77_FUNC(name,NAME) NAME ## _ + * #define SUNDIALS_F77_FUNC(name,NAME) NAME ## __ + */ + + +/* FCMIX: Define Fortran name-mangling macro for C identifiers + * which contain underscores. + */ + + +/* Define precision of SUNDIALS data type 'realtype' + * Depending on the precision level, one of the following + * three macros will be defined: + * #define SUNDIALS_SINGLE_PRECISION 1 + * #define SUNDIALS_DOUBLE_PRECISION 1 + * #define SUNDIALS_EXTENDED_PRECISION 1 + */ +#define SUNDIALS_DOUBLE_PRECISION 1 + +/* Define type of vector indices in SUNDIALS 'sunindextype'. + * Depending on user choice of index type, one of the following + * two macros will be defined: + * #define SUNDIALS_INT64_T 1 + * #define SUNDIALS_INT32_T 1 + */ +#define SUNDIALS_INT64_T 1 + +/* Define the type of vector indices in SUNDIALS 'sunindextype'. + * The macro will be defined with a type of the appropriate size. + */ +#define SUNDIALS_INDEX_TYPE int64_t + +/* Use generic math functions + * If it was decided that generic math functions can be used, then + * #define SUNDIALS_USE_GENERIC_MATH + */ +/* #undef SUNDIALS_USE_GENERIC_MATH */ + +/* Use POSIX timers if available. + * #define SUNDIALS_HAVE_POSIX_TIMERS + */ +/* #undef SUNDIALS_HAVE_POSIX_TIMERS */ + +/* Blas/Lapack available + * If working libraries for Blas/lapack support were found, then + * #define SUNDIALS_BLAS_LAPACK + */ +/* #undef SUNDIALS_BLAS_LAPACK */ + +/* SUPERLUMT available + * If working libraries for SUPERLUMT support were found, then + * #define SUNDIALS_SUPERLUMT + */ +/* #undef SUNDIALS_SUPERLUMT */ +/* #undef SUNDIALS_SUPERLUMT_THREAD_TYPE */ + +/* SUPERLUDIST available + * If working libraries for SUPERLUDIST support were found, then + * #define SUNDIALS_SUPERLUDIST + */ +/* #undef SUNDIALS_SUPERLUDIST */ + +/* KLU available + * If working libraries for KLU support were found, then + * #define SUNDIALS_KLU + */ +/* #undef SUNDIALS_KLU */ + +/* Trilinos available + * If working libraries for Trilinos support were found, then + * #define SUNDIALS_TRILINOS + */ +/* #undef SUNDIALS_TRILINOS */ + + /* Trilinos with MPI is available, then + * #define SUNDIALS_TRILINOS_HAVE_MPI + */ +/* #undef SUNDIALS_TRILINOS_HAVE_MPI */ + +/* Set if SUNDIALS is built with MPI support. + * + */ + + +/* FNVECTOR: Allow user to specify different MPI communicator + * If it was found that the MPI implementation supports MPI_Comm_f2c, then + * #define SUNDIALS_MPI_COMM_F2C 1 + * otherwise + * #define SUNDIALS_MPI_COMM_F2C 0 + */ +#define SUNDIALS_MPI_COMM_F2C 0 + +/* Mark SUNDIALS API functions for export/import + * When building shared SUNDIALS libraries under Windows, use + * #define SUNDIALS_EXPORT __declspec(dllexport) + * When linking to shared SUNDIALS libraries under Windows, use + * #define SUNDIALS_EXPORT __declspec(dllimport) + * In all other cases (other platforms or static libraries under + * Windows), the SUNDIALS_EXPORT macro is empty + */ +#define SUNDIALS_EXPORT diff --git a/bazaar/plugin/sundials/include/sundials/sundials_dense.h b/bazaar/plugin/sundials/include/sundials/sundials_dense.h new file mode 100644 index 000000000..e1a95a073 --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_dense.h @@ -0,0 +1,212 @@ +/* ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for a generic package of DENSE matrix + * operations, based on the DlsMat type defined in sundials_direct.h. + * + * There are two sets of dense solver routines listed in + * this file: one set uses type DlsMat defined below and the + * other set uses the type realtype ** for dense matrix arguments. + * Routines that work with the type DlsMat begin with "Dense". + * Routines that work with realtype** begin with "dense". + * -----------------------------------------------------------------*/ + +#ifndef _SUNDIALS_DENSE_H +#define _SUNDIALS_DENSE_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ----------------------------------------------------------------- + * Functions: DenseGETRF and DenseGETRS + * ----------------------------------------------------------------- + * DenseGETRF performs the LU factorization of the M by N dense + * matrix A. This is done using standard Gaussian elimination + * with partial (row) pivoting. Note that this applies only + * to matrices with M >= N and full column rank. + * + * 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 trapezoidal + * 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 + * trapezoidal part of A contains the multipliers, I-L. + * + * For square matrices (M = N), L is unit lower triangular. + * + * DenseGETRF 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. + * + * DenseGETRS solves the N-dimensional system A x = b using + * the LU factorization in A and the pivot information in p + * computed in DenseGETRF. The solution x is returned in b. This + * routine cannot fail if the corresponding call to DenseGETRF + * did not fail. + * DenseGETRS does NOT check for a square matrix! + * + * ----------------------------------------------------------------- + * DenseGETRF and DenseGETRS are simply wrappers around denseGETRF + * and denseGETRS, respectively, which perform all the work by + * directly accessing the data in the DlsMat A (i.e. in A->cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT sunindextype DenseGETRF(DlsMat A, sunindextype *p); +SUNDIALS_EXPORT void DenseGETRS(DlsMat A, sunindextype *p, realtype *b); + +SUNDIALS_EXPORT sunindextype denseGETRF(realtype **a, sunindextype m, + sunindextype n, sunindextype *p); +SUNDIALS_EXPORT void denseGETRS(realtype **a, sunindextype n, sunindextype *p, + realtype *b); + +/* + * ----------------------------------------------------------------- + * Functions : DensePOTRF and DensePOTRS + * ----------------------------------------------------------------- + * DensePOTRF computes the Cholesky factorization of a real symmetric + * positive definite matrix A. + * ----------------------------------------------------------------- + * DensePOTRS solves a system of linear equations A*X = B with a + * symmetric positive definite matrix A using the Cholesky factorization + * A = L*L**T computed by DensePOTRF. + * + * ----------------------------------------------------------------- + * DensePOTRF and DensePOTRS are simply wrappers around densePOTRF + * and densePOTRS, respectively, which perform all the work by + * directly accessing the data in the DlsMat A (i.e. the field cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT sunindextype DensePOTRF(DlsMat A); +SUNDIALS_EXPORT void DensePOTRS(DlsMat A, realtype *b); + +SUNDIALS_EXPORT sunindextype densePOTRF(realtype **a, sunindextype m); +SUNDIALS_EXPORT void densePOTRS(realtype **a, sunindextype m, realtype *b); + +/* + * ----------------------------------------------------------------- + * Functions : DenseGEQRF and DenseORMQR + * ----------------------------------------------------------------- + * DenseGEQRF computes a QR factorization of a real M-by-N matrix A: + * A = Q * R (with M>= N). + * + * DenseGEQRF requires a temporary work vector wrk of length M. + * ----------------------------------------------------------------- + * DenseORMQR computes the product w = Q * v where Q is a real + * orthogonal matrix defined as the product of k elementary reflectors + * + * Q = H(1) H(2) . . . H(k) + * + * as returned by DenseGEQRF. Q is an M-by-N matrix, v is a vector + * of length N and w is a vector of length M (with M >= N). + * + * DenseORMQR requires a temporary work vector wrk of length M. + * + * ----------------------------------------------------------------- + * DenseGEQRF and DenseORMQR are simply wrappers around denseGEQRF + * and denseORMQR, respectively, which perform all the work by + * directly accessing the data in the DlsMat A (i.e. the field cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int DenseGEQRF(DlsMat A, realtype *beta, realtype *wrk); +SUNDIALS_EXPORT int DenseORMQR(DlsMat A, realtype *beta, realtype *vn, + realtype *vm, realtype *wrk); + +SUNDIALS_EXPORT int denseGEQRF(realtype **a, sunindextype m, sunindextype n, + realtype *beta, realtype *wrk); +SUNDIALS_EXPORT int denseORMQR(realtype **a, sunindextype m, sunindextype n, + realtype *beta, realtype *v, realtype *w, + realtype *wrk); + +/* + * ----------------------------------------------------------------- + * Function : DenseCopy + * ----------------------------------------------------------------- + * DenseCopy copies the contents of the M-by-N matrix A into the + * M-by-N matrix B. + * + * DenseCopy is a wrapper around denseCopy which accesses the data + * in the DlsMat A and DlsMat B (i.e. the fields cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DenseCopy(DlsMat A, DlsMat B); +SUNDIALS_EXPORT void denseCopy(realtype **a, realtype **b, sunindextype m, + sunindextype n); + +/* + * ----------------------------------------------------------------- + * Function: DenseScale + * ----------------------------------------------------------------- + * DenseScale scales the elements of the M-by-N matrix A by the + * constant c and stores the result back in A. + * + * DenseScale is a wrapper around denseScale which performs the actual + * scaling by accessing the data in the DlsMat A (i.e. in A->cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DenseScale(realtype c, DlsMat A); +SUNDIALS_EXPORT void denseScale(realtype c, realtype **a, sunindextype m, + sunindextype n); + + +/* + * ----------------------------------------------------------------- + * Function: denseAddIdentity + * ----------------------------------------------------------------- + * denseAddIdentity adds the identity matrix to the n-by-n matrix + * stored in a realtype** array. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void denseAddIdentity(realtype **a, sunindextype n); + + +/* + * ----------------------------------------------------------------- + * Function: DenseMatvec + * ----------------------------------------------------------------- + * DenseMatvec computes the matrix-vector product y = A*x, where A + * is an M-by-N matrix, x is a vector of length N, and y is a vector + * of length M. No error checking is performed on the length of the + * arrays x and y. Only y is modified in this routine. + * + * DenseMatvec is a wrapper around denseMatvec which performs the + * actual product by accessing the data in the DlsMat A. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DenseMatvec(DlsMat A, realtype *x, realtype *y); +SUNDIALS_EXPORT void denseMatvec(realtype **a, realtype *x, realtype *y, + sunindextype m, sunindextype n); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sundials/sundials_direct.h b/bazaar/plugin/sundials/include/sundials/sundials_direct.h new file mode 100644 index 000000000..daa34de3f --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_direct.h @@ -0,0 +1,339 @@ +/* ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This header file contains definitions and declarations for use by + * generic direct linear solvers for Ax = b. It defines types for + * dense and banded matrices and corresponding accessor macros. + * -----------------------------------------------------------------*/ + +#ifndef _SUNDIALS_DIRECT_H +#define _SUNDIALS_DIRECT_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ================================================================= + * C O N S T A N T S + * ================================================================= + */ + +/* + * SUNDIALS_DENSE: dense matrix + * SUNDIALS_BAND: banded matrix + */ + +#define SUNDIALS_DENSE 1 +#define SUNDIALS_BAND 2 + +/* + * ================================================================== + * Type definitions + * ================================================================== + */ + +/* + * ----------------------------------------------------------------- + * Type : DlsMat + * ----------------------------------------------------------------- + * The type DlsMat is defined to be a pointer to a structure + * with various sizes, a data field, and an array of pointers to + * the columns which defines a dense or band matrix for use in + * direct linear solvers. The M and N fields indicates the number + * of rows and columns, respectively. The data field is a one + * dimensional array used for component storage. The cols field + * stores the pointers in data for the beginning of each column. + * ----------------------------------------------------------------- + * For DENSE matrices, the relevant fields in DlsMat are: + * type = SUNDIALS_DENSE + * M - number of rows + * N - number of columns + * ldim - leading dimension (ldim >= M) + * data - pointer to a contiguous block of realtype variables + * ldata - length of the data array =ldim*N + * cols - array of pointers. cols[j] points to the first element + * of the j-th column of the matrix in the array data. + * + * 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 DlsMat, then the (i,j)th element of A (with + * 0 <= i < M and 0 <= j < N) is given by (A->data)[j*n+i]. + * + * The DENSE_COL and DENSE_ELEM 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. + * ----------------------------------------------------------------- + * For BAND matrices, the relevant fields in DlsMat are: + * type = SUNDIALS_BAND + * M - number of rows + * N - number of columns + * mu - upper bandwidth, 0 <= mu <= min(M,N) + * ml - lower bandwidth, 0 <= ml <= min(M,N) + * s_mu - storage upper bandwidth, mu <= s_mu <= N-1. + * The dgbtrf 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(N-1,mu+ml) because of + * partial pivoting. The s_mu field holds the upper + * bandwidth allocated for A. + * ldim - leading dimension (ldim >= s_mu) + * data - pointer to a contiguous block of realtype variables + * ldata - length of the data array =ldim*(s_mu+ml+1) + * cols - array of pointers. cols[j] points to the first element + * of the j-th column of the matrix in the array data. + * + * The BAND_COL, BAND_COL_ELEM, and BAND_ELEM 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. The macro + * 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. + * ----------------------------------------------------------------- + */ + +typedef struct _DlsMat { + int type; + sunindextype M; + sunindextype N; + sunindextype ldim; + sunindextype mu; + sunindextype ml; + sunindextype s_mu; + realtype *data; + sunindextype ldata; + realtype **cols; +} *DlsMat; + +/* + * ================================================================== + * Data accessor macros + * ================================================================== + */ + +/* + * ----------------------------------------------------------------- + * DENSE_COL and DENSE_ELEM + * ----------------------------------------------------------------- + * + * DENSE_COL(A,j) references the jth column of the M-by-N dense + * matrix A, 0 <= j < N. The type of the expression DENSE_COL(A,j) + * is (realtype *). After the assignment col_j = DENSE_COL(A,j), + * col_j may be treated as an array indexed from 0 to M-1. + * The (i,j)-th element of A is thus referenced by col_j[i]. + * + * DENSE_ELEM(A,i,j) references the (i,j)th element of the dense + * M-by-N matrix A, 0 <= i < M ; 0 <= j < N. + * + * ----------------------------------------------------------------- + */ + +#define DENSE_COL(A,j) ((A->cols)[j]) +#define DENSE_ELEM(A,i,j) ((A->cols)[j][i]) + +/* + * ----------------------------------------------------------------- + * BAND_COL, BAND_COL_ELEM, and BAND_ELEM + * ----------------------------------------------------------------- + * + * 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). + * + * BAND_COL_ELEM references the (i,j)th entry of the band matrix A + * when used in conjunction with BAND_COL. The index (i,j) should + * satisfy j-(A->mu) <= i <= j+(A->ml). + * + * BAND_ELEM(A,i,j) references the (i,j)th element of the M-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_COL(A,j) (((A->cols)[j])+(A->s_mu)) +#define BAND_COL_ELEM(col_j,i,j) (col_j[(i)-(j)]) +#define BAND_ELEM(A,i,j) ((A->cols)[j][(i)-(j)+(A->s_mu)]) + +/* + * ================================================================== + * Exported function prototypes (functions working on dlsMat) + * ================================================================== + */ + +/* + * ----------------------------------------------------------------- + * Function: NewDenseMat + * ----------------------------------------------------------------- + * NewDenseMat allocates memory for an M-by-N dense matrix and + * returns the storage allocated (type DlsMat). NewDenseMat + * returns NULL if the request for matrix storage cannot be + * satisfied. See the above documentation for the type DlsMat + * for matrix storage details. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT DlsMat NewDenseMat(sunindextype M, sunindextype N); + +/* + * ----------------------------------------------------------------- + * Function: NewBandMat + * ----------------------------------------------------------------- + * NewBandMat allocates memory for an M-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 LU factored: + * + * (1) Pass smu = mu if A will not be factored. + * + * (2) Pass smu = MIN(N-1,mu+ml) if A will be factored. + * + * NewBandMat returns the storage allocated (type DlsMat) or + * NULL if the request for matrix storage cannot be satisfied. + * See the documentation for the type DlsMat for matrix storage + * details. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT DlsMat NewBandMat(sunindextype N, sunindextype mu, + sunindextype ml, sunindextype smu); + +/* + * ----------------------------------------------------------------- + * Functions: DestroyMat + * ----------------------------------------------------------------- + * DestroyMat frees the memory allocated by NewDenseMat or NewBandMat + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DestroyMat(DlsMat A); + +/* + * ----------------------------------------------------------------- + * Function: NewIntArray + * ----------------------------------------------------------------- + * NewIntArray allocates memory an array of N int's and returns + * the pointer to the memory it allocates. If the request for + * memory storage cannot be satisfied, it returns NULL. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int *NewIntArray(int N); + +/* + * ----------------------------------------------------------------- + * Function: NewIndexArray + * ----------------------------------------------------------------- + * NewIndexArray allocates memory an array of N sunindextype's and + * returns the pointer to the memory it allocates. If the request + * for memory storage cannot be satisfied, it returns NULL. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT sunindextype *NewIndexArray(sunindextype N); + +/* + * ----------------------------------------------------------------- + * Function: NewRealArray + * ----------------------------------------------------------------- + * NewRealArray allocates memory an array of N realtype and returns + * the pointer to the memory it allocates. If the request for + * memory storage cannot be satisfied, it returns NULL. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype *NewRealArray(sunindextype N); + +/* + * ----------------------------------------------------------------- + * Function: DestroyArray + * ----------------------------------------------------------------- + * DestroyArray frees memory allocated by NewIntArray, NewIndexArray, + * or NewRealArray. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DestroyArray(void *p); + +/* + * ----------------------------------------------------------------- + * Function : AddIdentity + * ----------------------------------------------------------------- + * AddIdentity adds 1.0 to the main diagonal (A_ii, i=0,1,...,N-1) of + * the M-by-N matrix A (M>= N) and stores the result back in A. + * AddIdentity is typically used with square matrices. + * AddIdentity does not check for M >= N and therefore a segmentation + * fault will occur if M < N! + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void AddIdentity(DlsMat A); + +/* + * ----------------------------------------------------------------- + * Function : SetToZero + * ----------------------------------------------------------------- + * SetToZero sets all the elements of the M-by-N matrix A to 0.0. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void SetToZero(DlsMat A); + +/* + * ----------------------------------------------------------------- + * Functions: PrintMat + * ----------------------------------------------------------------- + * This function prints the M-by-N (dense or band) matrix A to + * outfile as it would normally appear on paper. + * It is intended as debugging tools with small values of M and N. + * The elements are printed using the %g/%lg/%Lg option. + * A blank line is printed before and after the matrix. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void PrintMat(DlsMat A, FILE *outfile); + + +/* + * ================================================================== + * Exported function prototypes (functions working on realtype**) + * ================================================================== + */ + +SUNDIALS_EXPORT realtype **newDenseMat(sunindextype m, sunindextype n); +SUNDIALS_EXPORT realtype **newBandMat(sunindextype n, sunindextype smu, + sunindextype ml); +SUNDIALS_EXPORT void destroyMat(realtype **a); +SUNDIALS_EXPORT int *newIntArray(int n); +SUNDIALS_EXPORT sunindextype *newIndexArray(sunindextype n); +SUNDIALS_EXPORT realtype *newRealArray(sunindextype m); +SUNDIALS_EXPORT void destroyArray(void *v); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sundials/sundials_fconfig.h b/bazaar/plugin/sundials/include/sundials/sundials_fconfig.h new file mode 100644 index 000000000..eb9768576 --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_fconfig.h @@ -0,0 +1,51 @@ +! +! ----------------------------------------------------------------- +! Programmer(s): Daniel R. Reynolds @ SMU +!----------------------------------------------------------------- +! LLNS/SMU Copyright Start +! Copyright (c) 2002-2018, Southern Methodist University and +! Lawrence Livermore National Security +! +! This work was performed under the auspices of the U.S. Department +! of Energy by Southern Methodist University and Lawrence Livermore +! National Laboratory under Contract DE-AC52-07NA27344. +! Produced at Southern Methodist University and the Lawrence +! Livermore National Laboratory. +! +! All rights reserved. +! For details, see the LICENSE file. +! LLNS/SMU Copyright End +! ------------------------------------------------------------------ +! SUNDIALS fortran configuration input +! ------------------------------------------------------------------ + +! Define precision of SUNDIALS data type 'realtype' as Fortran +! parameter "REALTYPE" +! +! Depending on the precision level, this value will be one of +! 4 (SUNDIALS_SINGLE_PRECISION) +! 8 (SUNDIALS_DOUBLE_PRECISION) +! 16 (SUNDIALS_EXTENDED_PRECISION) +! +integer REALTYPE +parameter (REALTYPE=8) + +! Define type of vector indices in SUNDIALS 'sunindextype' as +! the Fortran parameter "SUNINDEXTYPE" +! +! Depending on the user choice of indextype, this will be one of +! 4 (32BIT) +! 8 (64BIT) +! +integer SUNINDEXTYPE +parameter (SUNINDEXTYPE=8) + +! If building with MPI enabled, define the logical flag +! "SUNDIALS_MPI_COMM_F2C" indicating whether the user can specify +! a different MPI communicator than MPI_COMM_WORLD to FNVInitP +! +! .true. (communicator can differ from MPI_COMM_WORLD) +! .false. (communicator must be MPI_COMM_WORLD) +! +logical SUNDIALS_MPI_COMM_F2C +parameter (SUNDIALS_MPI_COMM_F2C=.false.) diff --git a/bazaar/plugin/sundials/include/sundials/sundials_fnvector.h b/bazaar/plugin/sundials/include/sundials/sundials_fnvector.h new file mode 100644 index 000000000..23b809766 --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_fnvector.h @@ -0,0 +1,42 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of nvector.h) contains definitions + * needed for the initialization of vector operations in Fortran. + * -----------------------------------------------------------------*/ + + +#ifndef _FNVECTOR_H +#define _FNVECTOR_H + +#ifndef _SUNDIALS_CONFIG_H +#define _SUNDIALS_CONFIG_H +#include +#endif + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* SUNDIALS solver IDs */ + +#define FCMIX_CVODE 1 +#define FCMIX_IDA 2 +#define FCMIX_KINSOL 3 +#define FCMIX_ARKODE 4 + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sundials/sundials_futils.h b/bazaar/plugin/sundials/include/sundials/sundials_futils.h new file mode 100644 index 000000000..fe9af33c1 --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_futils.h @@ -0,0 +1,38 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Cody J. Balos + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * SUNDIALS Fortran 2003 interface utility definitions. + * -----------------------------------------------------------------*/ + +#ifndef _SUNDIALS_FUTILS_H +#define _SUNDIALS_FUTILS_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* Create a file pointer with the given file name and mode. */ +SUNDIALS_EXPORT FILE* SUNDIALSFileOpen(const char* filename, const char* modes); + +/* Close a file pointer with the given file name. */ +SUNDIALS_EXPORT void SUNDIALSFileClose(FILE* fp); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sundials/sundials_iterative.h b/bazaar/plugin/sundials/include/sundials/sundials_iterative.h new file mode 100644 index 000000000..ae3d2e0b4 --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_iterative.h @@ -0,0 +1,263 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen and Alan C. Hindmarsh @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * 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), + * setting up a preconditioner P (PSetupFn), and + * solving the preconditioner equation Pz = r (PSolveFn). + * -----------------------------------------------------------------*/ + +#ifndef _ITERATIVE_H +#define _ITERATIVE_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/* + * ----------------------------------------------------------------- + * 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: PSetupFn + * ----------------------------------------------------------------- + * A PSetupFn is an integrator-supplied routine that accesses data + * stored in the integrator memory structure (P_data), and calls + * the user-supplied, integrator-specific preconditioner setup + * routine. + * ----------------------------------------------------------------- + */ + +typedef int (*PSetupFn)(void *P_data); + +/* + * ----------------------------------------------------------------- + * 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. + * If the preconditioner is iterative, then it should strive to + * solve the preconditioner equation so that + * || Pz - r ||_wrms < tol + * where the weight vector for the WRMS norm may be accessed from + * the main integrator memory structure. + * The vector r should not be modified by the PSolveFn. + * 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, + realtype tol, 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=SUNMAX(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. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT 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. + * + * stemp is a length k+1 array of realtype which can be used as + * workspace by the ClassicalGS routine. + * + * vtemp is an N_Vector array of k+1 vectors which can be used as + * workspace by the ClassicalGS routine. + * + * ClassicalGS returns 0 to indicate success. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int ClassicalGS(N_Vector* v, realtype **h, int k, int p, + realtype *new_vk_norm, realtype *stemp, + N_Vector* vtemp); + +/* + * ----------------------------------------------------------------- + * 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. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT 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. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int QRsol(int n, realtype **h, realtype *q, realtype *b); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sundials/sundials_lapack.h b/bazaar/plugin/sundials/include/sundials/sundials_lapack.h new file mode 100644 index 000000000..02e714b66 --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_lapack.h @@ -0,0 +1,256 @@ +/* ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for a generic package of direct matrix + * operations for use with BLAS/LAPACK. + * -----------------------------------------------------------------*/ + +#ifndef _SUNDIALS_LAPACK_H +#define _SUNDIALS_LAPACK_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ================================================================== + * Blas and Lapack functions + * ================================================================== + */ + +#if defined(SUNDIALS_F77_FUNC) + +#define dcopy_f77 SUNDIALS_F77_FUNC(dcopy, DCOPY) +#define dscal_f77 SUNDIALS_F77_FUNC(dscal, DSCAL) +#define dgemv_f77 SUNDIALS_F77_FUNC(dgemv, DGEMV) +#define dtrsv_f77 SUNDIALS_F77_FUNC(dtrsv, DTRSV) +#define dsyrk_f77 SUNDIALS_F77_FUNC(dsyrk, DSKYR) + +#define dgbtrf_f77 SUNDIALS_F77_FUNC(dgbtrf, DGBTRF) +#define dgbtrs_f77 SUNDIALS_F77_FUNC(dgbtrs, DGBTRS) +#define dgetrf_f77 SUNDIALS_F77_FUNC(dgetrf, DGETRF) +#define dgetrs_f77 SUNDIALS_F77_FUNC(dgetrs, DGETRS) +#define dgeqp3_f77 SUNDIALS_F77_FUNC(dgeqp3, DGEQP3) +#define dgeqrf_f77 SUNDIALS_F77_FUNC(dgeqrf, DGEQRF) +#define dormqr_f77 SUNDIALS_F77_FUNC(dormqr, DORMQR) +#define dpotrf_f77 SUNDIALS_F77_FUNC(dpotrf, DPOTRF) +#define dpotrs_f77 SUNDIALS_F77_FUNC(dpotrs, DPOTRS) + +#define scopy_f77 SUNDIALS_F77_FUNC(scopy, SCOPY) +#define sscal_f77 SUNDIALS_F77_FUNC(sscal, SSCAL) +#define sgemv_f77 SUNDIALS_F77_FUNC(sgemv, SGEMV) +#define strsv_f77 SUNDIALS_F77_FUNC(strsv, STRSV) +#define ssyrk_f77 SUNDIALS_F77_FUNC(ssyrk, SSKYR) + +#define sgbtrf_f77 SUNDIALS_F77_FUNC(sgbtrf, SGBTRF) +#define sgbtrs_f77 SUNDIALS_F77_FUNC(sgbtrs, SGBTRS) +#define sgetrf_f77 SUNDIALS_F77_FUNC(sgetrf, SGETRF) +#define sgetrs_f77 SUNDIALS_F77_FUNC(sgetrs, SGETRS) +#define sgeqp3_f77 SUNDIALS_F77_FUNC(sgeqp3, SGEQP3) +#define sgeqrf_f77 SUNDIALS_F77_FUNC(sgeqrf, SGEQRF) +#define sormqr_f77 SUNDIALS_F77_FUNC(sormqr, SORMQR) +#define spotrf_f77 SUNDIALS_F77_FUNC(spotrf, SPOTRF) +#define spotrs_f77 SUNDIALS_F77_FUNC(spotrs, SPOTRS) + +#else + +#define dcopy_f77 dcopy_ +#define dscal_f77 dscal_ +#define dgemv_f77 dgemv_ +#define dtrsv_f77 dtrsv_ +#define dsyrk_f77 dsyrk_ + +#define dgbtrf_f77 dgbtrf_ +#define dgbtrs_f77 dgbtrs_ +#define dgeqp3_f77 dgeqp3_ +#define dgeqrf_f77 dgeqrf_ +#define dgetrf_f77 dgetrf_ +#define dgetrs_f77 dgetrs_ +#define dormqr_f77 dormqr_ +#define dpotrf_f77 dpotrf_ +#define dpotrs_f77 dpotrs_ + +#define scopy_f77 scopy_ +#define sscal_f77 sscal_ +#define sgemv_f77 sgemv_ +#define strsv_f77 strsv_ +#define ssyrk_f77 ssyrk_ + +#define sgbtrf_f77 sgbtrf_ +#define sgbtrs_f77 sgbtrs_ +#define sgeqp3_f77 sgeqp3_ +#define sgeqrf_f77 sgeqrf_ +#define sgetrf_f77 sgetrf_ +#define sgetrs_f77 sgetrs_ +#define sormqr_f77 sormqr_ +#define spotrf_f77 spotrf_ +#define spotrs_f77 spotrs_ + +#endif + +/* Level-1 BLAS */ + +extern void dcopy_f77(sunindextype *n, const double *x, + const sunindextype *inc_x, double *y, + const sunindextype *inc_y); + +extern void dscal_f77(sunindextype *n, const double *alpha, double *x, + const sunindextype *inc_x); + +extern void scopy_f77(sunindextype *n, const float *x, + const sunindextype *inc_x, float *y, + const sunindextype *inc_y); + +extern void sscal_f77(sunindextype *n, const float *alpha, float *x, + const sunindextype *inc_x); + +/* Level-2 BLAS */ + +extern void dgemv_f77(const char *trans, sunindextype *m, sunindextype *n, + const double *alpha, const double *a, sunindextype *lda, + const double *x, sunindextype *inc_x, const double *beta, + double *y, sunindextype *inc_y); + +extern void dtrsv_f77(const char *uplo, const char *trans, const char *diag, + const sunindextype *n, const double *a, + const sunindextype *lda, double *x, + const sunindextype *inc_x); + +extern void sgemv_f77(const char *trans, sunindextype *m, sunindextype *n, + const float *alpha, const float *a, sunindextype *lda, + const float *x, sunindextype *inc_x, const float *beta, + float *y, sunindextype *inc_y); + +extern void strsv_f77(const char *uplo, const char *trans, const char *diag, + const sunindextype *n, const float *a, + const sunindextype *lda, float *x, + const sunindextype *inc_x); + +/* Level-3 BLAS */ + +extern void dsyrk_f77(const char *uplo, const char *trans, + const sunindextype *n, const sunindextype *k, + const double *alpha, const double *a, + const sunindextype *lda, const double *beta, + const double *c, const sunindextype *ldc); + +extern void ssyrk_f77(const char *uplo, const char *trans, + const sunindextype *n, const sunindextype *k, + const float *alpha, const float *a, + const sunindextype *lda, const float *beta, + const float *c, const sunindextype *ldc); + +/* LAPACK */ + +extern void dgbtrf_f77(const sunindextype *m, const sunindextype *n, + const sunindextype *kl, const sunindextype *ku, + double *ab, sunindextype *ldab, sunindextype *ipiv, + sunindextype *info); + +extern void dgbtrs_f77(const char *trans, const sunindextype *n, + const sunindextype *kl, const sunindextype *ku, + const sunindextype *nrhs, double *ab, + const sunindextype *ldab, sunindextype *ipiv, + double *b, const sunindextype *ldb, sunindextype *info); + + +extern void dgeqp3_f77(const sunindextype *m, const sunindextype *n, double *a, + const sunindextype *lda, sunindextype *jpvt, double *tau, + double *work, const sunindextype *lwork, + sunindextype *info); + +extern void dgeqrf_f77(const sunindextype *m, const sunindextype *n, double *a, + const sunindextype *lda, double *tau, double *work, + const sunindextype *lwork, sunindextype *info); + +extern void dgetrf_f77(const sunindextype *m, const sunindextype *n, double *a, + sunindextype *lda, sunindextype *ipiv, + sunindextype *info); + +extern void dgetrs_f77(const char *trans, const sunindextype *n, + const sunindextype *nrhs, double *a, + const sunindextype *lda, sunindextype *ipiv, double *b, + const sunindextype *ldb, sunindextype *info); + + +extern void dormqr_f77(const char *side, const char *trans, + const sunindextype *m, const sunindextype *n, + const sunindextype *k, double *a, + const sunindextype *lda, double *tau, double *c, + const sunindextype *ldc, double *work, + const sunindextype *lwork, sunindextype *info); + +extern void dpotrf_f77(const char *uplo, const sunindextype *n, double *a, + sunindextype *lda, sunindextype *info); + +extern void dpotrs_f77(const char *uplo, const sunindextype *n, + const sunindextype *nrhs, double *a, + const sunindextype *lda, double *b, + const sunindextype *ldb, sunindextype *info); + + +extern void sgbtrf_f77(const sunindextype *m, const sunindextype *n, + const sunindextype *kl, const sunindextype *ku, + float *ab, sunindextype *ldab, sunindextype *ipiv, + sunindextype *info); + +extern void sgbtrs_f77(const char *trans, const sunindextype *n, + const sunindextype *kl, const sunindextype *ku, + const sunindextype *nrhs, float *ab, + const sunindextype *ldab, sunindextype *ipiv, + float *b, const sunindextype *ldb, sunindextype *info); + + +extern void sgeqp3_f77(const sunindextype *m, const sunindextype *n, float *a, + const sunindextype *lda, sunindextype *jpvt, float *tau, + float *work, const sunindextype *lwork, + sunindextype *info); + +extern void sgeqrf_f77(const sunindextype *m, const sunindextype *n, float *a, + const sunindextype *lda, float *tau, float *work, + const sunindextype *lwork, sunindextype *info); + +extern void sgetrf_f77(const sunindextype *m, const sunindextype *n, float *a, + sunindextype *lda, sunindextype *ipiv, + sunindextype *info); + +extern void sgetrs_f77(const char *trans, const sunindextype *n, + const sunindextype *nrhs, float *a, + const sunindextype *lda, sunindextype *ipiv, + float *b, const sunindextype *ldb, sunindextype *info); + + +extern void sormqr_f77(const char *side, const char *trans, + const sunindextype *m, const sunindextype *n, + const sunindextype *k, float *a, const sunindextype *lda, + float *tau, float *c, const sunindextype *ldc, + float *work, const sunindextype *lwork, + sunindextype *info); + +extern void spotrf_f77(const char *uplo, const sunindextype *n, float *a, + sunindextype *lda, sunindextype *info); + +extern void spotrs_f77(const char *uplo, const sunindextype *n, + const sunindextype *nrhs, float *a, + const sunindextype *lda, float *b, + const sunindextype *ldb, sunindextype *info); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sundials/sundials_linearsolver.h b/bazaar/plugin/sundials/include/sundials/sundials_linearsolver.h new file mode 100644 index 000000000..d0e3badd1 --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_linearsolver.h @@ -0,0 +1,204 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * David Gardner, Carol Woodward, Slaven Peles @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for a generic linear solver package. + * It defines the SUNLinearSolver structure (_generic_SUNLinearSolver) + * which contains the following fields: + * - an implementation-dependent 'content' field which contains + * any internal data required by the solver + * - an 'ops' filed which contains a structure listing operations + * acting on/by such solvers + * + * We consider both direct linear solvers and iterative linear solvers + * as available implementations of this package. Furthermore, iterative + * linear solvers can either use a matrix or be matrix-free. As a + * result of these different solver characteristics, some of the + * routines are applicable only to some types of linear solver. + * ----------------------------------------------------------------- + * This header file contains: + * - enumeration constants for all SUNDIALS-defined linear solver + * types, as well as a generic type for user-supplied linear + * solver types, + * - type declarations for the _generic_SUNLinearSolver and + * _generic_SUNLinearSolver_Ops structures, as well as references + * to pointers to such structures (SUNLinearSolver), + * - prototypes for the linear solver functions which operate + * on/by SUNLinearSolver objects, and + * - return codes for SUNLinearSolver objects. + * ----------------------------------------------------------------- + * At a minimum, a particular implementation of a SUNLinearSolver must + * do the following: + * - specify the 'content' field of SUNLinearSolver, + * - implement the operations on/by those SUNLinearSolver objects, + * - provide a constructor routine for new SUNLinearSolver objects + * + * Additionally, a SUNLinearSolver implementation may provide the + * following: + * - "Set" routines to control solver-specific parameters/options + * - "Get" routines to access solver-specific performance metrics + * -----------------------------------------------------------------*/ + +#ifndef _SUNLINEARSOLVER_H +#define _SUNLINEARSOLVER_H + +#include +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/* ----------------------------------------------------------------- + * Implemented SUNLinearSolver types and IDs: + * ----------------------------------------------------------------- */ + +typedef enum { + SUNLINEARSOLVER_DIRECT, + SUNLINEARSOLVER_ITERATIVE, + SUNLINEARSOLVER_MATRIX_ITERATIVE +} SUNLinearSolver_Type; + +typedef enum { + SUNLINEARSOLVER_BAND, + SUNLINEARSOLVER_DENSE, + SUNLINEARSOLVER_KLU, + SUNLINEARSOLVER_LAPACKBAND, + SUNLINEARSOLVER_LAPACKDENSE, + SUNLINEARSOLVER_PCG, + SUNLINEARSOLVER_SPBCGS, + SUNLINEARSOLVER_SPFGMR, + SUNLINEARSOLVER_SPGMR, + SUNLINEARSOLVER_SPTFQMR, + SUNLINEARSOLVER_SUPERLUDIST, + SUNLINEARSOLVER_SUPERLUMT, + SUNLINEARSOLVER_CUSOLVERSP_BATCHQR, + SUNLINEARSOLVER_CUSTOM +} SUNLinearSolver_ID; + + +/* ----------------------------------------------------------------- + * Generic definition of SUNLinearSolver + * ----------------------------------------------------------------- */ + +/* Forward reference for pointer to SUNLinearSolver_Ops object */ +typedef _SUNDIALS_STRUCT_ _generic_SUNLinearSolver_Ops *SUNLinearSolver_Ops; + +/* Forward reference for pointer to SUNLinearSolver object */ +typedef _SUNDIALS_STRUCT_ _generic_SUNLinearSolver *SUNLinearSolver; + +/* Structure containing function pointers to linear solver operations */ +struct _generic_SUNLinearSolver_Ops { + SUNLinearSolver_Type (*gettype)(SUNLinearSolver); + SUNLinearSolver_ID (*getid)(SUNLinearSolver); + int (*setatimes)(SUNLinearSolver, void*, ATimesFn); + int (*setpreconditioner)(SUNLinearSolver, void*, + PSetupFn, PSolveFn); + int (*setscalingvectors)(SUNLinearSolver, + N_Vector, N_Vector); + int (*initialize)(SUNLinearSolver); + int (*setup)(SUNLinearSolver, SUNMatrix); + int (*solve)(SUNLinearSolver, SUNMatrix, N_Vector, + N_Vector, realtype); + int (*numiters)(SUNLinearSolver); + realtype (*resnorm)(SUNLinearSolver); + sunindextype (*lastflag)(SUNLinearSolver); + int (*space)(SUNLinearSolver, long int*, long int*); + N_Vector (*resid)(SUNLinearSolver); + int (*free)(SUNLinearSolver); +}; + +/* A linear solver is a structure with an implementation-dependent + 'content' field, and a pointer to a structure of linear solver + operations corresponding to that implementation. */ +struct _generic_SUNLinearSolver { + void *content; + SUNLinearSolver_Ops ops; +}; + + +/* ----------------------------------------------------------------- + * Functions exported by SUNLinearSolver module + * ----------------------------------------------------------------- */ + +SUNDIALS_EXPORT SUNLinearSolver SUNLinSolNewEmpty(); + +SUNDIALS_EXPORT void SUNLinSolFreeEmpty(SUNLinearSolver S); + +SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType(SUNLinearSolver S); + +SUNDIALS_EXPORT SUNLinearSolver_ID SUNLinSolGetID(SUNLinearSolver S); + +SUNDIALS_EXPORT int SUNLinSolSetATimes(SUNLinearSolver S, void* A_data, + ATimesFn ATimes); + +SUNDIALS_EXPORT int SUNLinSolSetPreconditioner(SUNLinearSolver S, void* P_data, + PSetupFn Pset, PSolveFn Psol); + +SUNDIALS_EXPORT int SUNLinSolSetScalingVectors(SUNLinearSolver S, N_Vector s1, + N_Vector s2); + +SUNDIALS_EXPORT int SUNLinSolInitialize(SUNLinearSolver S); + +SUNDIALS_EXPORT int SUNLinSolSetup(SUNLinearSolver S, SUNMatrix A); + +SUNDIALS_EXPORT int SUNLinSolSolve(SUNLinearSolver S, SUNMatrix A, N_Vector x, + N_Vector b, realtype tol); + +SUNDIALS_EXPORT int SUNLinSolNumIters(SUNLinearSolver S); + +SUNDIALS_EXPORT realtype SUNLinSolResNorm(SUNLinearSolver S); + +SUNDIALS_EXPORT N_Vector SUNLinSolResid(SUNLinearSolver S); + +SUNDIALS_EXPORT sunindextype SUNLinSolLastFlag(SUNLinearSolver S); + +SUNDIALS_EXPORT int SUNLinSolSpace(SUNLinearSolver S, long int *lenrwLS, + long int *leniwLS); + +SUNDIALS_EXPORT int SUNLinSolFree(SUNLinearSolver S); + + +/* ----------------------------------------------------------------- + * SUNLinearSolver return values + * ----------------------------------------------------------------- */ + +#define SUNLS_SUCCESS 0 /* successful/converged */ + +#define SUNLS_MEM_NULL -801 /* mem argument is NULL */ +#define SUNLS_ILL_INPUT -802 /* illegal function input */ +#define SUNLS_MEM_FAIL -803 /* failed memory access */ +#define SUNLS_ATIMES_FAIL_UNREC -804 /* atimes unrecoverable failure */ +#define SUNLS_PSET_FAIL_UNREC -805 /* pset unrecoverable failure */ +#define SUNLS_PSOLVE_FAIL_UNREC -806 /* psolve unrecoverable failure */ +#define SUNLS_PACKAGE_FAIL_UNREC -807 /* external package unrec. fail */ +#define SUNLS_GS_FAIL -808 /* Gram-Schmidt failure */ +#define SUNLS_QRSOL_FAIL -809 /* QRsol found singular R */ +#define SUNLS_VECTOROP_ERR -810 /* vector operation error */ + +#define SUNLS_RES_REDUCED 801 /* nonconv. solve, resid reduced */ +#define SUNLS_CONV_FAIL 802 /* nonconvergent solve */ +#define SUNLS_ATIMES_FAIL_REC 803 /* atimes failed recoverably */ +#define SUNLS_PSET_FAIL_REC 804 /* pset failed recoverably */ +#define SUNLS_PSOLVE_FAIL_REC 805 /* psolve failed recoverably */ +#define SUNLS_PACKAGE_FAIL_REC 806 /* external package recov. fail */ +#define SUNLS_QRFACT_FAIL 807 /* QRfact found singular matrix */ +#define SUNLS_LUFACT_FAIL 808 /* LUfact found singular matrix */ + +#ifdef __cplusplus +} +#endif +#endif diff --git a/bazaar/plugin/sundials/include/sundials/sundials_math.h b/bazaar/plugin/sundials/include/sundials/sundials_math.h new file mode 100644 index 000000000..96ec82f0d --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_math.h @@ -0,0 +1,193 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * 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 sundials_types.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALSMATH_H +#define _SUNDIALSMATH_H + +#include + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ----------------------------------------------------------------- + * Macros + * ----------------------------------------------------------------- + * SUNMIN(A,B) returns the minimum of A and B + * + * SUNMAX(A,B) returns the maximum of A and B + * + * SUNSQR(A) returns A^2 + * + * SUNRsqrt calls the appropriate version of sqrt + * + * SUNRabs calls the appropriate version of abs + * + * SUNRexp calls the appropriate version of exp + * + * SUNRceil calls the appropriate version of ceil + * ----------------------------------------------------------------- + */ + +#ifndef SUNMIN +#define SUNMIN(A, B) ((A) < (B) ? (A) : (B)) +#endif + +#ifndef SUNMAX +#define SUNMAX(A, B) ((A) > (B) ? (A) : (B)) +#endif + +#ifndef SUNSQR +#define SUNSQR(A) ((A)*(A)) +#endif + +/* + * ----------------------------------------------------------------- + * Function : SUNRsqrt + * ----------------------------------------------------------------- + * Usage : realtype sqrt_x; + * sqrt_x = SUNRsqrt(x); + * ----------------------------------------------------------------- + * SUNRsqrt(x) returns the square root of x. If x < ZERO, then + * SUNRsqrt returns ZERO. + * ----------------------------------------------------------------- + */ + +#ifndef SUNRsqrt +#if defined(SUNDIALS_USE_GENERIC_MATH) +#define SUNRsqrt(x) ((x) <= RCONST(0.0) ? (RCONST(0.0)) : ((realtype) sqrt((double) (x)))) +#elif defined(SUNDIALS_DOUBLE_PRECISION) +#define SUNRsqrt(x) ((x) <= RCONST(0.0) ? (RCONST(0.0)) : (sqrt((x)))) +#elif defined(SUNDIALS_SINGLE_PRECISION) +#define SUNRsqrt(x) ((x) <= RCONST(0.0) ? (RCONST(0.0)) : (sqrtf((x)))) +#elif defined(SUNDIALS_EXTENDED_PRECISION) +#define SUNRsqrt(x) ((x) <= RCONST(0.0) ? (RCONST(0.0)) : (sqrtl((x)))) +#endif +#endif + +/* + * ----------------------------------------------------------------- + * Function : SUNRabs + * ----------------------------------------------------------------- + * Usage : realtype abs_x; + * abs_x = SUNRabs(x); + * ----------------------------------------------------------------- + * SUNRabs(x) returns the absolute value of x. + * ----------------------------------------------------------------- + */ + +#ifndef SUNRabs +#if defined(SUNDIALS_USE_GENERIC_MATH) +#define SUNRabs(x) ((realtype) fabs((double) (x))) +#elif defined(SUNDIALS_DOUBLE_PRECISION) +#define SUNRabs(x) (fabs((x))) +#elif defined(SUNDIALS_SINGLE_PRECISION) +#define SUNRabs(x) (fabsf((x))) +#elif defined(SUNDIALS_EXTENDED_PRECISION) +#define SUNRabs(x) (fabsl((x))) +#endif +#endif + +/* + * ----------------------------------------------------------------- + * Function : SUNRexp + * ----------------------------------------------------------------- + * Usage : realtype exp_x; + * exp_x = SUNRexp(x); + * ----------------------------------------------------------------- + * SUNRexp(x) returns e^x (base-e exponential function). + * ----------------------------------------------------------------- + */ + +#ifndef SUNRexp +#if defined(SUNDIALS_USE_GENERIC_MATH) +#define SUNRexp(x) ((realtype) exp((double) (x))) +#elif defined(SUNDIALS_DOUBLE_PRECISION) +#define SUNRexp(x) (exp((x))) +#elif defined(SUNDIALS_SINGLE_PRECISION) +#define SUNRexp(x) (expf((x))) +#elif defined(SUNDIALS_EXTENDED_PRECISION) +#define SUNRexp(x) (expl((x))) +#endif +#endif + +/* + * ----------------------------------------------------------------- + * Function : SUNRceil + * ----------------------------------------------------------------- + * Usage : realtype ceil_x; + * ceil_x = SUNRceil(x); + * ----------------------------------------------------------------- + * SUNRceil(x) returns the smallest integer value not less than x. + * ----------------------------------------------------------------- + */ + +#ifndef SUNRceil +#if defined(SUNDIALS_USE_GENERIC_MATH) +#define SUNRceil(x) ((realtype) ceil((double) (x))) +#elif defined(SUNDIALS_DOUBLE_PRECISION) +#define SUNRceil(x) (ceil((x))) +#elif defined(SUNDIALS_SINGLE_PRECISION) +#define SUNRceil(x) (ceilf((x))) +#elif defined(SUNDIALS_EXTENDED_PRECISION) +#define SUNRceil(x) (ceill((x))) +#endif +#endif + +/* + * ----------------------------------------------------------------- + * Function : SUNRpowerI + * ----------------------------------------------------------------- + * Usage : int exponent; + * realtype base, ans; + * ans = SUNRpowerI(base,exponent); + * ----------------------------------------------------------------- + * SUNRpowerI returns the value of base^exponent, where base is of type + * realtype and exponent is of type int. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype SUNRpowerI(realtype base, int exponent); + +/* + * ----------------------------------------------------------------- + * Function : SUNRpowerR + * ----------------------------------------------------------------- + * Usage : realtype base, exponent, ans; + * ans = SUNRpowerR(base,exponent); + * ----------------------------------------------------------------- + * SUNRpowerR returns the value of base^exponent, where both base and + * exponent are of type realtype. If base < ZERO, then SUNRpowerR + * returns ZERO. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype SUNRpowerR(realtype base, realtype exponent); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sundials/sundials_matrix.h b/bazaar/plugin/sundials/include/sundials/sundials_matrix.h new file mode 100644 index 000000000..366520241 --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_matrix.h @@ -0,0 +1,135 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * David Gardner, Carol Woodward, Slaven Peles, + * Cody Balos @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for a generic matrix package. + * It defines the SUNMatrix structure (_generic_SUNMatrix) which + * contains the following fields: + * - an implementation-dependent 'content' field which contains + * the description and actual data of the matrix + * - an 'ops' filed which contains a structure listing operations + * acting on such matrices + * ----------------------------------------------------------------- + * This header file contains: + * - enumeration constants for all SUNDIALS-defined matrix types, + * as well as a generic type for user-supplied matrix types, + * - type declarations for the _generic_SUNMatrix and + * _generic_SUNMatrix_Ops structures, as well as references to + * pointers to such structures (SUNMatrix), and + * - prototypes for the matrix functions which operate on + * SUNMatrix objects. + * ----------------------------------------------------------------- + * At a minimum, a particular implementation of a SUNMatrix must + * do the following: + * - specify the 'content' field of SUNMatrix, + * - implement the operations on those SUNMatrix objects, + * - provide a constructor routine for new SUNMatrix objects + * + * Additionally, a SUNMatrix implementation may provide the following: + * - macros to access the underlying SUNMatrix data + * - a routine to print the content of a SUNMatrix + * -----------------------------------------------------------------*/ + +#ifndef _SUNMATRIX_H +#define _SUNMATRIX_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/* ----------------------------------------------------------------- + * Implemented SUNMatrix types + * ----------------------------------------------------------------- */ + +typedef enum { + SUNMATRIX_DENSE, + SUNMATRIX_BAND, + SUNMATRIX_SPARSE, + SUNMATRIX_SLUNRLOC, + SUNMATRIX_CUSPARSE, + SUNMATRIX_CUSTOM +} SUNMatrix_ID; + + +/* ----------------------------------------------------------------- + * Generic definition of SUNMatrix + * ----------------------------------------------------------------- */ + +/* Forward reference for pointer to SUNMatrix_Ops object */ +typedef _SUNDIALS_STRUCT_ _generic_SUNMatrix_Ops *SUNMatrix_Ops; + +/* Forward reference for pointer to SUNMatrix object */ +typedef _SUNDIALS_STRUCT_ _generic_SUNMatrix *SUNMatrix; + +/* Structure containing function pointers to matrix operations */ +struct _generic_SUNMatrix_Ops { + SUNMatrix_ID (*getid)(SUNMatrix); + SUNMatrix (*clone)(SUNMatrix); + void (*destroy)(SUNMatrix); + int (*zero)(SUNMatrix); + int (*copy)(SUNMatrix, SUNMatrix); + int (*scaleadd)(realtype, SUNMatrix, SUNMatrix); + int (*scaleaddi)(realtype, SUNMatrix); + int (*matvecsetup)(SUNMatrix); + int (*matvec)(SUNMatrix, N_Vector, N_Vector); + int (*space)(SUNMatrix, long int*, long int*); +}; + +/* A matrix is a structure with an implementation-dependent + 'content' field, and a pointer to a structure of matrix + operations corresponding to that implementation. */ +struct _generic_SUNMatrix { + void *content; + SUNMatrix_Ops ops; +}; + + +/* ----------------------------------------------------------------- + * Functions exported by SUNMatrix module + * ----------------------------------------------------------------- */ + +SUNDIALS_EXPORT SUNMatrix SUNMatNewEmpty(); +SUNDIALS_EXPORT void SUNMatFreeEmpty(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatCopyOps(SUNMatrix A, SUNMatrix B); +SUNDIALS_EXPORT SUNMatrix_ID SUNMatGetID(SUNMatrix A); +SUNDIALS_EXPORT SUNMatrix SUNMatClone(SUNMatrix A); +SUNDIALS_EXPORT void SUNMatDestroy(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatZero(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatCopy(SUNMatrix A, SUNMatrix B); +SUNDIALS_EXPORT int SUNMatScaleAdd(realtype c, SUNMatrix A, SUNMatrix B); +SUNDIALS_EXPORT int SUNMatScaleAddI(realtype c, SUNMatrix A); +SUNDIALS_EXPORT int SUNMatMatvecSetup(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatMatvec(SUNMatrix A, N_Vector x, N_Vector y); +SUNDIALS_EXPORT int SUNMatSpace(SUNMatrix A, long int *lenrw, long int *leniw); + +/* + * ----------------------------------------------------------------- + * IV. SUNMatrix error codes + * --------------------------------------------------------------- + */ + +#define SUNMAT_SUCCESS 0 /* function successfull */ +#define SUNMAT_ILL_INPUT -701 /* illegal function input */ +#define SUNMAT_MEM_FAIL -702 /* failed memory access/alloc */ +#define SUNMAT_OPERATION_FAIL -703 /* a SUNMatrix operation returned nonzero */ +#define SUNMAT_MATVEC_SETUP_REQUIRED -704 /* the SUNMatMatvecSetup routine needs to be called */ + +#ifdef __cplusplus +} +#endif +#endif diff --git a/bazaar/plugin/sundials/include/sundials/sundials_mpi_types.h b/bazaar/plugin/sundials/include/sundials/sundials_mpi_types.h new file mode 100644 index 000000000..248bc9cfa --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_mpi_types.h @@ -0,0 +1,39 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Scott Cohen, Alan Hindmarsh, Radu Serban, + * Aaron Collier, and Slaven Peles @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This header file contains definitions of MPI data types, which + * are used by MPI parallel vector implementations. + * -----------------------------------------------------------------*/ + +#include + +/* define MPI data types */ + +#if defined(SUNDIALS_SINGLE_PRECISION) + #define MPI_SUNREALTYPE MPI_FLOAT +#elif defined(SUNDIALS_DOUBLE_PRECISION) + #define MPI_SUNREALTYPE MPI_DOUBLE +#elif defined(SUNDIALS_EXTENDED_PRECISION) + #define MPI_SUNREALTYPE MPI_LONG_DOUBLE +#endif + +#if defined(SUNDIALS_INT64_T) + #define MPI_SUNINDEXTYPE MPI_INT64_T +#elif defined(SUNDIALS_INT32_T) + #define MPI_SUNINDEXTYPE MPI_INT32_T +#endif + +/* define legacy SUNDIALS MPI data types */ +#define PVEC_REAL_MPI_TYPE MPI_SUNREALTYPE +#define PVEC_INTEGER_MPI_TYPE MPI_SUNINDEXTYPE diff --git a/bazaar/plugin/sundials/include/sundials/sundials_nonlinearsolver.h b/bazaar/plugin/sundials/include/sundials/sundials_nonlinearsolver.h new file mode 100644 index 000000000..6fb18d765 --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_nonlinearsolver.h @@ -0,0 +1,197 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------------------- + * This is the header file for a generic nonlinear solver package. It defines + * the SUNNonlinearSolver structure (_generic_SUNNonlinearSolver) which contains + * the following fields: + * - an implementation-dependent 'content' field which contains any internal + * data required by the solver + * - an 'ops' filed which contains a structure listing operations acting on/by + * such solvers + * + * We consider iterative nonlinear solvers for systems in both root finding + * (F(y) = 0) or fixed-point (G(y) = y) form. As a result, some of the routines + * are applicable only to one type of nonlinear solver. + * ----------------------------------------------------------------------------- + * This header file contains: + * - function types supplied to a SUNNonlinearSolver, + * - enumeration constants for SUNDIALS-defined nonlinear solver types, + * - type declarations for the _generic_SUNNonlinearSolver and + * _generic_SUNNonlinearSolver_Ops structures, as well as references to + * pointers to such structures (SUNNonlinearSolver), + * - prototypes for the nonlinear solver functions which operate + * on/by SUNNonlinearSolver objects, and + * - return codes for SUNLinearSolver objects. + * ----------------------------------------------------------------------------- + * At a minimum, a particular implementation of a SUNNonlinearSolver must do the + * following: + * - specify the 'content' field of a SUNNonlinearSolver, + * - implement the operations on/by the SUNNonlinearSovler objects, + * - provide a constructor routine for new SUNNonlinearSolver objects + * + * Additionally, a SUNNonlinearSolver implementation may provide the following: + * - "Set" routines to control solver-specific parameters/options + * - "Get" routines to access solver-specific performance metrics + * ---------------------------------------------------------------------------*/ + +#ifndef _SUNNONLINEARSOLVER_H +#define _SUNNONLINEARSOLVER_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/* ----------------------------------------------------------------------------- + * Forward references for SUNNonlinearSolver types defined below + * ---------------------------------------------------------------------------*/ + +/* Forward reference for pointer to SUNNonlinearSolver_Ops object */ +typedef _SUNDIALS_STRUCT_ _generic_SUNNonlinearSolver_Ops *SUNNonlinearSolver_Ops; + +/* Forward reference for pointer to SUNNonlinearSolver object */ +typedef _SUNDIALS_STRUCT_ _generic_SUNNonlinearSolver *SUNNonlinearSolver; + + +/* ----------------------------------------------------------------------------- + * Integrator supplied function types + * ---------------------------------------------------------------------------*/ + +typedef int (*SUNNonlinSolSysFn)(N_Vector y, N_Vector F, void* mem); + +typedef int (*SUNNonlinSolLSetupFn)(booleantype jbad, booleantype* jcur, + void* mem); + +typedef int (*SUNNonlinSolLSolveFn)(N_Vector b, void* mem); + +typedef int (*SUNNonlinSolConvTestFn)(SUNNonlinearSolver NLS, N_Vector y, + N_Vector del, realtype tol, N_Vector ewt, + void* mem); + + +/* ----------------------------------------------------------------------------- + * SUNNonlinearSolver types + * ---------------------------------------------------------------------------*/ + +typedef enum { + SUNNONLINEARSOLVER_ROOTFIND, + SUNNONLINEARSOLVER_FIXEDPOINT +} SUNNonlinearSolver_Type; + + +/* ----------------------------------------------------------------------------- + * Generic definition of SUNNonlinearSolver + * ---------------------------------------------------------------------------*/ + +/* Structure containing function pointers to nonlinear solver operations */ +struct _generic_SUNNonlinearSolver_Ops { + SUNNonlinearSolver_Type (*gettype)(SUNNonlinearSolver); + int (*initialize)(SUNNonlinearSolver); + int (*setup)(SUNNonlinearSolver, N_Vector, void*); + int (*solve)(SUNNonlinearSolver, N_Vector, N_Vector, N_Vector, realtype, + booleantype, void*); + int (*free)(SUNNonlinearSolver); + int (*setsysfn)(SUNNonlinearSolver, SUNNonlinSolSysFn); + int (*setlsetupfn)(SUNNonlinearSolver, SUNNonlinSolLSetupFn); + int (*setlsolvefn)(SUNNonlinearSolver, SUNNonlinSolLSolveFn); + int (*setctestfn)(SUNNonlinearSolver, SUNNonlinSolConvTestFn, void*); + int (*setmaxiters)(SUNNonlinearSolver, int); + int (*getnumiters)(SUNNonlinearSolver, long int*); + int (*getcuriter)(SUNNonlinearSolver, int*); + int (*getnumconvfails)(SUNNonlinearSolver, long int*); +}; + +/* A nonlinear solver is a structure with an implementation-dependent 'content' + field, and a pointer to a structure of solver nonlinear solver operations + corresponding to that implementation. */ +struct _generic_SUNNonlinearSolver { + void *content; + SUNNonlinearSolver_Ops ops; +}; + + +/* ----------------------------------------------------------------------------- + * Functions exported by SUNNonlinearSolver module + * ---------------------------------------------------------------------------*/ + +/* empty constructor/destructor */ +SUNDIALS_EXPORT SUNNonlinearSolver SUNNonlinSolNewEmpty(); +SUNDIALS_EXPORT void SUNNonlinSolFreeEmpty(SUNNonlinearSolver NLS); + +/* core functions */ +SUNDIALS_EXPORT SUNNonlinearSolver_Type SUNNonlinSolGetType(SUNNonlinearSolver NLS); + +SUNDIALS_EXPORT int SUNNonlinSolInitialize(SUNNonlinearSolver NLS); + +SUNDIALS_EXPORT int SUNNonlinSolSetup(SUNNonlinearSolver NLS, + N_Vector y, void* mem); + +SUNDIALS_EXPORT int SUNNonlinSolSolve(SUNNonlinearSolver NLS, + N_Vector y0, N_Vector y, + N_Vector w, realtype tol, + booleantype callLSetup, void *mem); + +SUNDIALS_EXPORT int SUNNonlinSolFree(SUNNonlinearSolver NLS); + +/* set functions */ +SUNDIALS_EXPORT int SUNNonlinSolSetSysFn(SUNNonlinearSolver NLS, + SUNNonlinSolSysFn SysFn); + +SUNDIALS_EXPORT int SUNNonlinSolSetLSetupFn(SUNNonlinearSolver NLS, + SUNNonlinSolLSetupFn SetupFn); + +SUNDIALS_EXPORT int SUNNonlinSolSetLSolveFn(SUNNonlinearSolver NLS, + SUNNonlinSolLSolveFn SolveFn); + +SUNDIALS_EXPORT int SUNNonlinSolSetConvTestFn(SUNNonlinearSolver NLS, + SUNNonlinSolConvTestFn CTestFn, + void* ctest_data); + +SUNDIALS_EXPORT int SUNNonlinSolSetMaxIters(SUNNonlinearSolver NLS, + int maxiters); +/* get functions */ +SUNDIALS_EXPORT int SUNNonlinSolGetNumIters(SUNNonlinearSolver NLS, + long int *niters); + +SUNDIALS_EXPORT int SUNNonlinSolGetCurIter(SUNNonlinearSolver NLS, + int *iter); + +SUNDIALS_EXPORT int SUNNonlinSolGetNumConvFails(SUNNonlinearSolver NLS, + long int *nconvfails); + + +/* ----------------------------------------------------------------------------- + * SUNNonlinearSolver return values + * ---------------------------------------------------------------------------*/ + +#define SUN_NLS_SUCCESS 0 /* successful / converged */ + +/* Recoverable */ +#define SUN_NLS_CONTINUE +901 /* not converged, keep iterating */ +#define SUN_NLS_CONV_RECVR +902 /* convergece failure, try to recover */ + +/* Unrecoverable */ +#define SUN_NLS_MEM_NULL -901 /* memory argument is NULL */ +#define SUN_NLS_MEM_FAIL -902 /* failed memory access / allocation */ +#define SUN_NLS_ILL_INPUT -903 /* illegal function input */ +#define SUN_NLS_VECTOROP_ERR -904 /* failed NVector operation */ +#define SUN_NLS_EXT_FAIL -905 /* failed in external library call */ + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sundials/sundials_nvector.h b/bazaar/plugin/sundials/include/sundials/sundials_nvector.h new file mode 100644 index 000000000..e343fb56a --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_nvector.h @@ -0,0 +1,264 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for a generic NVECTOR package. + * It defines the N_Vector structure (_generic_N_Vector) which + * contains the following fields: + * - an implementation-dependent 'content' field which contains + * the description and actual data of the vector + * - an 'ops' filed which contains a structure listing operations + * acting on such vectors + * ----------------------------------------------------------------- + * This header file contains: + * - enumeration constants for all SUNDIALS-defined vector types, + * as well as a generic type for user-supplied vector types, + * - type declarations for the _generic_N_Vector and + * _generic_N_Vector_Ops structures, as well as references to + * pointers to such structures (N_Vector), and + * - prototypes for the vector functions which operate on + * N_Vector objects. + * ----------------------------------------------------------------- + * At a minimum, a particular implementation of an NVECTOR must + * do the following: + * - specify the 'content' field of N_Vector, + * - implement the operations on those N_Vector objects, + * - provide a constructor routine for new N_Vector objects + * + * Additionally, an NVECTOR implementation may provide the following: + * - macros to access the underlying N_Vector data + * - a constructor for an array of N_Vectors + * - a constructor for an empty N_Vector (i.e., a new N_Vector with + * a NULL data pointer). + * - a routine to print the content of an N_Vector + * -----------------------------------------------------------------*/ + +#ifndef _NVECTOR_H +#define _NVECTOR_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/* ----------------------------------------------------------------- + * Implemented N_Vector types + * ----------------------------------------------------------------- */ + +typedef enum { + SUNDIALS_NVEC_SERIAL, + SUNDIALS_NVEC_PARALLEL, + SUNDIALS_NVEC_OPENMP, + SUNDIALS_NVEC_PTHREADS, + SUNDIALS_NVEC_PARHYP, + SUNDIALS_NVEC_PETSC, + SUNDIALS_NVEC_CUDA, + SUNDIALS_NVEC_RAJA, + SUNDIALS_NVEC_OPENMPDEV, + SUNDIALS_NVEC_TRILINOS, + SUNDIALS_NVEC_MANYVECTOR, + SUNDIALS_NVEC_MPIMANYVECTOR, + SUNDIALS_NVEC_MPIPLUSX, + SUNDIALS_NVEC_CUSTOM +} N_Vector_ID; + + +/* ----------------------------------------------------------------- + * Generic definition of N_Vector + * ----------------------------------------------------------------- */ + +/* Forward reference for pointer to N_Vector_Ops object */ +typedef _SUNDIALS_STRUCT_ _generic_N_Vector_Ops *N_Vector_Ops; + +/* Forward reference for pointer to N_Vector object */ +typedef _SUNDIALS_STRUCT_ _generic_N_Vector *N_Vector; + +/* Define array of N_Vectors */ +typedef N_Vector *N_Vector_S; + +/* Structure containing function pointers to vector operations */ +struct _generic_N_Vector_Ops { + N_Vector_ID (*nvgetvectorid)(N_Vector); + N_Vector (*nvclone)(N_Vector); + N_Vector (*nvcloneempty)(N_Vector); + void (*nvdestroy)(N_Vector); + void (*nvspace)(N_Vector, sunindextype *, sunindextype *); + realtype* (*nvgetarraypointer)(N_Vector); + void (*nvsetarraypointer)(realtype *, N_Vector); + void* (*nvgetcommunicator)(N_Vector); + sunindextype (*nvgetlength)(N_Vector); + + /* standard vector operations */ + void (*nvlinearsum)(realtype, N_Vector, realtype, N_Vector, N_Vector); + void (*nvconst)(realtype, N_Vector); + void (*nvprod)(N_Vector, N_Vector, N_Vector); + void (*nvdiv)(N_Vector, N_Vector, N_Vector); + void (*nvscale)(realtype, N_Vector, N_Vector); + void (*nvabs)(N_Vector, N_Vector); + void (*nvinv)(N_Vector, N_Vector); + void (*nvaddconst)(N_Vector, realtype, N_Vector); + realtype (*nvdotprod)(N_Vector, N_Vector); + realtype (*nvmaxnorm)(N_Vector); + realtype (*nvwrmsnorm)(N_Vector, N_Vector); + realtype (*nvwrmsnormmask)(N_Vector, N_Vector, N_Vector); + realtype (*nvmin)(N_Vector); + realtype (*nvwl2norm)(N_Vector, N_Vector); + realtype (*nvl1norm)(N_Vector); + void (*nvcompare)(realtype, N_Vector, N_Vector); + booleantype (*nvinvtest)(N_Vector, N_Vector); + booleantype (*nvconstrmask)(N_Vector, N_Vector, N_Vector); + realtype (*nvminquotient)(N_Vector, N_Vector); + + /* fused vector operations */ + int (*nvlinearcombination)(int, realtype*, N_Vector*, N_Vector); + int (*nvscaleaddmulti)(int, realtype*, N_Vector, N_Vector*, N_Vector*); + int (*nvdotprodmulti)(int, N_Vector, N_Vector*, realtype*); + + /* vector array operations */ + int (*nvlinearsumvectorarray)(int, realtype, N_Vector*, realtype, N_Vector*, + N_Vector*); + int (*nvscalevectorarray)(int, realtype*, N_Vector*, N_Vector*); + int (*nvconstvectorarray)(int, realtype, N_Vector*); + int (*nvwrmsnormvectorarray)(int, N_Vector*, N_Vector*, realtype*); + int (*nvwrmsnormmaskvectorarray)(int, N_Vector*, N_Vector*, N_Vector, realtype*); + int (*nvscaleaddmultivectorarray)(int, int, realtype*, N_Vector*, N_Vector**, N_Vector**); + int (*nvlinearcombinationvectorarray)(int, int, realtype*, N_Vector**, N_Vector*); + + /* OPTIONAL local reduction kernels (no parallel communication) */ + realtype (*nvdotprodlocal)(N_Vector, N_Vector); + realtype (*nvmaxnormlocal)(N_Vector); + realtype (*nvminlocal)(N_Vector); + realtype (*nvl1normlocal)(N_Vector); + booleantype (*nvinvtestlocal)(N_Vector, N_Vector); + booleantype (*nvconstrmasklocal)(N_Vector, N_Vector, N_Vector); + realtype (*nvminquotientlocal)(N_Vector, N_Vector); + realtype (*nvwsqrsumlocal)(N_Vector, N_Vector); + realtype (*nvwsqrsummasklocal)(N_Vector, N_Vector, N_Vector); +}; + +/* A vector is a structure with an implementation-dependent + 'content' field, and a pointer to a structure of vector + operations corresponding to that implementation. */ +struct _generic_N_Vector { + void *content; + N_Vector_Ops ops; +}; + + +/* ----------------------------------------------------------------- + * Functions exported by NVECTOR module + * ----------------------------------------------------------------- */ + +SUNDIALS_EXPORT N_Vector N_VNewEmpty(); +SUNDIALS_EXPORT void N_VFreeEmpty(N_Vector v); +SUNDIALS_EXPORT int N_VCopyOps(N_Vector w, N_Vector v); + +SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VClone(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VCloneEmpty(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy(N_Vector v); +SUNDIALS_EXPORT void N_VSpace(N_Vector v, sunindextype *lrw, sunindextype *liw); +SUNDIALS_EXPORT realtype *N_VGetArrayPointer(N_Vector v); +SUNDIALS_EXPORT void N_VSetArrayPointer(realtype *v_data, N_Vector v); +SUNDIALS_EXPORT void *N_VGetCommunicator(N_Vector v); +SUNDIALS_EXPORT sunindextype N_VGetLength(N_Vector v); + +/* standard vector operations */ +SUNDIALS_EXPORT void N_VLinearSum(realtype a, N_Vector x, realtype b, + N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VConst(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst(N_Vector x, realtype b, N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT realtype N_VMin(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm(N_Vector x); +SUNDIALS_EXPORT void N_VCompare(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient(N_Vector num, N_Vector denom); + +/* OPTIONAL fused vector operations */ +SUNDIALS_EXPORT int N_VLinearCombination(int nvec, realtype* c, N_Vector* X, + N_Vector z); + +SUNDIALS_EXPORT int N_VScaleAddMulti(int nvec, realtype* a, N_Vector x, + N_Vector* Y, N_Vector* Z); + +SUNDIALS_EXPORT int N_VDotProdMulti(int nvec, N_Vector x, N_Vector* Y, + realtype* dotprods); + +/* OPTIONAL vector array operations */ +SUNDIALS_EXPORT int N_VLinearSumVectorArray(int nvec, + realtype a, N_Vector* X, + realtype b, N_Vector* Y, + N_Vector* Z); + +SUNDIALS_EXPORT int N_VScaleVectorArray(int nvec, realtype* c, N_Vector* X, + N_Vector* Z); + +SUNDIALS_EXPORT int N_VConstVectorArray(int nvec, realtype c, N_Vector* Z); + +SUNDIALS_EXPORT int N_VWrmsNormVectorArray(int nvec, N_Vector* X, N_Vector* W, + realtype* nrm); + +SUNDIALS_EXPORT int N_VWrmsNormMaskVectorArray(int nvec, N_Vector* X, + N_Vector* W, N_Vector id, + realtype* nrm); + +SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray(int nvec, int nsum, + realtype* a, N_Vector* X, + N_Vector** Y, N_Vector** Z); + +SUNDIALS_EXPORT int N_VLinearCombinationVectorArray(int nvec, int nsum, + realtype* c, N_Vector** X, + N_Vector* Z); + +/* OPTIONAL local reduction kernels (no parallel communication) */ +SUNDIALS_EXPORT realtype N_VDotProdLocal(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNormLocal(N_Vector x); +SUNDIALS_EXPORT realtype N_VMinLocal(N_Vector x); +SUNDIALS_EXPORT realtype N_VL1NormLocal(N_Vector x); +SUNDIALS_EXPORT realtype N_VWSqrSumLocal(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWSqrSumMaskLocal(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT booleantype N_VInvTestLocal(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMaskLocal(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotientLocal(N_Vector num, N_Vector denom); + + +/* ----------------------------------------------------------------- + * Additional functions exported by NVECTOR module + * ----------------------------------------------------------------- */ + +SUNDIALS_EXPORT N_Vector* N_VNewVectorArray(int count); +SUNDIALS_EXPORT N_Vector* N_VCloneEmptyVectorArray(int count, N_Vector w); +SUNDIALS_EXPORT N_Vector* N_VCloneVectorArray(int count, N_Vector w); +SUNDIALS_EXPORT void N_VDestroyVectorArray(N_Vector* vs, int count); + +/* These function are really only for users of the Fortran interface */ +SUNDIALS_EXPORT N_Vector N_VGetVecAtIndexVectorArray(N_Vector* vs, int index); +SUNDIALS_EXPORT void N_VSetVecAtIndexVectorArray(N_Vector* vs, int index, N_Vector w); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sundials/sundials_nvector_senswrapper.h b/bazaar/plugin/sundials/include/sundials/sundials_nvector_senswrapper.h new file mode 100644 index 000000000..49172ec8a --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_nvector_senswrapper.h @@ -0,0 +1,104 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------------------- + * This is the header file for the implementation of the NVECTOR SensWrapper. + * + * Part I contains declarations specific to the implementation of the + * vector wrapper. + * + * Part II defines accessor macros that allow the user to efficiently access + * the content of the vector wrapper data structure. + * + * Part III contains the prototype for the constructors N_VNewEmpty_SensWrapper + * and N_VNew_SensWrapper, as well as wrappers to NVECTOR vector operations. + * ---------------------------------------------------------------------------*/ + +#ifndef _NVECTOR_SENSWRAPPER_H +#define _NVECTOR_SENSWRAPPER_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/*============================================================================== + PART I: NVector wrapper content structure + ============================================================================*/ + +struct _N_VectorContent_SensWrapper { + N_Vector* vecs; /* array of wrapped vectors */ + int nvecs; /* number of wrapped vectors */ + booleantype own_vecs; /* flag indicating if wrapper owns vectors */ +}; + +typedef struct _N_VectorContent_SensWrapper *N_VectorContent_SensWrapper; + +/*============================================================================== + PART II: Macros to access wrapper content + ============================================================================*/ + +#define NV_CONTENT_SW(v) ( (N_VectorContent_SensWrapper)(v->content) ) +#define NV_VECS_SW(v) ( NV_CONTENT_SW(v)->vecs ) +#define NV_NVECS_SW(v) ( NV_CONTENT_SW(v)->nvecs ) +#define NV_OWN_VECS_SW(v) ( NV_CONTENT_SW(v)->own_vecs ) +#define NV_VEC_SW(v,i) ( NV_VECS_SW(v)[i] ) + +/*============================================================================== + PART III: Exported functions + ============================================================================*/ + +/* constructor creates an empty vector wrapper */ +SUNDIALS_EXPORT N_Vector N_VNewEmpty_SensWrapper(int nvecs); +SUNDIALS_EXPORT N_Vector N_VNew_SensWrapper(int count, N_Vector w); + +/* clone operations */ +SUNDIALS_EXPORT N_Vector N_VCloneEmpty_SensWrapper(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VClone_SensWrapper(N_Vector w); + +/* destructor */ +SUNDIALS_EXPORT void N_VDestroy_SensWrapper(N_Vector v); + +/* standard vector operations */ +SUNDIALS_EXPORT void N_VLinearSum_SensWrapper(realtype a, N_Vector x, + realtype b, N_Vector y, + N_Vector z); +SUNDIALS_EXPORT void N_VConst_SensWrapper(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd_SensWrapper(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv_SensWrapper(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale_SensWrapper(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs_SensWrapper(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv_SensWrapper(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst_SensWrapper(N_Vector x, realtype b, + N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd_SensWrapper(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm_SensWrapper(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm_SensWrapper(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask_SensWrapper(N_Vector x, N_Vector w, + N_Vector id); +SUNDIALS_EXPORT realtype N_VMin_SensWrapper(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm_SensWrapper(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm_SensWrapper(N_Vector x); +SUNDIALS_EXPORT void N_VCompare_SensWrapper(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest_SensWrapper(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask_SensWrapper(N_Vector c, N_Vector x, + N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient_SensWrapper(N_Vector num, + N_Vector denom); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sundials/sundials_types.h b/bazaar/plugin/sundials/include/sundials/sundials_types.h new file mode 100644 index 000000000..4f8158cfd --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_types.h @@ -0,0 +1,160 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Scott Cohen, Alan Hindmarsh, Radu Serban, + * Aaron Collier, and Slaven Peles @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This header file exports three types: realtype, sunindextype and + * booleantype, as well as the constants SUNTRUE and SUNFALSE. + * + * Users should include the header file sundials_types.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. + * + * The legal types for realtype are float, double and long double. + * + * The constants SUNDIALS_INT64_T and SUNDIALS_INT32_T indicate + * the underlying data type of sunindextype -- the integer data type + * used for vector and matrix indices. + * + * Data types are set at the configuration stage. + * + * The macro RCONST gives the user a convenient way to define + * real-valued literal 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). The macro can be used for + * literal constants only. It cannot be used for expressions. + * -----------------------------------------------------------------*/ + +#ifndef _SUNDIALSTYPES_H +#define _SUNDIALSTYPES_H + +#ifndef _SUNDIALS_CONFIG_H +#define _SUNDIALS_CONFIG_H +#include +#endif + +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + *------------------------------------------------------------------ + * Macro _SUNDIALS_STRUCT_ + * The _SUNDIALS_STRUCT_ macro is defined as a `struct` unless + * generating the SWIG interfaces - in that case it is defined as + * nothing. This is needed to work around a bug in SWIG which prevents + * it from properly parsing our generic module structures. + *------------------------------------------------------------------ + */ +#ifdef SWIG +#define _SUNDIALS_STRUCT_ +#else +#define _SUNDIALS_STRUCT_ struct +#endif + +/* + *------------------------------------------------------------------ + * Type realtype + * Macro RCONST + * Constants BIG_REAL, SMALL_REAL, and UNIT_ROUNDOFF + *------------------------------------------------------------------ + */ + +#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 : sunindextype + *------------------------------------------------------------------ + * Defines integer type to be used for vector and matrix indices. + * User can build sundials to use 32- or 64-bit signed integers. + * If compiler does not support portable data types, the SUNDIALS + * CMake build system tries to find a type of the desired size. + *------------------------------------------------------------------ + */ + +typedef SUNDIALS_INDEX_TYPE sunindextype; + +/* + *------------------------------------------------------------------ + * Type : booleantype + *------------------------------------------------------------------ + * Constants : SUNFALSE and SUNTRUE + *------------------------------------------------------------------ + * ANSI C does not have a built-in boolean 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 boolean data. Variables of type + * booleantype are intended to have only the two values SUNFALSE and + * SUNTRUE which are defined below to be equal to 0 and 1, + * respectively. + *------------------------------------------------------------------ + */ + +#ifndef booleantype +#define booleantype int +#endif + +#ifndef SUNFALSE +#define SUNFALSE 0 +#endif + +#ifndef SUNTRUE +#define SUNTRUE 1 +#endif + +#ifdef __cplusplus +} +#endif + +#endif /* _SUNDIALSTYPES_H */ diff --git a/bazaar/plugin/sundials/include/sundials/sundials_version.h b/bazaar/plugin/sundials/include/sundials/sundials_version.h new file mode 100644 index 000000000..7d5a6057a --- /dev/null +++ b/bazaar/plugin/sundials/include/sundials/sundials_version.h @@ -0,0 +1,38 @@ +/* ----------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This header file is for routines to get SUNDIALS version info + * -----------------------------------------------------------------*/ + +#ifndef _SUNDIALS_VERSION_H +#define _SUNDIALS_VERSION_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* Fill a string with SUNDIALS version information */ +SUNDIALS_EXPORT int SUNDIALSGetVersion(char *version, int len); + +/* Fills integers with the major, minor, and patch release version numbers and a + string with the release label.*/ +SUNDIALS_EXPORT int SUNDIALSGetVersionNumber(int *major, int *minor, int *patch, + char *label, int len); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_band.h b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_band.h new file mode 100644 index 000000000..39005ff8d --- /dev/null +++ b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_band.h @@ -0,0 +1,76 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds, Ashley Crawford @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the band implementation of the + * SUNLINSOL module, SUNLINSOL_BAND. + * + * Note: + * - The definition of the generic SUNLinearSolver structure can + * be found in the header file sundials_linearsolver.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNLINSOL_BAND_H +#define _SUNLINSOL_BAND_H + +#include +#include +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* --------------------------------------- + * Band Implementation of SUNLinearSolver + * --------------------------------------- */ + +struct _SUNLinearSolverContent_Band { + sunindextype N; + sunindextype *pivots; + sunindextype last_flag; +}; + +typedef struct _SUNLinearSolverContent_Band *SUNLinearSolverContent_Band; + + +/* -------------------------------------- + * Exported Functions for SUNLINSOL_BAND + * -------------------------------------- */ + +SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_Band(N_Vector y, SUNMatrix A); + +/* deprecated */ +SUNDIALS_EXPORT SUNLinearSolver SUNBandLinearSolver(N_Vector y, + SUNMatrix A); + +SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_Band(SUNLinearSolver S); +SUNDIALS_EXPORT SUNLinearSolver_ID SUNLinSolGetID_Band(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolInitialize_Band(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSetup_Band(SUNLinearSolver S, SUNMatrix A); +SUNDIALS_EXPORT int SUNLinSolSolve_Band(SUNLinearSolver S, SUNMatrix A, + N_Vector x, N_Vector b, realtype tol); +SUNDIALS_EXPORT sunindextype SUNLinSolLastFlag_Band(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSpace_Band(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS); +SUNDIALS_EXPORT int SUNLinSolFree_Band(SUNLinearSolver S); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_cusolversp_batchqr.h b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_cusolversp_batchqr.h new file mode 100644 index 000000000..a7ee27857 --- /dev/null +++ b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_cusolversp_batchqr.h @@ -0,0 +1,111 @@ +/* ---------------------------------------------------------------------------- + * Programmer(s): Cody J. Balos @ LLNL + * ---------------------------------------------------------------------------- + * Based on work by Donald Wilcox @ LBNL + * ---------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ---------------------------------------------------------------------------- + * Header file for cuSolverSp batched QR SUNLinearSolver interface. + * ----------------------------------------------------------------------------*/ + +#ifndef _SUNLINSOL_CUSOLVERSP_H +#define _SUNLINSOL_CUSOLVERSP_H + +#include +#include + +#include +#include +#include + +#ifdef __cplusplus +extern "C" { +#endif + + +/* + * ---------------------------------------------------------------------------- + * PART I: cuSolverSp implementation of SUNLinearSolver + * ---------------------------------------------------------------------------- + */ + +struct _SUNLinearSolverContent_cuSolverSp_batchQR { + int last_flag; /* last return flag */ + booleantype first_factorize; /* is this the first factorization? */ + size_t internal_size; /* size of cusolver internal buffer for Q and R */ + size_t workspace_size; /* size of cusolver memory block for num. factorization */ + cusolverSpHandle_t cusolver_handle; /* cuSolverSp context */ + csrqrInfo_t info; /* opaque cusolver data structure */ + void* workspace; /* memory block used by cusolver */ + const char* desc; /* description of this linear solver */ +}; + +typedef struct _SUNLinearSolverContent_cuSolverSp_batchQR *SUNLinearSolverContent_cuSolverSp_batchQR; + + +/* + * ---------------------------------------------------------------------------- + * PART II: Functions exported by sunlinsol_sludist + * ---------------------------------------------------------------------------- + */ + +SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_cuSolverSp_batchQR(N_Vector y, SUNMatrix A, + cusolverSpHandle_t cusol_handle); + + +/* + * ---------------------------------------------------------------------------- + * cuSolverSp implementations of SUNLinearSolver operations + * ---------------------------------------------------------------------------- + */ + +SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_cuSolverSp_batchQR(SUNLinearSolver S); + +SUNDIALS_EXPORT SUNLinearSolver_ID SUNLinSolGetID_cuSolverSp_batchQR(SUNLinearSolver S); + +SUNDIALS_EXPORT int SUNLinSolInitialize_cuSolverSp_batchQR(SUNLinearSolver S); + +SUNDIALS_EXPORT int SUNLinSolSetup_cuSolverSp_batchQR(SUNLinearSolver S, + SUNMatrix A); + +SUNDIALS_EXPORT int SUNLinSolSolve_cuSolverSp_batchQR(SUNLinearSolver S, + SUNMatrix A, + N_Vector x, + N_Vector b, + realtype tol); + +SUNDIALS_EXPORT sunindextype SUNLinSolLastFlag_cuSolverSp_batchQR(SUNLinearSolver S); + +SUNDIALS_EXPORT int SUNLinSolFree_cuSolverSp_batchQR(SUNLinearSolver S); + + +/* + * ---------------------------------------------------------------------------- + * Additional get and set functions. + * ---------------------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void SUNLinSol_cuSolverSp_batchQR_GetDescription(SUNLinearSolver S, + char** desc); + +SUNDIALS_EXPORT void SUNLinSol_cuSolverSp_batchQR_SetDescription(SUNLinearSolver S, + const char* desc); + +SUNDIALS_EXPORT void SUNLinSol_cuSolverSp_batchQR_GetDeviceSpace(SUNLinearSolver S, + size_t* cuSolverInternal, + size_t* cuSolverWorkspace); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_dense.h b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_dense.h new file mode 100644 index 000000000..ed8563de7 --- /dev/null +++ b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_dense.h @@ -0,0 +1,80 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds, Ashley Crawford @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the dense implementation of the + * SUNLINSOL module, SUNLINSOL_DENSE. + * + * Notes: + * - The definition of the generic SUNLinearSolver structure can + * be found in the header file sundials_linearsolver.h. + * - The definition of the type 'realtype' can be found in the + * 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' and 'indextype'. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNLINSOL_DENSE_H +#define _SUNLINSOL_DENSE_H + +#include +#include +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* ---------------------------------------- + * Dense Implementation of SUNLinearSolver + * ---------------------------------------- */ + +struct _SUNLinearSolverContent_Dense { + sunindextype N; + sunindextype *pivots; + sunindextype last_flag; +}; + +typedef struct _SUNLinearSolverContent_Dense *SUNLinearSolverContent_Dense; + +/* ---------------------------------------- + * Exported Functions for SUNLINSOL_DENSE + * ---------------------------------------- */ + +SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_Dense(N_Vector y, SUNMatrix A); + +/* deprecated */ +SUNDIALS_EXPORT SUNLinearSolver SUNDenseLinearSolver(N_Vector y, + SUNMatrix A); + +SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_Dense(SUNLinearSolver S); +SUNDIALS_EXPORT SUNLinearSolver_ID SUNLinSolGetID_Dense(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolInitialize_Dense(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSetup_Dense(SUNLinearSolver S, SUNMatrix A); +SUNDIALS_EXPORT int SUNLinSolSolve_Dense(SUNLinearSolver S, SUNMatrix A, + N_Vector x, N_Vector b, realtype tol); +SUNDIALS_EXPORT sunindextype SUNLinSolLastFlag_Dense(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSpace_Dense(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS); +SUNDIALS_EXPORT int SUNLinSolFree_Dense(SUNLinearSolver S); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_lapackband.h b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_lapackband.h new file mode 100644 index 000000000..ed353e262 --- /dev/null +++ b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_lapackband.h @@ -0,0 +1,87 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the LAPACK band implementation of the + * SUNLINSOL module, SUNLINSOL_LAPACKBAND. + * + * Note: + * - The definition of the generic SUNLinearSolver structure can + * be found in the header file sundials_linearsolver.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNLINSOL_LAPBAND_H +#define _SUNLINSOL_LAPBAND_H + +#include +#include +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* Interfaces to match 'realtype' with the correct LAPACK functions */ +#if defined(SUNDIALS_DOUBLE_PRECISION) +#define xgbtrf_f77 dgbtrf_f77 +#define xgbtrs_f77 dgbtrs_f77 +#elif defined(SUNDIALS_SINGLE_PRECISION) +#define xgbtrf_f77 sgbtrf_f77 +#define xgbtrs_f77 sgbtrs_f77 +#else +#error Incompatible realtype for LAPACK; disable LAPACK and rebuild +#endif + +/* ---------------------------------------------- + * LAPACK band implementation of SUNLinearSolver + * ---------------------------------------------- */ + +struct _SUNLinearSolverContent_LapackBand { + sunindextype N; + sunindextype *pivots; + sunindextype last_flag; +}; + +typedef struct _SUNLinearSolverContent_LapackBand *SUNLinearSolverContent_LapackBand; + + +/* -------------------------------------------- + * Exported Functions for SUNLINSOL_LAPACKBAND + * -------------------------------------------- */ + +SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_LapackBand(N_Vector y, + SUNMatrix A); + +/* deprecated */ +SUNDIALS_EXPORT SUNLinearSolver SUNLapackBand(N_Vector y, SUNMatrix A); + +SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_LapackBand(SUNLinearSolver S); +SUNDIALS_EXPORT SUNLinearSolver_ID SUNLinSolGetID_LapackBand(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolInitialize_LapackBand(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSetup_LapackBand(SUNLinearSolver S, SUNMatrix A); +SUNDIALS_EXPORT int SUNLinSolSolve_LapackBand(SUNLinearSolver S, SUNMatrix A, + N_Vector x, N_Vector b, realtype tol); +SUNDIALS_EXPORT sunindextype SUNLinSolLastFlag_LapackBand(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSpace_LapackBand(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS); +SUNDIALS_EXPORT int SUNLinSolFree_LapackBand(SUNLinearSolver S); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_lapackdense.h b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_lapackdense.h new file mode 100644 index 000000000..a2dbe6f52 --- /dev/null +++ b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_lapackdense.h @@ -0,0 +1,87 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the LAPACK dense implementation of the + * SUNLINSOL module, SUNLINSOL_LINPACKDENSE. + * + * Note: + * - The definition of the generic SUNLinearSolver structure can + * be found in the header file sundials_linearsolver.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNLINSOL_LAPDENSE_H +#define _SUNLINSOL_LAPDENSE_H + +#include +#include +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* Interfaces to match 'realtype' with the correct LAPACK functions */ +#if defined(SUNDIALS_DOUBLE_PRECISION) +#define xgetrf_f77 dgetrf_f77 +#define xgetrs_f77 dgetrs_f77 +#elif defined(SUNDIALS_SINGLE_PRECISION) +#define xgetrf_f77 sgetrf_f77 +#define xgetrs_f77 sgetrs_f77 +#else +#error Incompatible realtype for LAPACK; disable LAPACK and rebuild +#endif + +/* ----------------------------------------------- + * LAPACK dense implementation of SUNLinearSolver + * ----------------------------------------------- */ + +struct _SUNLinearSolverContent_LapackDense { + sunindextype N; + sunindextype *pivots; + sunindextype last_flag; +}; + +typedef struct _SUNLinearSolverContent_LapackDense *SUNLinearSolverContent_LapackDense; + + +/* --------------------------------------------- + * Exported Functions for SUNLINSOL_LAPACKDENSE + * --------------------------------------------- */ + +SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_LapackDense(N_Vector y, + SUNMatrix A); + +/* deprecated */ +SUNDIALS_EXPORT SUNLinearSolver SUNLapackDense(N_Vector y, SUNMatrix A); + +SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_LapackDense(SUNLinearSolver S); +SUNDIALS_EXPORT SUNLinearSolver_ID SUNLinSolGetID_LapackDense(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolInitialize_LapackDense(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSetup_LapackDense(SUNLinearSolver S, SUNMatrix A); +SUNDIALS_EXPORT int SUNLinSolSolve_LapackDense(SUNLinearSolver S, SUNMatrix A, + N_Vector x, N_Vector b, realtype tol); +SUNDIALS_EXPORT sunindextype SUNLinSolLastFlag_LapackDense(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSpace_LapackDense(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS); +SUNDIALS_EXPORT int SUNLinSolFree_LapackDense(SUNLinearSolver S); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_pcg.h b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_pcg.h new file mode 100644 index 000000000..9476d555f --- /dev/null +++ b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_pcg.h @@ -0,0 +1,113 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds, Ashley Crawford @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the PCG implementation of the + * SUNLINSOL module, SUNLINSOL_PCG. The PCG algorithm is based + * on the Preconditioned Conjugate Gradient. + * + * Note: + * - The definition of the generic SUNLinearSolver structure can + * be found in the header file sundials_linearsolver.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNLINSOL_PCG_H +#define _SUNLINSOL_PCG_H + +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* Default PCG solver parameters */ +#define SUNPCG_MAXL_DEFAULT 5 + +/* -------------------------------------- + * PCG Implementation of SUNLinearSolver + * -------------------------------------- */ + +struct _SUNLinearSolverContent_PCG { + int maxl; + int pretype; + int numiters; + realtype resnorm; + int last_flag; + + ATimesFn ATimes; + void* ATData; + PSetupFn Psetup; + PSolveFn Psolve; + void* PData; + + N_Vector s; + N_Vector r; + N_Vector p; + N_Vector z; + N_Vector Ap; +}; + +typedef struct _SUNLinearSolverContent_PCG *SUNLinearSolverContent_PCG; + + +/* ------------------------------------- + * Exported Functions for SUNLINSOL_PCG + * ------------------------------------- */ + +SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_PCG(N_Vector y, + int pretype, + int maxl); +SUNDIALS_EXPORT int SUNLinSol_PCGSetPrecType(SUNLinearSolver S, + int pretype); +SUNDIALS_EXPORT int SUNLinSol_PCGSetMaxl(SUNLinearSolver S, + int maxl); + +/* deprecated */ +SUNDIALS_EXPORT SUNLinearSolver SUNPCG(N_Vector y, int pretype, int maxl); +/* deprecated */ +SUNDIALS_EXPORT int SUNPCGSetPrecType(SUNLinearSolver S, int pretype); +/* deprecated */ +SUNDIALS_EXPORT int SUNPCGSetMaxl(SUNLinearSolver S, int maxl); + +SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_PCG(SUNLinearSolver S); +SUNDIALS_EXPORT SUNLinearSolver_ID SUNLinSolGetID_PCG(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolInitialize_PCG(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSetATimes_PCG(SUNLinearSolver S, void* A_data, + ATimesFn ATimes); +SUNDIALS_EXPORT int SUNLinSolSetPreconditioner_PCG(SUNLinearSolver S, + void* P_data, + PSetupFn Pset, + PSolveFn Psol); +SUNDIALS_EXPORT int SUNLinSolSetScalingVectors_PCG(SUNLinearSolver S, + N_Vector s, + N_Vector nul); +SUNDIALS_EXPORT int SUNLinSolSetup_PCG(SUNLinearSolver S, SUNMatrix nul); +SUNDIALS_EXPORT int SUNLinSolSolve_PCG(SUNLinearSolver S, SUNMatrix nul, + N_Vector x, N_Vector b, realtype tol); +SUNDIALS_EXPORT int SUNLinSolNumIters_PCG(SUNLinearSolver S); +SUNDIALS_EXPORT realtype SUNLinSolResNorm_PCG(SUNLinearSolver S); +SUNDIALS_EXPORT N_Vector SUNLinSolResid_PCG(SUNLinearSolver S); +SUNDIALS_EXPORT sunindextype SUNLinSolLastFlag_PCG(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSpace_PCG(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS); +SUNDIALS_EXPORT int SUNLinSolFree_PCG(SUNLinearSolver S); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_spbcgs.h b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_spbcgs.h new file mode 100644 index 000000000..738f6b3a8 --- /dev/null +++ b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_spbcgs.h @@ -0,0 +1,120 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * Based on code sundials_spbcgs.h by: Peter Brown and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the SPBCGS implementation of the + * SUNLINSOL module, SUNLINSOL_SPBCGS. The SPBCGS algorithm is based + * on the Scaled Preconditioned Bi-CG-Stabilized method. + * + * Note: + * - The definition of the generic SUNLinearSolver structure can + * be found in the header file sundials_linearsolver.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNLINSOL_SPBCGS_H +#define _SUNLINSOL_SPBCGS_H + +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* Default SPBCGS solver parameters */ +#define SUNSPBCGS_MAXL_DEFAULT 5 + +/* ----------------------------------------- + * SPBCGS Implementation of SUNLinearSolver + * ---------------------------------------- */ + +struct _SUNLinearSolverContent_SPBCGS { + int maxl; + int pretype; + int numiters; + realtype resnorm; + int last_flag; + + ATimesFn ATimes; + void* ATData; + PSetupFn Psetup; + PSolveFn Psolve; + void* PData; + + N_Vector s1; + N_Vector s2; + N_Vector r; + N_Vector r_star; + N_Vector p; + N_Vector q; + N_Vector u; + N_Vector Ap; + N_Vector vtemp; +}; + +typedef struct _SUNLinearSolverContent_SPBCGS *SUNLinearSolverContent_SPBCGS; + + +/* --------------------------------------- + *Exported Functions for SUNLINSOL_SPBCGS + * --------------------------------------- */ + +SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_SPBCGS(N_Vector y, + int pretype, + int maxl); +SUNDIALS_EXPORT int SUNLinSol_SPBCGSSetPrecType(SUNLinearSolver S, + int pretype); +SUNDIALS_EXPORT int SUNLinSol_SPBCGSSetMaxl(SUNLinearSolver S, + int maxl); + +/* deprecated */ +SUNDIALS_EXPORT SUNLinearSolver SUNSPBCGS(N_Vector y, int pretype, int maxl); +/* deprecated */ +SUNDIALS_EXPORT int SUNSPBCGSSetPrecType(SUNLinearSolver S, int pretype); +/* deprecated */ +SUNDIALS_EXPORT int SUNSPBCGSSetMaxl(SUNLinearSolver S, int maxl); + +SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_SPBCGS(SUNLinearSolver S); +SUNDIALS_EXPORT SUNLinearSolver_ID SUNLinSolGetID_SPBCGS(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolInitialize_SPBCGS(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSetATimes_SPBCGS(SUNLinearSolver S, void* A_data, + ATimesFn ATimes); +SUNDIALS_EXPORT int SUNLinSolSetPreconditioner_SPBCGS(SUNLinearSolver S, + void* P_data, + PSetupFn Pset, + PSolveFn Psol); +SUNDIALS_EXPORT int SUNLinSolSetScalingVectors_SPBCGS(SUNLinearSolver S, + N_Vector s1, + N_Vector s2); +SUNDIALS_EXPORT int SUNLinSolSetup_SPBCGS(SUNLinearSolver S, SUNMatrix A); +SUNDIALS_EXPORT int SUNLinSolSolve_SPBCGS(SUNLinearSolver S, SUNMatrix A, + N_Vector x, N_Vector b, realtype tol); +SUNDIALS_EXPORT int SUNLinSolNumIters_SPBCGS(SUNLinearSolver S); +SUNDIALS_EXPORT realtype SUNLinSolResNorm_SPBCGS(SUNLinearSolver S); +SUNDIALS_EXPORT N_Vector SUNLinSolResid_SPBCGS(SUNLinearSolver S); +SUNDIALS_EXPORT sunindextype SUNLinSolLastFlag_SPBCGS(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSpace_SPBCGS(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS); +SUNDIALS_EXPORT int SUNLinSolFree_SPBCGS(SUNLinearSolver S); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_spfgmr.h b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_spfgmr.h new file mode 100644 index 000000000..1fcc8caab --- /dev/null +++ b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_spfgmr.h @@ -0,0 +1,132 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * Based on code sundials_spfgmr.h by: Daniel R. Reynolds and + * Hilari C. Tiedeman @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the SPFGMR implementation of the + * SUNLINSOL module, SUNLINSOL_SPFGMR. The SPFGMR algorithm is based + * on the Scaled Preconditioned FGMRES (Flexible Generalized Minimal + * Residual) method [Y. Saad, SIAM J. Sci. Comput., 1993]. + * + * Note: + * - The definition of the generic SUNLinearSolver structure can + * be found in the header file sundials_linearsolver.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNLINSOL_SPFGMR_H +#define _SUNLINSOL_SPFGMR_H + +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* Default SPFGMR solver parameters */ +#define SUNSPFGMR_MAXL_DEFAULT 5 +#define SUNSPFGMR_MAXRS_DEFAULT 0 +#define SUNSPFGMR_GSTYPE_DEFAULT MODIFIED_GS + +/* ----------------------------------------- + * SPFGMR Implementation of SUNLinearSolver + * ----------------------------------------- */ + +struct _SUNLinearSolverContent_SPFGMR { + int maxl; + int pretype; + int gstype; + int max_restarts; + int numiters; + realtype resnorm; + int last_flag; + + ATimesFn ATimes; + void* ATData; + PSetupFn Psetup; + PSolveFn Psolve; + void* PData; + + N_Vector s1; + N_Vector s2; + N_Vector *V; + N_Vector *Z; + realtype **Hes; + realtype *givens; + N_Vector xcor; + realtype *yg; + N_Vector vtemp; + + realtype *cv; + N_Vector *Xv; +}; + +typedef struct _SUNLinearSolverContent_SPFGMR *SUNLinearSolverContent_SPFGMR; + +/* ---------------------------------------- + * Exported Functions for SUNLINSOL_SPFGMR + * ---------------------------------------- */ + +SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_SPFGMR(N_Vector y, + int pretype, + int maxl); +SUNDIALS_EXPORT int SUNLinSol_SPFGMRSetPrecType(SUNLinearSolver S, + int pretype); +SUNDIALS_EXPORT int SUNLinSol_SPFGMRSetGSType(SUNLinearSolver S, + int gstype); +SUNDIALS_EXPORT int SUNLinSol_SPFGMRSetMaxRestarts(SUNLinearSolver S, + int maxrs); + +/* deprecated */ +SUNDIALS_EXPORT SUNLinearSolver SUNSPFGMR(N_Vector y, int pretype, int maxl); +/* deprecated */ +SUNDIALS_EXPORT int SUNSPFGMRSetPrecType(SUNLinearSolver S, int pretype); +/* deprecated */ +SUNDIALS_EXPORT int SUNSPFGMRSetGSType(SUNLinearSolver S, int gstype); +/* deprecated */ +SUNDIALS_EXPORT int SUNSPFGMRSetMaxRestarts(SUNLinearSolver S, int maxrs); + + +SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_SPFGMR(SUNLinearSolver S); +SUNDIALS_EXPORT SUNLinearSolver_ID SUNLinSolGetID_SPFGMR(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolInitialize_SPFGMR(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSetATimes_SPFGMR(SUNLinearSolver S, void* A_data, + ATimesFn ATimes); +SUNDIALS_EXPORT int SUNLinSolSetPreconditioner_SPFGMR(SUNLinearSolver S, + void* P_data, + PSetupFn Pset, + PSolveFn Psol); +SUNDIALS_EXPORT int SUNLinSolSetScalingVectors_SPFGMR(SUNLinearSolver S, + N_Vector s1, + N_Vector s2); +SUNDIALS_EXPORT int SUNLinSolSetup_SPFGMR(SUNLinearSolver S, SUNMatrix A); +SUNDIALS_EXPORT int SUNLinSolSolve_SPFGMR(SUNLinearSolver S, SUNMatrix A, + N_Vector x, N_Vector b, realtype tol); +SUNDIALS_EXPORT int SUNLinSolNumIters_SPFGMR(SUNLinearSolver S); +SUNDIALS_EXPORT realtype SUNLinSolResNorm_SPFGMR(SUNLinearSolver S); +SUNDIALS_EXPORT N_Vector SUNLinSolResid_SPFGMR(SUNLinearSolver S); +SUNDIALS_EXPORT sunindextype SUNLinSolLastFlag_SPFGMR(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSpace_SPFGMR(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS); +SUNDIALS_EXPORT int SUNLinSolFree_SPFGMR(SUNLinearSolver S); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_spgmr.h b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_spgmr.h new file mode 100644 index 000000000..6227c3ee6 --- /dev/null +++ b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_spgmr.h @@ -0,0 +1,131 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * Based on code sundials_spgmr.h by: Scott D. Cohen, + * Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the SPGMR implementation of the + * SUNLINSOL module, SUNLINSOL_SPGMR. The SPGMR algorithm is based + * on the Scaled Preconditioned GMRES (Generalized Minimal Residual) + * method. + * + * Note: + * - The definition of the generic SUNLinearSolver structure can + * be found in the header file sundials_linearsolver.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNLINSOL_SPGMR_H +#define _SUNLINSOL_SPGMR_H + +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* Default SPGMR solver parameters */ +#define SUNSPGMR_MAXL_DEFAULT 5 +#define SUNSPGMR_MAXRS_DEFAULT 0 +#define SUNSPGMR_GSTYPE_DEFAULT MODIFIED_GS + +/* ---------------------------------------- + * SPGMR Implementation of SUNLinearSolver + * ---------------------------------------- */ + +struct _SUNLinearSolverContent_SPGMR { + int maxl; + int pretype; + int gstype; + int max_restarts; + int numiters; + realtype resnorm; + int last_flag; + + ATimesFn ATimes; + void* ATData; + PSetupFn Psetup; + PSolveFn Psolve; + void* PData; + + N_Vector s1; + N_Vector s2; + N_Vector *V; + realtype **Hes; + realtype *givens; + N_Vector xcor; + realtype *yg; + N_Vector vtemp; + + realtype *cv; + N_Vector *Xv; +}; + +typedef struct _SUNLinearSolverContent_SPGMR *SUNLinearSolverContent_SPGMR; + + +/* --------------------------------------- + * Exported Functions for SUNLINSOL_SPGMR + * --------------------------------------- */ + +SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_SPGMR(N_Vector y, + int pretype, + int maxl); +SUNDIALS_EXPORT int SUNLinSol_SPGMRSetPrecType(SUNLinearSolver S, + int pretype); +SUNDIALS_EXPORT int SUNLinSol_SPGMRSetGSType(SUNLinearSolver S, + int gstype); +SUNDIALS_EXPORT int SUNLinSol_SPGMRSetMaxRestarts(SUNLinearSolver S, + int maxrs); + +/* deprecated */ +SUNDIALS_EXPORT SUNLinearSolver SUNSPGMR(N_Vector y, int pretype, int maxl); +/* deprecated */ +SUNDIALS_EXPORT int SUNSPGMRSetPrecType(SUNLinearSolver S, int pretype); +/* deprecated */ +SUNDIALS_EXPORT int SUNSPGMRSetGSType(SUNLinearSolver S, int gstype); +/* deprecated */ +SUNDIALS_EXPORT int SUNSPGMRSetMaxRestarts(SUNLinearSolver S, int maxrs); + +SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_SPGMR(SUNLinearSolver S); +SUNDIALS_EXPORT SUNLinearSolver_ID SUNLinSolGetID_SPGMR(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolInitialize_SPGMR(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSetATimes_SPGMR(SUNLinearSolver S, void* A_data, + ATimesFn ATimes); +SUNDIALS_EXPORT int SUNLinSolSetPreconditioner_SPGMR(SUNLinearSolver S, + void* P_data, + PSetupFn Pset, + PSolveFn Psol); +SUNDIALS_EXPORT int SUNLinSolSetScalingVectors_SPGMR(SUNLinearSolver S, + N_Vector s1, + N_Vector s2); +SUNDIALS_EXPORT int SUNLinSolSetup_SPGMR(SUNLinearSolver S, SUNMatrix A); +SUNDIALS_EXPORT int SUNLinSolSolve_SPGMR(SUNLinearSolver S, SUNMatrix A, + N_Vector x, N_Vector b, realtype tol); +SUNDIALS_EXPORT int SUNLinSolNumIters_SPGMR(SUNLinearSolver S); +SUNDIALS_EXPORT realtype SUNLinSolResNorm_SPGMR(SUNLinearSolver S); +SUNDIALS_EXPORT N_Vector SUNLinSolResid_SPGMR(SUNLinearSolver S); +SUNDIALS_EXPORT sunindextype SUNLinSolLastFlag_SPGMR(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSpace_SPGMR(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS); +SUNDIALS_EXPORT int SUNLinSolFree_SPGMR(SUNLinearSolver S); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_sptfqmr.h b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_sptfqmr.h new file mode 100644 index 000000000..8cd72380f --- /dev/null +++ b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_sptfqmr.h @@ -0,0 +1,122 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * Based on code sundials_sptfqmr.h by: Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the SPTFQMR implementation of the + * SUNLINSOL module, SUNLINSOL_SPTFQMR. The SPTFQMR algorithm is + * based on the Scaled Preconditioned Transpose-free Quasi-Minimum + * Residual method. + * + * Note: + * - The definition of the generic SUNLinearSolver structure can + * be found in the header file sundials_linearsolver.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNLINSOL_SPTFQMR_H +#define _SUNLINSOL_SPTFQMR_H + +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* Default SPTFQMR solver parameters */ +#define SUNSPTFQMR_MAXL_DEFAULT 5 + +/* ------------------------------------------ + * SPTFQMR Implementation of SUNLinearSolver + * ------------------------------------------ */ + +struct _SUNLinearSolverContent_SPTFQMR { + int maxl; + int pretype; + int numiters; + realtype resnorm; + int last_flag; + + ATimesFn ATimes; + void* ATData; + PSetupFn Psetup; + PSolveFn Psolve; + void* PData; + + N_Vector s1; + N_Vector s2; + N_Vector r_star; + N_Vector q; + N_Vector d; + N_Vector v; + N_Vector p; + N_Vector *r; + N_Vector u; + N_Vector vtemp1; + N_Vector vtemp2; + N_Vector vtemp3; +}; + +typedef struct _SUNLinearSolverContent_SPTFQMR *SUNLinearSolverContent_SPTFQMR; + + /* ------------------------------------- + * Exported Functions SUNLINSOL_SPTFQMR + * -------------------------------------- */ + +SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_SPTFQMR(N_Vector y, + int pretype, + int maxl); +SUNDIALS_EXPORT int SUNLinSol_SPTFQMRSetPrecType(SUNLinearSolver S, + int pretype); +SUNDIALS_EXPORT int SUNLinSol_SPTFQMRSetMaxl(SUNLinearSolver S, + int maxl); + +/* deprecated */ +SUNDIALS_EXPORT SUNLinearSolver SUNSPTFQMR(N_Vector y, int pretype, int maxl); +/* deprecated */ +SUNDIALS_EXPORT int SUNSPTFQMRSetPrecType(SUNLinearSolver S, int pretype); +/* deprecated */ +SUNDIALS_EXPORT int SUNSPTFQMRSetMaxl(SUNLinearSolver S, int maxl); + +SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_SPTFQMR(SUNLinearSolver S); +SUNDIALS_EXPORT SUNLinearSolver_ID SUNLinSolGetID_SPTFQMR(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolInitialize_SPTFQMR(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSetATimes_SPTFQMR(SUNLinearSolver S, void* A_data, + ATimesFn ATimes); +SUNDIALS_EXPORT int SUNLinSolSetPreconditioner_SPTFQMR(SUNLinearSolver S, + void* P_data, + PSetupFn Pset, + PSolveFn Psol); +SUNDIALS_EXPORT int SUNLinSolSetScalingVectors_SPTFQMR(SUNLinearSolver S, + N_Vector s1, + N_Vector s2); +SUNDIALS_EXPORT int SUNLinSolSetup_SPTFQMR(SUNLinearSolver S, SUNMatrix A); +SUNDIALS_EXPORT int SUNLinSolSolve_SPTFQMR(SUNLinearSolver S, SUNMatrix A, + N_Vector x, N_Vector b, realtype tol); +SUNDIALS_EXPORT int SUNLinSolNumIters_SPTFQMR(SUNLinearSolver S); +SUNDIALS_EXPORT realtype SUNLinSolResNorm_SPTFQMR(SUNLinearSolver S); +SUNDIALS_EXPORT N_Vector SUNLinSolResid_SPTFQMR(SUNLinearSolver S); +SUNDIALS_EXPORT sunindextype SUNLinSolLastFlag_SPTFQMR(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSpace_SPTFQMR(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS); +SUNDIALS_EXPORT int SUNLinSolFree_SPTFQMR(SUNLinearSolver S); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_superludist.h b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_superludist.h new file mode 100644 index 000000000..3d4a768df --- /dev/null +++ b/bazaar/plugin/sundials/include/sunlinsol/sunlinsol_superludist.h @@ -0,0 +1,119 @@ +/* + * ---------------------------------------------------------------------------- + * Programmer(s): Cody J. Balos @ LLNL + * ---------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ---------------------------------------------------------------------------- + * This is the header file for the SuperLU-DIST implementation of the SUNLINSOL + * module. + * + * Part I contains declarations specific to the SuperLU-Dist implementation of + * the supplied SUNLINSOL module. + * + * Part II contains the prototype for the constructor SUNSuperLUDIST as well as + * implementation-specific prototypes for various useful solver operations. + * + * Notes: + * + * - The definition of the generic SUNLinearSolver structure can be found in + * the header file sundials_linearsolver.h. + * ---------------------------------------------------------------------------- + */ + +#ifndef _SUNLINSOL_SLUDIST_H +#define _SUNLINSOL_SLUDIST_H + +#include +#include +#include +#include +#include +#include + +#ifdef __cplusplus +extern "C" { +#endif + + +/* + * ---------------------------------------------------------------------------- + * PART I: SuperLU-DIST implementation of SUNLinearSolver + * ---------------------------------------------------------------------------- + */ + +struct _SUNLinearSolverContent_SuperLUDIST { + booleantype first_factorize; + int last_flag; + realtype berr; + gridinfo_t *grid; + LUstruct_t *lu; + superlu_dist_options_t *options; + ScalePermstruct_t *scaleperm; + SOLVEstruct_t *solve; + SuperLUStat_t *stat; + sunindextype N; +}; + +typedef struct _SUNLinearSolverContent_SuperLUDIST *SUNLinearSolverContent_SuperLUDIST; + + +/* + * ---------------------------------------------------------------------------- + * PART II: Functions exported by sunlinsol_sludist + * ---------------------------------------------------------------------------- + */ + +SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_SuperLUDIST(N_Vector y, SUNMatrix A, + gridinfo_t *grid, + LUstruct_t *lu, + ScalePermstruct_t *scaleperm, + SOLVEstruct_t *solve, + SuperLUStat_t *stat, + superlu_dist_options_t *options); + +/* + * ---------------------------------------------------------------------------- + * Accessor functions. + * ---------------------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype SUNLinSol_SuperLUDIST_GetBerr(SUNLinearSolver LS); +SUNDIALS_EXPORT gridinfo_t* SUNLinSol_SuperLUDIST_GetGridinfo(SUNLinearSolver LS); +SUNDIALS_EXPORT LUstruct_t* SUNLinSol_SuperLUDIST_GetLUstruct(SUNLinearSolver LS); +SUNDIALS_EXPORT superlu_dist_options_t* SUNLinSol_SuperLUDIST_GetSuperLUOptions(SUNLinearSolver LS); +SUNDIALS_EXPORT ScalePermstruct_t* SUNLinSol_SuperLUDIST_GetScalePermstruct(SUNLinearSolver LS); +SUNDIALS_EXPORT SOLVEstruct_t* SUNLinSol_SuperLUDIST_GetSOLVEstruct(SUNLinearSolver LS); +SUNDIALS_EXPORT SuperLUStat_t* SUNLinSol_SuperLUDIST_GetSuperLUStat(SUNLinearSolver LS); + +/* + * ---------------------------------------------------------------------------- + * SuperLU-DIST implementations of SUNLinearSolver operations + * ---------------------------------------------------------------------------- + */ + +SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_SuperLUDIST(SUNLinearSolver S); +SUNDIALS_EXPORT SUNLinearSolver_ID SUNLinSolGetID_SuperLUDIST(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolInitialize_SuperLUDIST(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSetup_SuperLUDIST(SUNLinearSolver S, SUNMatrix A); +SUNDIALS_EXPORT int SUNLinSolSolve_SuperLUDIST(SUNLinearSolver S, SUNMatrix A, + N_Vector x, N_Vector b, realtype tol); +SUNDIALS_EXPORT sunindextype SUNLinSolLastFlag_SuperLUDIST(SUNLinearSolver S); +SUNDIALS_EXPORT int SUNLinSolSpace_SuperLUDIST(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS); +SUNDIALS_EXPORT int SUNLinSolFree_SuperLUDIST(SUNLinearSolver S); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunmatrix/sunmatrix_band.h b/bazaar/plugin/sundials/include/sunmatrix/sunmatrix_band.h new file mode 100644 index 000000000..ffc4660ff --- /dev/null +++ b/bazaar/plugin/sundials/include/sunmatrix/sunmatrix_band.h @@ -0,0 +1,129 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * David Gardner @ LLNL + * Based on code sundials_direct.h by: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the band implementation of the + * SUNMATRIX module, SUNMATRIX_BAND. + * + * Notes: + * - The definition of the generic SUNMatrix structure can be found + * in the header file sundials_matrix.h. + * - The definition of the type 'realtype' can be found in the + * 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' and 'indextype'. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNMATRIX_BAND_H +#define _SUNMATRIX_BAND_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* --------------------------------- + * Band implementation of SUNMatrix + * --------------------------------- */ + +struct _SUNMatrixContent_Band { + sunindextype M; + sunindextype N; + sunindextype ldim; + sunindextype mu; + sunindextype ml; + sunindextype s_mu; + realtype *data; + sunindextype ldata; + realtype **cols; +}; + +typedef struct _SUNMatrixContent_Band *SUNMatrixContent_Band; + + +/* ------------------------------------ + * Macros for access to SUNMATRIX_BAND + * ------------------------------------ */ + +#define SM_CONTENT_B(A) ( (SUNMatrixContent_Band)(A->content) ) + +#define SM_ROWS_B(A) ( SM_CONTENT_B(A)->M ) + +#define SM_COLUMNS_B(A) ( SM_CONTENT_B(A)->N ) + +#define SM_LDATA_B(A) ( SM_CONTENT_B(A)->ldata ) + +#define SM_UBAND_B(A) ( SM_CONTENT_B(A)->mu ) + +#define SM_LBAND_B(A) ( SM_CONTENT_B(A)->ml ) + +#define SM_SUBAND_B(A) ( SM_CONTENT_B(A)->s_mu ) + +#define SM_LDIM_B(A) ( SM_CONTENT_B(A)->ldim ) + +#define SM_DATA_B(A) ( SM_CONTENT_B(A)->data ) + +#define SM_COLS_B(A) ( SM_CONTENT_B(A)->cols ) + +#define SM_COLUMN_B(A,j) ( ((SM_CONTENT_B(A)->cols)[j])+SM_SUBAND_B(A) ) + +#define SM_COLUMN_ELEMENT_B(col_j,i,j) (col_j[(i)-(j)]) + +#define SM_ELEMENT_B(A,i,j) ( (SM_CONTENT_B(A)->cols)[j][(i)-(j)+SM_SUBAND_B(A)] ) + + +/* ---------------------------------------- + * Exported Functions for SUNMATRIX_BAND + * ---------------------------------------- */ + +SUNDIALS_EXPORT SUNMatrix SUNBandMatrix(sunindextype N, sunindextype mu, + sunindextype ml); + +SUNDIALS_EXPORT SUNMatrix SUNBandMatrixStorage(sunindextype N, + sunindextype mu, + sunindextype ml, + sunindextype smu); + +SUNDIALS_EXPORT void SUNBandMatrix_Print(SUNMatrix A, FILE* outfile); + +SUNDIALS_EXPORT sunindextype SUNBandMatrix_Rows(SUNMatrix A); +SUNDIALS_EXPORT sunindextype SUNBandMatrix_Columns(SUNMatrix A); +SUNDIALS_EXPORT sunindextype SUNBandMatrix_LowerBandwidth(SUNMatrix A); +SUNDIALS_EXPORT sunindextype SUNBandMatrix_UpperBandwidth(SUNMatrix A); +SUNDIALS_EXPORT sunindextype SUNBandMatrix_StoredUpperBandwidth(SUNMatrix A); +SUNDIALS_EXPORT sunindextype SUNBandMatrix_LDim(SUNMatrix A); +SUNDIALS_EXPORT realtype* SUNBandMatrix_Data(SUNMatrix A); +SUNDIALS_EXPORT realtype** SUNBandMatrix_Cols(SUNMatrix A); +SUNDIALS_EXPORT realtype* SUNBandMatrix_Column(SUNMatrix A, sunindextype j); + +SUNDIALS_EXPORT SUNMatrix_ID SUNMatGetID_Band(SUNMatrix A); +SUNDIALS_EXPORT SUNMatrix SUNMatClone_Band(SUNMatrix A); +SUNDIALS_EXPORT void SUNMatDestroy_Band(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatZero_Band(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatCopy_Band(SUNMatrix A, SUNMatrix B); +SUNDIALS_EXPORT int SUNMatScaleAdd_Band(realtype c, SUNMatrix A, SUNMatrix B); +SUNDIALS_EXPORT int SUNMatScaleAddI_Band(realtype c, SUNMatrix A); +SUNDIALS_EXPORT int SUNMatMatvec_Band(SUNMatrix A, N_Vector x, N_Vector y); +SUNDIALS_EXPORT int SUNMatSpace_Band(SUNMatrix A, long int *lenrw, long int *leniw); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunmatrix/sunmatrix_cusparse.h b/bazaar/plugin/sundials/include/sunmatrix/sunmatrix_cusparse.h new file mode 100644 index 000000000..20cf5081d --- /dev/null +++ b/bazaar/plugin/sundials/include/sunmatrix/sunmatrix_cusparse.h @@ -0,0 +1,121 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Cody J. Balos @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file is for the cuSPARSE implementation of the + * SUNMATRIX module. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNMATRIX_CUSPARSE_H +#define _SUNMATRIX_CUSPARSE_H + +#include + +#include +#include + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* ------------------------------------------ + * Implementation of SUNMATRIX_CUSPARSE + * ------------------------------------------ */ + +/* storage formats */ +#define SUNMAT_CUSPARSE_CSR 0 +#define SUNMAT_CUSPARSE_BCSR 1 + +struct _SUNMatrix_Content_cuSparse { + int M; + int N; + int NNZ; + int nblocks; + int blockrows; + int blockcols; + int blocknnz; + int sparse_type; + booleantype own_data; + booleantype fixed_pattern; + int* colind; + int* rowptrs; + realtype* data; + cusparseMatDescr_t mat_descr; + cusparseHandle_t cusp_handle; +}; + +typedef struct _SUNMatrix_Content_cuSparse *SUNMatrix_Content_cuSparse; + + +/* ------------------------------------------------------------------ + * Constructors. + * ------------------------------------------------------------------ */ + +SUNDIALS_EXPORT SUNMatrix SUNMatrix_cuSparse_NewCSR(int M, int N, int NNZ, cusparseHandle_t cusp); +SUNDIALS_EXPORT SUNMatrix SUNMatrix_cuSparse_MakeCSR(cusparseMatDescr_t mat_descr, int M, int N, int NNZ, + int *rowptrs , int *colind , realtype *data, + cusparseHandle_t cusp); + +/* Creates a CSR block-diagonal matrix where each block shares the same sparsity structure. + Reduces memory usage by only storing the row pointers and column indices for one block. */ +SUNDIALS_EXPORT SUNMatrix SUNMatrix_cuSparse_NewBlockCSR(int nblocks, int blockrows, int blockcols, + int blocknnz, cusparseHandle_t cusp); + + +/* ------------------------------------------------------------------ + * Implementation specific routines. + * ------------------------------------------------------------------ */ + +SUNDIALS_EXPORT int SUNMatrix_cuSparse_SparseType(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatrix_cuSparse_Rows(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatrix_cuSparse_Columns(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatrix_cuSparse_NNZ(SUNMatrix A); +SUNDIALS_EXPORT int* SUNMatrix_cuSparse_IndexPointers(SUNMatrix A); +SUNDIALS_EXPORT int* SUNMatrix_cuSparse_IndexValues(SUNMatrix A); +SUNDIALS_EXPORT realtype* SUNMatrix_cuSparse_Data(SUNMatrix A); + +SUNDIALS_EXPORT int SUNMatrix_cuSparse_SetFixedPattern(SUNMatrix A, booleantype yesno); +SUNDIALS_EXPORT int SUNMatrix_cuSparse_NumBlocks(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatrix_cuSparse_BlockRows(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatrix_cuSparse_BlockColumns(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatrix_cuSparse_BlockNNZ(SUNMatrix A); +SUNDIALS_EXPORT realtype* SUNMatrix_cuSparse_BlockData(SUNMatrix A, int blockidx); +SUNDIALS_EXPORT cusparseMatDescr_t SUNMatrix_cuSparse_MatDescr(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatrix_cuSparse_CopyToDevice(SUNMatrix device, realtype* h_data, + int* h_idxptrs, int* h_idxvals); +SUNDIALS_EXPORT int SUNMatrix_cuSparse_CopyFromDevice(SUNMatrix device, realtype* h_data, + int* h_idxptrs, int* h_idxvals); + + +/* ------------------------------------------------------------------ + * SUNMatrix API routines. + * ------------------------------------------------------------------ */ + +SUNDIALS_EXPORT SUNMatrix_ID SUNMatGetID_cuSparse(SUNMatrix A); +SUNDIALS_EXPORT SUNMatrix SUNMatClone_cuSparse(SUNMatrix A); +SUNDIALS_EXPORT void SUNMatDestroy_cuSparse(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatZero_cuSparse(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatCopy_cuSparse(SUNMatrix A, SUNMatrix B); +SUNDIALS_EXPORT int SUNMatScaleAdd_cuSparse(realtype c, SUNMatrix A, SUNMatrix B); +SUNDIALS_EXPORT int SUNMatScaleAddI_cuSparse(realtype c, SUNMatrix A); +SUNDIALS_EXPORT int SUNMatMatvec_cuSparse(SUNMatrix A, N_Vector x, N_Vector y); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunmatrix/sunmatrix_dense.h b/bazaar/plugin/sundials/include/sunmatrix/sunmatrix_dense.h new file mode 100644 index 000000000..79c4e4e91 --- /dev/null +++ b/bazaar/plugin/sundials/include/sunmatrix/sunmatrix_dense.h @@ -0,0 +1,105 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * David Gardner @ LLNL + * Based on code sundials_direct.h by: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the dense implementation of the + * SUNMATRIX module, SUNMATRIX_DENSE. + * + * Notes: + * - The definition of the generic SUNMatrix structure can be found + * in the header file sundials_matrix.h. + * - The definition of the type 'realtype' can be found in the + * 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' and 'indextype'. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNMATRIX_DENSE_H +#define _SUNMATRIX_DENSE_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* ---------------------------------- + * Dense implementation of SUNMatrix + * ---------------------------------- */ + +struct _SUNMatrixContent_Dense { + sunindextype M; + sunindextype N; + realtype *data; + sunindextype ldata; + realtype **cols; +}; + +typedef struct _SUNMatrixContent_Dense *SUNMatrixContent_Dense; + +/* ------------------------------------ + * Macros for access to SUNMATRIX_DENSE + * ------------------------------------ */ + +#define SM_CONTENT_D(A) ( (SUNMatrixContent_Dense)(A->content) ) + +#define SM_ROWS_D(A) ( SM_CONTENT_D(A)->M ) + +#define SM_COLUMNS_D(A) ( SM_CONTENT_D(A)->N ) + +#define SM_LDATA_D(A) ( SM_CONTENT_D(A)->ldata ) + +#define SM_DATA_D(A) ( SM_CONTENT_D(A)->data ) + +#define SM_COLS_D(A) ( SM_CONTENT_D(A)->cols ) + +#define SM_COLUMN_D(A,j) ( (SM_CONTENT_D(A)->cols)[j] ) + +#define SM_ELEMENT_D(A,i,j) ( (SM_CONTENT_D(A)->cols)[j][i] ) + +/* --------------------------------------- + * Exported Functions for SUNMATRIX_DENSE + * --------------------------------------- */ + +SUNDIALS_EXPORT SUNMatrix SUNDenseMatrix(sunindextype M, sunindextype N); + +SUNDIALS_EXPORT void SUNDenseMatrix_Print(SUNMatrix A, FILE* outfile); + +SUNDIALS_EXPORT sunindextype SUNDenseMatrix_Rows(SUNMatrix A); +SUNDIALS_EXPORT sunindextype SUNDenseMatrix_Columns(SUNMatrix A); +SUNDIALS_EXPORT sunindextype SUNDenseMatrix_LData(SUNMatrix A); +SUNDIALS_EXPORT realtype* SUNDenseMatrix_Data(SUNMatrix A); +SUNDIALS_EXPORT realtype** SUNDenseMatrix_Cols(SUNMatrix A); +SUNDIALS_EXPORT realtype* SUNDenseMatrix_Column(SUNMatrix A, sunindextype j); + +SUNDIALS_EXPORT SUNMatrix_ID SUNMatGetID_Dense(SUNMatrix A); +SUNDIALS_EXPORT SUNMatrix SUNMatClone_Dense(SUNMatrix A); +SUNDIALS_EXPORT void SUNMatDestroy_Dense(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatZero_Dense(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatCopy_Dense(SUNMatrix A, SUNMatrix B); +SUNDIALS_EXPORT int SUNMatScaleAdd_Dense(realtype c, SUNMatrix A, SUNMatrix B); +SUNDIALS_EXPORT int SUNMatScaleAddI_Dense(realtype c, SUNMatrix A); +SUNDIALS_EXPORT int SUNMatMatvec_Dense(SUNMatrix A, N_Vector x, N_Vector y); +SUNDIALS_EXPORT int SUNMatSpace_Dense(SUNMatrix A, long int *lenrw, long int *leniw); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunmatrix/sunmatrix_sparse.h b/bazaar/plugin/sundials/include/sunmatrix/sunmatrix_sparse.h new file mode 100644 index 000000000..b42af27f5 --- /dev/null +++ b/bazaar/plugin/sundials/include/sunmatrix/sunmatrix_sparse.h @@ -0,0 +1,146 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * David Gardner @ LLNL + * Based on code sundials_sparse.h by: Carol Woodward and + * Slaven Peles @ LLNL, and Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the sparse implementation of the + * SUNMATRIX module, SUNMATRIX_SPARSE. + * + * Notes: + * - The definition of the generic SUNMatrix structure can be found + * in the header file sundials_matrix.h. + * - The definition of the type 'realtype' can be found in the + * 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' and 'indextype'. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNMATRIX_SPARSE_H +#define _SUNMATRIX_SPARSE_H + +#include +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* ------------------------ + * Matrix Type Definitions + * ------------------------ */ + +#define CSC_MAT 0 +#define CSR_MAT 1 + + +/* ------------------------------------------ + * Sparse Implementation of SUNMATRIX_SPARSE + * ------------------------------------------ */ + +struct _SUNMatrixContent_Sparse { + sunindextype M; + sunindextype N; + sunindextype NNZ; + sunindextype NP; + realtype *data; + int sparsetype; + sunindextype *indexvals; + sunindextype *indexptrs; + /* CSC indices */ + sunindextype **rowvals; + sunindextype **colptrs; + /* CSR indices */ + sunindextype **colvals; + sunindextype **rowptrs; +}; + +typedef struct _SUNMatrixContent_Sparse *SUNMatrixContent_Sparse; + + +/* --------------------------------------- + * Macros for access to SUNMATRIX_SPARSE + * --------------------------------------- */ + +#define SM_CONTENT_S(A) ( (SUNMatrixContent_Sparse)(A->content) ) + +#define SM_ROWS_S(A) ( SM_CONTENT_S(A)->M ) + +#define SM_COLUMNS_S(A) ( SM_CONTENT_S(A)->N ) + +#define SM_NNZ_S(A) ( SM_CONTENT_S(A)->NNZ ) + +#define SM_NP_S(A) ( SM_CONTENT_S(A)->NP ) + +#define SM_SPARSETYPE_S(A) ( SM_CONTENT_S(A)->sparsetype ) + +#define SM_DATA_S(A) ( SM_CONTENT_S(A)->data ) + +#define SM_INDEXVALS_S(A) ( SM_CONTENT_S(A)->indexvals ) + +#define SM_INDEXPTRS_S(A) ( SM_CONTENT_S(A)->indexptrs ) + +/* ---------------------------------------- + * Exported Functions for SUNMATRIX_SPARSE + * ---------------------------------------- */ + +SUNDIALS_EXPORT SUNMatrix SUNSparseMatrix(sunindextype M, sunindextype N, + sunindextype NNZ, int sparsetype); + +SUNDIALS_EXPORT SUNMatrix SUNSparseFromDenseMatrix(SUNMatrix A, + realtype droptol, + int sparsetype); + +SUNDIALS_EXPORT SUNMatrix SUNSparseFromBandMatrix(SUNMatrix A, + realtype droptol, + int sparsetype); + +SUNDIALS_EXPORT int SUNSparseMatrix_ToCSR(const SUNMatrix A, SUNMatrix* Bout); +SUNDIALS_EXPORT int SUNSparseMatrix_ToCSC(const SUNMatrix A, SUNMatrix* Bout); + +SUNDIALS_EXPORT int SUNSparseMatrix_Realloc(SUNMatrix A); + +SUNDIALS_EXPORT int SUNSparseMatrix_Reallocate(SUNMatrix A, sunindextype NNZ); + +SUNDIALS_EXPORT void SUNSparseMatrix_Print(SUNMatrix A, FILE* outfile); + +SUNDIALS_EXPORT sunindextype SUNSparseMatrix_Rows(SUNMatrix A); +SUNDIALS_EXPORT sunindextype SUNSparseMatrix_Columns(SUNMatrix A); +SUNDIALS_EXPORT sunindextype SUNSparseMatrix_NNZ(SUNMatrix A); +SUNDIALS_EXPORT sunindextype SUNSparseMatrix_NP(SUNMatrix A); +SUNDIALS_EXPORT int SUNSparseMatrix_SparseType(SUNMatrix A); +SUNDIALS_EXPORT realtype* SUNSparseMatrix_Data(SUNMatrix A); +SUNDIALS_EXPORT sunindextype* SUNSparseMatrix_IndexValues(SUNMatrix A); +SUNDIALS_EXPORT sunindextype* SUNSparseMatrix_IndexPointers(SUNMatrix A); + +SUNDIALS_EXPORT SUNMatrix_ID SUNMatGetID_Sparse(SUNMatrix A); +SUNDIALS_EXPORT SUNMatrix SUNMatClone_Sparse(SUNMatrix A); +SUNDIALS_EXPORT void SUNMatDestroy_Sparse(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatZero_Sparse(SUNMatrix A); +SUNDIALS_EXPORT int SUNMatCopy_Sparse(SUNMatrix A, SUNMatrix B); +SUNDIALS_EXPORT int SUNMatScaleAdd_Sparse(realtype c, SUNMatrix A, SUNMatrix B); +SUNDIALS_EXPORT int SUNMatScaleAddI_Sparse(realtype c, SUNMatrix A); +SUNDIALS_EXPORT int SUNMatMatvec_Sparse(SUNMatrix A, N_Vector x, N_Vector y); +SUNDIALS_EXPORT int SUNMatSpace_Sparse(SUNMatrix A, long int *lenrw, long int *leniw); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunnonlinsol/sunnonlinsol_fixedpoint.h b/bazaar/plugin/sundials/include/sunnonlinsol/sunnonlinsol_fixedpoint.h new file mode 100644 index 000000000..046f2939a --- /dev/null +++ b/bazaar/plugin/sundials/include/sunnonlinsol/sunnonlinsol_fixedpoint.h @@ -0,0 +1,120 @@ +/*----------------------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *----------------------------------------------------------------------------- + * This is the header file for the SUNNonlinearSolver module implementation of + * the Anderson-accelerated fixed-point method. + * + * Part I defines the solver-specific content structure. + * + * Part II contains prototypes for the solver constructor and operations. + *---------------------------------------------------------------------------*/ + +#ifndef _SUNNONLINSOL_FIXEDPOINT_H +#define _SUNNONLINSOL_FIXEDPOINT_H + +#include "sundials/sundials_types.h" +#include "sundials/sundials_nvector.h" +#include "sundials/sundials_nonlinearsolver.h" + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/*----------------------------------------------------------------------------- + I. Content structure + ---------------------------------------------------------------------------*/ + +struct _SUNNonlinearSolverContent_FixedPoint { + + /* functions provided by the integrator */ + SUNNonlinSolSysFn Sys; /* fixed-point iteration function */ + SUNNonlinSolConvTestFn CTest; /* convergence test function */ + + /* nonlinear solver variables */ + int m; /* number of acceleration vectors to use */ + int *imap; /* array of length m */ + booleantype damping; /* flag to apply dampling in acceleration */ + realtype beta; /* damping paramter */ + realtype *R; /* array of length m*m */ + realtype *gamma; /* array of length m */ + realtype *cvals; /* array of length m+1 for fused vector op */ + N_Vector *df; /* vector array of length m */ + N_Vector *dg; /* vector array of length m */ + N_Vector *q; /* vector array of length m */ + N_Vector *Xvecs; /* array of length m+1 for fused vector op */ + N_Vector yprev; /* temporary vectors for performing solve */ + N_Vector gy; + N_Vector fold; + N_Vector gold; + N_Vector delta; /* correction vector (change between 2 iterates) */ + int curiter; /* current iteration number in a solve attempt */ + int maxiters; /* maximum number of iterations per solve attempt */ + long int niters; /* total number of iterations across all solves */ + long int nconvfails; /* total number of convergence failures */ + void *ctest_data; /* data to pass to convergence test function */ +}; + +typedef struct _SUNNonlinearSolverContent_FixedPoint *SUNNonlinearSolverContent_FixedPoint; + +/* ----------------------------------------------------------------------------- + II: Exported functions + ---------------------------------------------------------------------------*/ + +/* Constructor to create solver and allocates memory */ +SUNDIALS_EXPORT SUNNonlinearSolver SUNNonlinSol_FixedPoint(N_Vector y, int m); +SUNDIALS_EXPORT SUNNonlinearSolver SUNNonlinSol_FixedPointSens(int count, N_Vector y, int m); + +/* core functions */ +SUNDIALS_EXPORT SUNNonlinearSolver_Type SUNNonlinSolGetType_FixedPoint(SUNNonlinearSolver NLS); + +SUNDIALS_EXPORT int SUNNonlinSolInitialize_FixedPoint(SUNNonlinearSolver NLS); + +SUNDIALS_EXPORT int SUNNonlinSolSolve_FixedPoint(SUNNonlinearSolver NLS, + N_Vector y0, N_Vector y, + N_Vector w, realtype tol, + booleantype callSetup, void *mem); + +SUNDIALS_EXPORT int SUNNonlinSolFree_FixedPoint(SUNNonlinearSolver NLS); + +/* set functions */ +SUNDIALS_EXPORT int SUNNonlinSolSetSysFn_FixedPoint(SUNNonlinearSolver NLS, + SUNNonlinSolSysFn SysFn); + +SUNDIALS_EXPORT int SUNNonlinSolSetConvTestFn_FixedPoint(SUNNonlinearSolver NLS, + SUNNonlinSolConvTestFn CTestFn, + void* ctest_data); + +SUNDIALS_EXPORT int SUNNonlinSolSetMaxIters_FixedPoint(SUNNonlinearSolver NLS, + int maxiters); + +SUNDIALS_EXPORT int SUNNonlinSolSetDamping_FixedPoint(SUNNonlinearSolver NLS, + realtype beta); + +/* get functions */ +SUNDIALS_EXPORT int SUNNonlinSolGetNumIters_FixedPoint(SUNNonlinearSolver NLS, + long int *niters); + +SUNDIALS_EXPORT int SUNNonlinSolGetCurIter_FixedPoint(SUNNonlinearSolver NLS, + int *iter); + +SUNDIALS_EXPORT int SUNNonlinSolGetNumConvFails_FixedPoint(SUNNonlinearSolver NLS, + long int *nconvfails); + +SUNDIALS_EXPORT int SUNNonlinSolGetSysFn_FixedPoint(SUNNonlinearSolver NLS, + SUNNonlinSolSysFn *SysFn); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunnonlinsol/sunnonlinsol_newton.h b/bazaar/plugin/sundials/include/sunnonlinsol/sunnonlinsol_newton.h new file mode 100644 index 000000000..f1e54bb67 --- /dev/null +++ b/bazaar/plugin/sundials/include/sunnonlinsol/sunnonlinsol_newton.h @@ -0,0 +1,111 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------------------- + * This is the header file for the SUNNonlinearSolver module implementation of + * Newton's method. + * + * Part I defines the solver-specific content structure. + * + * Part II contains prototypes for the solver constructor and operations. + * ---------------------------------------------------------------------------*/ + +#ifndef _SUNNONLINSOL_NEWTON_H +#define _SUNNONLINSOL_NEWTON_H + +#include "sundials/sundials_types.h" +#include "sundials/sundials_nvector.h" +#include "sundials/sundials_nonlinearsolver.h" + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* ----------------------------------------------------------------------------- + * I. Content structure + * ---------------------------------------------------------------------------*/ + +struct _SUNNonlinearSolverContent_Newton { + + /* functions provided by the integrator */ + SUNNonlinSolSysFn Sys; /* nonlinear system residual function */ + SUNNonlinSolLSetupFn LSetup; /* linear solver setup function */ + SUNNonlinSolLSolveFn LSolve; /* linear solver solve function */ + SUNNonlinSolConvTestFn CTest; /* nonlinear solver convergence test function */ + + /* nonlinear solver variables */ + N_Vector delta; /* Newton update vector */ + booleantype jcur; /* Jacobian status, current = SUNTRUE / stale = SUNFALSE */ + int curiter; /* current number of iterations in a solve attempt */ + int maxiters; /* maximum number of iterations in a solve attempt */ + long int niters; /* total number of nonlinear iterations across all solves */ + long int nconvfails; /* total number of convergence failures across all solves */ + void* ctest_data; /* data to pass to convergence test function */ +}; + +typedef struct _SUNNonlinearSolverContent_Newton *SUNNonlinearSolverContent_Newton; + +/* ----------------------------------------------------------------------------- + * II: Exported functions + * ---------------------------------------------------------------------------*/ + +/* Constructor to create solver and allocates memory */ +SUNDIALS_EXPORT SUNNonlinearSolver SUNNonlinSol_Newton(N_Vector y); +SUNDIALS_EXPORT SUNNonlinearSolver SUNNonlinSol_NewtonSens(int count, N_Vector y); + +/* core functions */ +SUNDIALS_EXPORT SUNNonlinearSolver_Type SUNNonlinSolGetType_Newton(SUNNonlinearSolver NLS); + +SUNDIALS_EXPORT int SUNNonlinSolInitialize_Newton(SUNNonlinearSolver NLS); + +SUNDIALS_EXPORT int SUNNonlinSolSolve_Newton(SUNNonlinearSolver NLS, + N_Vector y0, N_Vector y, + N_Vector w, realtype tol, + booleantype callLSetup, void *mem); + +SUNDIALS_EXPORT int SUNNonlinSolFree_Newton(SUNNonlinearSolver NLS); + +/* set functions */ +SUNDIALS_EXPORT int SUNNonlinSolSetSysFn_Newton(SUNNonlinearSolver NLS, + SUNNonlinSolSysFn SysFn); + +SUNDIALS_EXPORT int SUNNonlinSolSetLSetupFn_Newton(SUNNonlinearSolver NLS, + SUNNonlinSolLSetupFn LSetupFn); + +SUNDIALS_EXPORT int SUNNonlinSolSetLSolveFn_Newton(SUNNonlinearSolver NLS, + SUNNonlinSolLSolveFn LSolveFn); + +SUNDIALS_EXPORT int SUNNonlinSolSetConvTestFn_Newton(SUNNonlinearSolver NLS, + SUNNonlinSolConvTestFn CTestFn, + void* ctest_data); + +SUNDIALS_EXPORT int SUNNonlinSolSetMaxIters_Newton(SUNNonlinearSolver NLS, + int maxiters); + +/* get functions */ +SUNDIALS_EXPORT int SUNNonlinSolGetNumIters_Newton(SUNNonlinearSolver NLS, + long int *niters); + +SUNDIALS_EXPORT int SUNNonlinSolGetCurIter_Newton(SUNNonlinearSolver NLS, + int *iter); + +SUNDIALS_EXPORT int SUNNonlinSolGetNumConvFails_Newton(SUNNonlinearSolver NLS, + long int *nconvfails); + +SUNDIALS_EXPORT int SUNNonlinSolGetSysFn_Newton(SUNNonlinearSolver NLS, + SUNNonlinSolSysFn *SysFn); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/include/sunnonlinsol/sunnonlinsol_petscsnes.h b/bazaar/plugin/sundials/include/sunnonlinsol/sunnonlinsol_petscsnes.h new file mode 100644 index 000000000..be9d5c520 --- /dev/null +++ b/bazaar/plugin/sundials/include/sunnonlinsol/sunnonlinsol_petscsnes.h @@ -0,0 +1,97 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): Cody J. Balos @ LLNL + * ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------------------- + * This is the header file for the SUNNonlinearSolver module implementation of + * a wrapper to the PETSc SNES nonlinear solvers. + * + * Part I defines the solver-specific content structure. + * + * Part II contains prototypes for the solver constructor and operations. + * ---------------------------------------------------------------------------*/ + +#ifndef _SUNNONLINSOL_PETSCSNES_H +#define _SUNNONLINSOL_PETSCSNES_H + +#include "sundials/sundials_types.h" +#include "sundials/sundials_nvector.h" +#include "sundials/sundials_nonlinearsolver.h" +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* ----------------------------------------------------------------------------- + * I. Content structure + * ---------------------------------------------------------------------------*/ + +struct _SUNNonlinearSolverContent_PetscSNES { + int sysfn_last_err; /* last error returned by the system function Sys */ + PetscErrorCode petsc_last_err; /* last error return by PETSc */ + long int nconvfails; /* number of nonlinear converge failures (recoverable or not) */ + long int nni; /* number of nonlinear iterations */ + void *imem; /* SUNDIALS integrator memory */ + SNES snes; /* PETSc SNES context */ + Vec r; /* nonlinear residual */ + N_Vector y, f; /* wrappers for PETSc vectors in system function */ + /* functions provided by the integrator */ + SUNNonlinSolSysFn Sys; /* nonlinear system function */ +}; + +typedef struct _SUNNonlinearSolverContent_PetscSNES *SUNNonlinearSolverContent_PetscSNES; + +/* ----------------------------------------------------------------------------- + * II: Exported functions + * ---------------------------------------------------------------------------*/ + +/* Constructor to create solver and allocates memory */ + +SUNDIALS_EXPORT SUNNonlinearSolver SUNNonlinSol_PetscSNES(N_Vector y, SNES snes); + +/* SUNNonlinearSolver API functions */ + +SUNDIALS_EXPORT SUNNonlinearSolver_Type SUNNonlinSolGetType_PetscSNES(SUNNonlinearSolver NLS); + +SUNDIALS_EXPORT int SUNNonlinSolInitialize_PetscSNES(SUNNonlinearSolver NLS); + +SUNDIALS_EXPORT int SUNNonlinSolSolve_PetscSNES(SUNNonlinearSolver NLS, + N_Vector y0, N_Vector y, + N_Vector w, realtype tol, + booleantype callLSetup, void* mem); + +SUNDIALS_EXPORT int SUNNonlinSolSetSysFn_PetscSNES(SUNNonlinearSolver NLS, + SUNNonlinSolSysFn SysFn); + +SUNDIALS_EXPORT int SUNNonlinSolGetNumIters_PetscSNES(SUNNonlinearSolver NLS, long int* nni); + +SUNDIALS_EXPORT int SUNNonlinSolGetNumConvFails_PetscSNES(SUNNonlinearSolver NLS, + long int* nconvfails); + +SUNDIALS_EXPORT int SUNNonlinSolFree_PetscSNES(SUNNonlinearSolver NLS); + +/* Implementation specific functions */ + +SUNDIALS_EXPORT int SUNNonlinSolGetSNES_PetscSNES(SUNNonlinearSolver NLS, SNES* snes); + +SUNDIALS_EXPORT int SUNNonlinSolGetPetscError_PetscSNES(SUNNonlinearSolver NLS, + PetscErrorCode* err); + +SUNDIALS_EXPORT int SUNNonlinSolGetSysFn_PetscSNES(SUNNonlinearSolver NLS, + SUNNonlinSolSysFn* SysFn); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/ida/ida.c b/bazaar/plugin/sundials/src/ida/ida.c new file mode 100644 index 000000000..732893efe --- /dev/null +++ b/bazaar/plugin/sundials/src/ida/ida.c @@ -0,0 +1,3488 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Alan Hindmarsh, Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for the main IDA solver. + * ----------------------------------------------------------------- + * + * EXPORTED FUNCTIONS + * ------------------ + * Creation, allocation and re-initialization functions + * IDACreate + * IDAInit + * IDAReInit + * IDARootInit + * Main solver function + * IDASolve + * Interpolated output and extraction functions + * IDAGetDky + * Deallocation functions + * IDAFree + * + * PRIVATE FUNCTIONS + * ----------------- + * IDACheckNvector + * Memory allocation/deallocation + * IDAAllocVectors + * IDAFreeVectors + * Initial setup + * IDAInitialSetup + * IDAEwtSet + * IDAEwtSetSS + * IDAEwtSetSV + * Stopping tests + * IDAStopTest1 + * IDAStopTest2 + * Error handler + * IDAHandleFailure + * Main IDAStep function + * IDAStep + * IDASetCoeffs + * Nonlinear solver functions + * IDANls + * IDAPredict + * Error test + * IDATestError + * IDARestore + * Handler for convergence and/or error test failures + * IDAHandleNFlag + * IDAReset + * Function called after a successful step + * IDACompleteStep + * Get solution + * IDAGetSolution + * Norm functions + * IDAWrmsNorm + * Functions for rootfinding + * IDARcheck1 + * IDARcheck2 + * IDARcheck3 + * IDARootfind + * IDA Error message handling functions + * IDAProcessError + * IDAErrHandler + * ----------------------------------------------------------------- + */ + +/* + * ================================================================= + * IMPORTED HEADER FILES + * ================================================================= + */ + +#include +#include +#include +#include + +#include "ida_impl.h" +#include +#include + +/* + * ================================================================= + * IDAS 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 FOUR RCONST(4.0) /* real 4.0 */ +#define FIVE RCONST(5.0) /* real 5.0 */ +#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 */ + +/* + * ================================================================= + * IDAS ROUTINE-SPECIFIC CONSTANTS + * ================================================================= + */ + +/* + * Control constants for lower-level functions used by IDASolve + * ------------------------------------------------------------ + */ + +/* IDAStep control constants */ + +#define PREDICT_AGAIN 20 + +/* Return values for lower level routines used by IDASolve */ + +#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 + +/* + * Control constants for lower-level rootfinding functions + * ------------------------------------------------------- + */ + +#define RTFOUND +1 +#define CLOSERT +3 + +/* + * Control constants for tolerances + * -------------------------------- + */ + +#define IDA_NN 0 +#define IDA_SS 1 +#define IDA_SV 2 +#define IDA_WF 3 + +/* + * Algorithmic constants + * --------------------- + */ + +#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 */ +#define MAXBACKS 100 /* max backtracks per Newton step in IDACalcIC */ +#define XRATE RCONST(0.25) /* constant for updating Jacobian/preconditioner */ + +/* + * ================================================================= + * PRIVATE FUNCTION PROTOTYPES + * ================================================================= + */ + +static booleantype IDACheckNvector(N_Vector tmpl); + +/* Memory allocation/deallocation */ + +static booleantype IDAAllocVectors(IDAMem IDA_mem, N_Vector tmpl); +static void IDAFreeVectors(IDAMem IDA_mem); + +/* Initial setup */ + +int IDAInitialSetup(IDAMem IDA_mem); + +static int IDAEwtSetSS(IDAMem IDA_mem, N_Vector ycur, N_Vector weight); +static int IDAEwtSetSV(IDAMem IDA_mem, N_Vector ycur, N_Vector weight); + +/* Main IDAStep function */ + +static int IDAStep(IDAMem IDA_mem); + +/* Function called at beginning of step */ + +static void IDASetCoeffs(IDAMem IDA_mem, realtype *ck); + +/* Nonlinear solver functions */ + +static void IDAPredict(IDAMem IDA_mem); +static int IDANls(IDAMem IDA_mem); + +/* Error test */ + +static int IDATestError(IDAMem IDA_mem, realtype ck, + realtype *err_k, realtype *err_km1); + +/* Handling of convergence and/or error test failures */ + +static void IDARestore(IDAMem IDA_mem, realtype saved_t); +static int IDAHandleNFlag(IDAMem IDA_mem, int nflag, realtype err_k, realtype err_km1, + long int *ncfnPtr, int *ncfPtr, long int *netfPtr, int *nefPtr); +static void IDAReset(IDAMem IDA_mem); + +/* Function called after a successful step */ + +static void IDACompleteStep(IDAMem IDA_mem, realtype err_k, realtype err_km1); + +/* Function called to evaluate the solutions y(t) and y'(t) at t */ + +int IDAGetSolution(void *ida_mem, realtype t, N_Vector yret, N_Vector ypret); + +/* Stopping tests and failure handling */ + +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); + +/* Functions for rootfinding */ + +static int IDARcheck1(IDAMem IDA_mem); +static int IDARcheck2(IDAMem IDA_mem); +static int IDARcheck3(IDAMem IDA_mem); +static int IDARootfind(IDAMem IDA_mem); + +/* + * ================================================================= + * EXPORTED FUNCTIONS IMPLEMENTATION + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Creation, allocation and re-initialization 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 IDAInit. + * If an initialization error occurs, IDACreate prints an error + * message to standard err and returns NULL. + */ + +void *IDACreate(void) +{ + IDAMem IDA_mem; + + IDA_mem = NULL; + IDA_mem = (IDAMem) malloc(sizeof(struct IDAMemRec)); + if (IDA_mem == NULL) { + IDAProcessError(NULL, 0, "IDA", "IDACreate", MSG_MEM_FAIL); + return (NULL); + } + + /* Zero out ida_mem */ + memset(IDA_mem, 0, sizeof(struct IDAMemRec)); + + /* Set unit roundoff in IDA_mem */ + IDA_mem->ida_uround = UNIT_ROUNDOFF; + + /* Set default values for integrator optional inputs */ + IDA_mem->ida_res = NULL; + IDA_mem->ida_user_data = NULL; + IDA_mem->ida_itol = IDA_NN; + IDA_mem->ida_atolmin0 = SUNTRUE; + IDA_mem->ida_user_efun = SUNFALSE; + IDA_mem->ida_efun = NULL; + IDA_mem->ida_edata = NULL; + IDA_mem->ida_ehfun = IDAErrHandler; + IDA_mem->ida_eh_data = IDA_mem; + IDA_mem->ida_errfp = stderr; + IDA_mem->ida_maxord = MAXORD_DEFAULT; + IDA_mem->ida_mxstep = MXSTEP_DEFAULT; + IDA_mem->ida_hmax_inv = HMAX_INV_DEFAULT; + IDA_mem->ida_hin = ZERO; + IDA_mem->ida_epcon = EPCON; + IDA_mem->ida_maxnef = MXNEF; + IDA_mem->ida_maxncf = MXNCF; + IDA_mem->ida_suppressalg = SUNFALSE; + IDA_mem->ida_id = NULL; + IDA_mem->ida_constraints = NULL; + IDA_mem->ida_constraintsSet = SUNFALSE; + IDA_mem->ida_tstopset = SUNFALSE; + + /* set the saved value maxord_alloc */ + IDA_mem->ida_maxord_alloc = MAXORD_DEFAULT; + + /* 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_maxbacks = MAXBACKS; + IDA_mem->ida_lsoff = SUNFALSE; + IDA_mem->ida_steptol = SUNRpowerR(IDA_mem->ida_uround, TWOTHIRDS); + + /* Initialize lrw and liw */ + IDA_mem->ida_lrw = 25 + 5*MXORDP1; + IDA_mem->ida_liw = 38; + + /* No mallocs have been done yet */ + IDA_mem->ida_VatolMallocDone = SUNFALSE; + IDA_mem->ida_constraintsMallocDone = SUNFALSE; + IDA_mem->ida_idMallocDone = SUNFALSE; + IDA_mem->ida_MallocDone = SUNFALSE; + + /* Initialize nonlinear solver variables */ + IDA_mem->NLS = NULL; + IDA_mem->ownNLS = SUNFALSE; + + /* Return pointer to IDA memory block */ + return((void *)IDA_mem); +} + +/*-----------------------------------------------------------------*/ + +/* + * IDAInit + * + * IDAInit 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 + * error handler function. + */ + +int IDAInit(void *ida_mem, IDAResFn res, + realtype t0, N_Vector yy0, N_Vector yp0) +{ + int retval; + IDAMem IDA_mem; + booleantype nvectorOK, allocOK; + sunindextype lrw1, liw1; + SUNNonlinearSolver NLS; + + /* Check ida_mem */ + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAInit", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Check for legal input parameters */ + + if (yy0 == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInit", MSG_Y0_NULL); + return(IDA_ILL_INPUT); + } + + if (yp0 == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInit", MSG_YP0_NULL); + return(IDA_ILL_INPUT); + } + + if (res == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInit", MSG_RES_NULL); + return(IDA_ILL_INPUT); + } + + /* Test if all required vector operations are implemented */ + + nvectorOK = IDACheckNvector(yy0); + if (!nvectorOK) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInit", MSG_BAD_NVECTOR); + 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) { + IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDAInit", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + /* create a Newton nonlinear solver object by default */ + NLS = SUNNonlinSol_Newton(yy0); + + /* check that nonlinear solver is non-NULL */ + if (NLS == NULL) { + IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDAInit", MSG_MEM_FAIL); + IDAFreeVectors(IDA_mem); + return(IDA_MEM_FAIL); + } + + /* attach the nonlinear solver to the IDA memory */ + retval = IDASetNonlinearSolver(IDA_mem, NLS); + + /* check that the nonlinear solver was successfully attached */ + if (retval != IDA_SUCCESS) { + IDAProcessError(IDA_mem, retval, "IDA", "IDAInit", + "Setting the nonlinear solver failed"); + IDAFreeVectors(IDA_mem); + SUNNonlinSolFree(NLS); + return(IDA_MEM_FAIL); + } + + /* set ownership flag */ + IDA_mem->ownNLS = SUNTRUE; + + /* 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; + + /* 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; + + IDA_mem->ida_nge = 0; + + IDA_mem->ida_irfnd = 0; + + /* Initialize root-finding variables */ + + IDA_mem->ida_glo = NULL; + IDA_mem->ida_ghi = NULL; + IDA_mem->ida_grout = NULL; + IDA_mem->ida_iroots = NULL; + IDA_mem->ida_rootdir = NULL; + IDA_mem->ida_gfun = NULL; + IDA_mem->ida_nrtfn = 0; + IDA_mem->ida_gactive = NULL; + IDA_mem->ida_mxgnull = 1; + + /* Initial setup not done yet */ + + IDA_mem->ida_SetupDone = SUNFALSE; + + /* Problem memory has been successfully allocated */ + + IDA_mem->ida_MallocDone = SUNTRUE; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +/* + * IDAReInit + * + * IDAReInit re-initializes IDA's memory for a problem, assuming + * it has already beeen allocated in a prior IDAInit call. + * All problem specification inputs are checked for errors. + * The problem size Neq is assumed to be unchanged since the call + * to IDAInit, and the maximum order maxord must not be larger. + * If any error occurs during reinitialization, it is reported to + * the error handler function. + * The return value is IDA_SUCCESS = 0 if no errors occurred, or + * a negative value otherwise. + */ + +int IDAReInit(void *ida_mem, + realtype t0, N_Vector yy0, N_Vector yp0) +{ + IDAMem IDA_mem; + + /* Check for legal input parameters */ + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAReInit", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Check if problem was malloc'ed */ + + if (IDA_mem->ida_MallocDone == SUNFALSE) { + IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDAReInit", MSG_NO_MALLOC); + return(IDA_NO_MALLOC); + } + + /* Check for legal input parameters */ + + if (yy0 == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAReInit", MSG_Y0_NULL); + return(IDA_ILL_INPUT); + } + + if (yp0 == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAReInit", MSG_YP0_NULL); + return(IDA_ILL_INPUT); + } + + /* Copy the input parameters into IDA memory block */ + + IDA_mem->ida_tn = t0; + + /* 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; + + IDA_mem->ida_nge = 0; + + IDA_mem->ida_irfnd = 0; + + /* Initial setup not done yet */ + + IDA_mem->ida_SetupDone = SUNFALSE; + + /* Problem has been successfully re-initialized */ + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +/* + * IDASStolerances + * IDASVtolerances + * IDAWFtolerances + * + * These functions specify the integration tolerances. One of them + * MUST be called before the first call to IDA. + * + * IDASStolerances specifies scalar relative and absolute tolerances. + * IDASVtolerances specifies scalar relative tolerance and a vector + * absolute tolerance (a potentially different absolute tolerance + * for each vector component). + * IDAWFtolerances specifies a user-provides function (of type IDAEwtFn) + * which will be called to set the error weight vector. + */ + +int IDASStolerances(void *ida_mem, realtype reltol, realtype abstol) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASStolerances", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (IDA_mem->ida_MallocDone == SUNFALSE) { + IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDASStolerances", MSG_NO_MALLOC); + return(IDA_NO_MALLOC); + } + + /* Check inputs */ + + if (reltol < ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASStolerances", MSG_BAD_RTOL); + return(IDA_ILL_INPUT); + } + + if (abstol < ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASStolerances", MSG_BAD_ATOL); + return(IDA_ILL_INPUT); + } + + /* Copy tolerances into memory */ + + IDA_mem->ida_rtol = reltol; + IDA_mem->ida_Satol = abstol; + IDA_mem->ida_atolmin0 = (abstol == ZERO); + + IDA_mem->ida_itol = IDA_SS; + + IDA_mem->ida_user_efun = SUNFALSE; + IDA_mem->ida_efun = IDAEwtSet; + IDA_mem->ida_edata = NULL; /* will be set to ida_mem in InitialSetup */ + + return(IDA_SUCCESS); +} + + +int IDASVtolerances(void *ida_mem, realtype reltol, N_Vector abstol) +{ + IDAMem IDA_mem; + realtype atolmin; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASVtolerances", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (IDA_mem->ida_MallocDone == SUNFALSE) { + IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDASVtolerances", MSG_NO_MALLOC); + return(IDA_NO_MALLOC); + } + + /* Check inputs */ + + if (reltol < ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASVtolerances", MSG_BAD_RTOL); + return(IDA_ILL_INPUT); + } + + atolmin = N_VMin(abstol); + if (atolmin < ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASVtolerances", MSG_BAD_ATOL); + return(IDA_ILL_INPUT); + } + + /* Copy tolerances into memory */ + + if ( !(IDA_mem->ida_VatolMallocDone) ) { + IDA_mem->ida_Vatol = N_VClone(IDA_mem->ida_ewt); + IDA_mem->ida_lrw += IDA_mem->ida_lrw1; + IDA_mem->ida_liw += IDA_mem->ida_liw1; + IDA_mem->ida_VatolMallocDone = SUNTRUE; + } + + IDA_mem->ida_rtol = reltol; + N_VScale(ONE, abstol, IDA_mem->ida_Vatol); + IDA_mem->ida_atolmin0 = (atolmin == ZERO); + + IDA_mem->ida_itol = IDA_SV; + + IDA_mem->ida_user_efun = SUNFALSE; + IDA_mem->ida_efun = IDAEwtSet; + IDA_mem->ida_edata = NULL; /* will be set to ida_mem in InitialSetup */ + + return(IDA_SUCCESS); +} + + +int IDAWFtolerances(void *ida_mem, IDAEwtFn efun) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAWFtolerances", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (IDA_mem->ida_MallocDone == SUNFALSE) { + IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDAWFtolerances", MSG_NO_MALLOC); + return(IDA_NO_MALLOC); + } + + IDA_mem->ida_itol = IDA_WF; + + IDA_mem->ida_user_efun = SUNTRUE; + IDA_mem->ida_efun = efun; + IDA_mem->ida_edata = NULL; /* will be set to user_data in InitialSetup */ + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +/* + * IDARootInit + * + * IDARootInit initializes a rootfinding problem to be solved + * during the integration of the DAE system. It loads the root + * function pointer and the number of root functions, and allocates + * workspace memory. The return value is IDA_SUCCESS = 0 if no + * errors occurred, or a negative value otherwise. + */ + +int IDARootInit(void *ida_mem, int nrtfn, IDARootFn g) +{ + IDAMem IDA_mem; + int i, nrt; + + /* Check ida_mem pointer */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDARootInit", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + nrt = (nrtfn < 0) ? 0 : nrtfn; + + /* If rerunning IDARootInit() with a different number of root + functions (changing number of gfun components), then free + currently held memory resources */ + if ((nrt != IDA_mem->ida_nrtfn) && (IDA_mem->ida_nrtfn > 0)) { + + free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL; + free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL; + free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL; + free(IDA_mem->ida_iroots); IDA_mem->ida_iroots = NULL; + free(IDA_mem->ida_rootdir); IDA_mem->ida_rootdir = NULL; + free(IDA_mem->ida_gactive); IDA_mem->ida_gactive = NULL; + + IDA_mem->ida_lrw -= 3 * (IDA_mem->ida_nrtfn); + IDA_mem->ida_liw -= 3 * (IDA_mem->ida_nrtfn); + + } + + /* If IDARootInit() was called with nrtfn == 0, then set ida_nrtfn to + zero and ida_gfun to NULL before returning */ + if (nrt == 0) { + IDA_mem->ida_nrtfn = nrt; + IDA_mem->ida_gfun = NULL; + return(IDA_SUCCESS); + } + + /* If rerunning IDARootInit() 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 == IDA_mem->ida_nrtfn) { + if (g != IDA_mem->ida_gfun) { + if (g == NULL) { + free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL; + free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL; + free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL; + free(IDA_mem->ida_iroots); IDA_mem->ida_iroots = NULL; + free(IDA_mem->ida_rootdir); IDA_mem->ida_rootdir = NULL; + free(IDA_mem->ida_gactive); IDA_mem->ida_gactive = NULL; + + IDA_mem->ida_lrw -= 3*nrt; + IDA_mem->ida_liw -= 3*nrt; + + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDARootInit", MSG_ROOT_FUNC_NULL); + return(IDA_ILL_INPUT); + } + else { + IDA_mem->ida_gfun = g; + return(IDA_SUCCESS); + } + } + else return(IDA_SUCCESS); + } + + /* Set variable values in IDA memory block */ + IDA_mem->ida_nrtfn = nrt; + if (g == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDARootInit", MSG_ROOT_FUNC_NULL); + return(IDA_ILL_INPUT); + } + else IDA_mem->ida_gfun = g; + + /* Allocate necessary memory and return */ + IDA_mem->ida_glo = NULL; + IDA_mem->ida_glo = (realtype *) malloc(nrt*sizeof(realtype)); + if (IDA_mem->ida_glo == NULL) { + IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + IDA_mem->ida_ghi = NULL; + IDA_mem->ida_ghi = (realtype *) malloc(nrt*sizeof(realtype)); + if (IDA_mem->ida_ghi == NULL) { + free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL; + IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + IDA_mem->ida_grout = NULL; + IDA_mem->ida_grout = (realtype *) malloc(nrt*sizeof(realtype)); + if (IDA_mem->ida_grout == NULL) { + free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL; + free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL; + IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + IDA_mem->ida_iroots = NULL; + IDA_mem->ida_iroots = (int *) malloc(nrt*sizeof(int)); + if (IDA_mem->ida_iroots == NULL) { + free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL; + free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL; + free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL; + IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + IDA_mem->ida_rootdir = NULL; + IDA_mem->ida_rootdir = (int *) malloc(nrt*sizeof(int)); + if (IDA_mem->ida_rootdir == NULL) { + free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL; + free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL; + free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL; + free(IDA_mem->ida_iroots); IDA_mem->ida_iroots = NULL; + IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + IDA_mem->ida_gactive = NULL; + IDA_mem->ida_gactive = (booleantype *) malloc(nrt*sizeof(booleantype)); + if (IDA_mem->ida_gactive == NULL) { + free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL; + free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL; + free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL; + free(IDA_mem->ida_iroots); IDA_mem->ida_iroots = NULL; + free(IDA_mem->ida_rootdir); IDA_mem->ida_rootdir = NULL; + IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + /* Set default values for rootdir (both directions) */ + for(i=0; iida_rootdir[i] = 0; + + /* Set default values for gactive (all active) */ + for(i=0; iida_gactive[i] = SUNTRUE; + + IDA_mem->ida_lrw += 3*nrt; + IDA_mem->ida_liw += 3*nrt; + + return(IDA_SUCCESS); +} + + +/* + * ----------------------------------------------------------------- + * Main solver function + * ----------------------------------------------------------------- + */ + +/* + * 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 two modes, specified by itask: + * In the IDA_NORMAL mode, the solver steps until it passes tout and then + * interpolates to obtain y(tout) and yp(tout). + * In the IDA_ONE_STEP mode, it takes one internal step and returns. + * + * 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, irfndp, ir; + realtype tdist, troundoff, ypnorm, rh, nrm; + IDAMem IDA_mem; + booleantype inactive_roots; + + /* Check for legal inputs in all cases. */ + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASolve", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Check if problem was malloc'ed */ + + if (IDA_mem->ida_MallocDone == SUNFALSE) { + IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDASolve", MSG_NO_MALLOC); + return(IDA_NO_MALLOC); + } + + /* Check for legal arguments */ + + if (yret == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_YRET_NULL); + return(IDA_ILL_INPUT); + } + IDA_mem->ida_yy = yret; + + if (ypret == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_YPRET_NULL); + return(IDA_ILL_INPUT); + } + IDA_mem->ida_yp = ypret; + + if (tret == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_TRET_NULL); + return(IDA_ILL_INPUT); + } + + if ((itask != IDA_NORMAL) && (itask != IDA_ONE_STEP)) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_ITASK); + return(IDA_ILL_INPUT); + } + + if (itask == IDA_NORMAL) IDA_mem->ida_toutc = tout; + IDA_mem->ida_taskc = itask; + + if (IDA_mem->ida_nst == 0) { /* This is the first call */ + + /* Check inputs to IDA for correctness and consistency */ + + if (IDA_mem->ida_SetupDone == SUNFALSE) { + ier = IDAInitialSetup(IDA_mem); + if (ier != IDA_SUCCESS) return(ier); + IDA_mem->ida_SetupDone = SUNTRUE; + } + + /* On first call, check for tout - tn too small, set initial hh, + check for approach to tstop, and scale phi[1] by hh. + Also check for zeros of root function g at and near t0. */ + + tdist = SUNRabs(tout - IDA_mem->ida_tn); + if (tdist == ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_TOO_CLOSE); + return(IDA_ILL_INPUT); + } + troundoff = TWO * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(tout)); + if (tdist < troundoff) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_TOO_CLOSE); + return(IDA_ILL_INPUT); + } + + IDA_mem->ida_hh = IDA_mem->ida_hin; + if ( (IDA_mem->ida_hh != ZERO) && ((tout-IDA_mem->ida_tn)*IDA_mem->ida_hh < ZERO) ) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_HINIT); + return(IDA_ILL_INPUT); + } + + if (IDA_mem->ida_hh == ZERO) { + IDA_mem->ida_hh = PT001*tdist; + ypnorm = IDAWrmsNorm(IDA_mem, IDA_mem->ida_phi[1], + IDA_mem->ida_ewt, IDA_mem->ida_suppressalg); + if (ypnorm > HALF / IDA_mem->ida_hh) IDA_mem->ida_hh = HALF/ypnorm; + if (tout < IDA_mem->ida_tn) IDA_mem->ida_hh = -IDA_mem->ida_hh; + } + + rh = SUNRabs(IDA_mem->ida_hh) * IDA_mem->ida_hmax_inv; + if (rh > ONE) IDA_mem->ida_hh /= rh; + + if (IDA_mem->ida_tstopset) { + if ( (IDA_mem->ida_tstop - IDA_mem->ida_tn)*IDA_mem->ida_hh <= ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", + MSG_BAD_TSTOP, IDA_mem->ida_tstop, IDA_mem->ida_tn); + return(IDA_ILL_INPUT); + } + if ( (IDA_mem->ida_tn + IDA_mem->ida_hh - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) + IDA_mem->ida_hh = (IDA_mem->ida_tstop - IDA_mem->ida_tn)*(ONE - FOUR * IDA_mem->ida_uround); + } + + IDA_mem->ida_h0u = IDA_mem->ida_hh; + IDA_mem->ida_kk = 0; + IDA_mem->ida_kused = 0; /* set in case of an error return before a step */ + + /* Check for exact zeros of the root functions at or near t0. */ + if (IDA_mem->ida_nrtfn > 0) { + ier = IDARcheck1(IDA_mem); + if (ier == IDA_RTFUNC_FAIL) { + IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDA", "IDARcheck1", + MSG_RTFUNC_FAILED, IDA_mem->ida_tn); + return(IDA_RTFUNC_FAIL); + } + } + + /* set phi[1] = hh*y' */ + N_VScale(IDA_mem->ida_hh, IDA_mem->ida_phi[1], IDA_mem->ida_phi[1]); + + /* Set the convergence test constants epsNewt and toldel */ + IDA_mem->ida_epsNewt = IDA_mem->ida_epcon; + IDA_mem->ida_toldel = PT0001 * IDA_mem->ida_epsNewt; + + } /* end of first-call block. */ + + /* Call lperf function and set nstloc for later performance testing. */ + + if (IDA_mem->ida_lperf != NULL) + IDA_mem->ida_lperf(IDA_mem, 0); + nstloc = 0; + + /* If not the first call, perform all stopping tests. */ + + if (IDA_mem->ida_nst > 0) { + + /* First, check for a root in the last step taken, other than the + last root found, if any. If itask = IDA_ONE_STEP and y(tn) was not + returned because of an intervening root, return y(tn) now. */ + + if (IDA_mem->ida_nrtfn > 0) { + + irfndp = IDA_mem->ida_irfnd; + + ier = IDARcheck2(IDA_mem); + + if (ier == CLOSERT) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDARcheck2", + MSG_CLOSE_ROOTS, IDA_mem->ida_tlo); + return(IDA_ILL_INPUT); + } else if (ier == IDA_RTFUNC_FAIL) { + IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDA", "IDARcheck2", + MSG_RTFUNC_FAILED, IDA_mem->ida_tlo); + return(IDA_RTFUNC_FAIL); + } else if (ier == RTFOUND) { + IDA_mem->ida_tretlast = *tret = IDA_mem->ida_tlo; + return(IDA_ROOT_RETURN); + } + + /* If tn is distinct from tretlast (within roundoff), + check remaining interval for roots */ + troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); + if ( SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tretlast) > troundoff ) { + ier = IDARcheck3(IDA_mem); + if (ier == IDA_SUCCESS) { /* no root found */ + IDA_mem->ida_irfnd = 0; + if ((irfndp == 1) && (itask == IDA_ONE_STEP)) { + IDA_mem->ida_tretlast = *tret = IDA_mem->ida_tn; + ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret); + return(IDA_SUCCESS); + } + } else if (ier == RTFOUND) { /* a new root was found */ + IDA_mem->ida_irfnd = 1; + IDA_mem->ida_tretlast = *tret = IDA_mem->ida_tlo; + return(IDA_ROOT_RETURN); + } else if (ier == IDA_RTFUNC_FAIL) { /* g failed */ + IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDA", "IDARcheck3", + MSG_RTFUNC_FAILED, IDA_mem->ida_tlo); + return(IDA_RTFUNC_FAIL); + } + } + + } /* end of root stop check */ + + + /* Now test for all other stop conditions. */ + + istate = IDAStopTest1(IDA_mem, tout, tret, yret, ypret, itask); + if (istate != CONTINUE_STEPS) return(istate); + } + + /* Looping point for internal steps. */ + + for(;;) { + + /* Check for too many steps taken. */ + + if ( (IDA_mem->ida_mxstep>0) && (nstloc >= IDA_mem->ida_mxstep) ) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", + MSG_MAX_STEPS, IDA_mem->ida_tn); + istate = IDA_TOO_MUCH_WORK; + *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn; + break; /* Here yy=yret and yp=ypret already have the current solution. */ + } + + /* Call lperf to generate warnings of poor performance. */ + + if (IDA_mem->ida_lperf != NULL) + IDA_mem->ida_lperf(IDA_mem, 1); + + /* Reset and check ewt (if not first call). */ + + if (IDA_mem->ida_nst > 0) { + + ier = IDA_mem->ida_efun(IDA_mem->ida_phi[0], IDA_mem->ida_ewt, + IDA_mem->ida_edata); + + if (ier != 0) { + + if (IDA_mem->ida_itol == IDA_WF) + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", + MSG_EWT_NOW_FAIL, IDA_mem->ida_tn); + else + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", + MSG_EWT_NOW_BAD, IDA_mem->ida_tn); + + istate = IDA_ILL_INPUT; + ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret); + *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn; + break; + + } + + } + + /* Check for too much accuracy requested. */ + + nrm = IDAWrmsNorm(IDA_mem, IDA_mem->ida_phi[0], IDA_mem->ida_ewt, + IDA_mem->ida_suppressalg); + IDA_mem->ida_tolsf = IDA_mem->ida_uround * nrm; + if (IDA_mem->ida_tolsf > ONE) { + IDA_mem->ida_tolsf *= TEN; + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", + MSG_TOO_MUCH_ACC, IDA_mem->ida_tn); + istate = IDA_TOO_MUCH_ACC; + *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn; + if (IDA_mem->ida_nst > 0) ier = IDAGetSolution(IDA_mem, IDA_mem->ida_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 = IDA_mem->ida_tretlast = IDA_mem->ida_tn; + ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret); + break; + } + + nstloc++; + + /* After successful step, check for stop conditions; continue or break. */ + + /* First check for root in the last step taken. */ + + if (IDA_mem->ida_nrtfn > 0) { + + ier = IDARcheck3(IDA_mem); + + if (ier == RTFOUND) { /* A new root was found */ + IDA_mem->ida_irfnd = 1; + istate = IDA_ROOT_RETURN; + IDA_mem->ida_tretlast = *tret = IDA_mem->ida_tlo; + break; + } else if (ier == IDA_RTFUNC_FAIL) { /* g failed */ + IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDA", "IDARcheck3", + MSG_RTFUNC_FAILED, IDA_mem->ida_tlo); + istate = IDA_RTFUNC_FAIL; + break; + } + + /* If we are at the end of the first step and we still have + * some event functions that are inactive, issue a warning + * as this may indicate a user error in the implementation + * of the root function. */ + + if (IDA_mem->ida_nst==1) { + inactive_roots = SUNFALSE; + for (ir=0; irida_nrtfn; ir++) { + if (!IDA_mem->ida_gactive[ir]) { + inactive_roots = SUNTRUE; + break; + } + } + if ((IDA_mem->ida_mxgnull > 0) && inactive_roots) { + IDAProcessError(IDA_mem, IDA_WARNING, "IDA", "IDASolve", + MSG_INACTIVE_ROOTS); + } + } + + } + + /* Now check all other stop conditions. */ + + istate = IDAStopTest2(IDA_mem, tout, tret, yret, ypret, itask); + if (istate != CONTINUE_STEPS) break; + + } /* End of step loop */ + + return(istate); +} + +/* + * ----------------------------------------------------------------- + * Interpolated output and extraction functions + * ----------------------------------------------------------------- + */ + +/* + * IDAGetDky + * + * This routine evaluates the k-th derivative of y(t) as the value of + * the k-th derivative of the interpolating polynomial at the independent + * variable t, and stores the results in the vector dky. It uses the current + * independent variable value, tn, and the method order last used, kused. + * + * The return values are: + * IDA_SUCCESS if t is legal + * IDA_BAD_T if t is not within the interval of the last step taken + * IDA_BAD_DKY if the dky vector is NULL + * IDA_BAD_K if the requested k is not in the range [0,order used] + * IDA_VECTOROP_ERR if the fused vector operation fails + * + */ + +int IDAGetDky(void *ida_mem, realtype t, int k, N_Vector dky) +{ + IDAMem IDA_mem; + realtype tfuzz, tp, delt, psij_1; + int i, j, retval; + realtype cjk [MXORDP1]; + realtype cjk_1[MXORDP1]; + + /* Check ida_mem */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetDky", MSG_NO_MEM); + return (IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (dky == NULL) { + IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDA", "IDAGetDky", MSG_NULL_DKY); + return(IDA_BAD_DKY); + } + + if ((k < 0) || (k > IDA_mem->ida_kused)) { + IDAProcessError(IDA_mem, IDA_BAD_K, "IDA", "IDAGetDky", MSG_BAD_K); + return(IDA_BAD_K); + } + + /* Check t for legality. Here tn - hused is t_{n-1}. */ + + tfuzz = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); + if (IDA_mem->ida_hh < ZERO) tfuzz = - tfuzz; + tp = IDA_mem->ida_tn - IDA_mem->ida_hused - tfuzz; + if ((t - tp)*IDA_mem->ida_hh < ZERO) { + IDAProcessError(IDA_mem, IDA_BAD_T, "IDA", "IDAGetDky", MSG_BAD_T, t, + IDA_mem->ida_tn-IDA_mem->ida_hused, IDA_mem->ida_tn); + return(IDA_BAD_T); + } + + /* Initialize the c_j^(k) and c_k^(k-1) */ + for(i=0; iida_tn; + + for(i=0; i<=k; i++) { + + /* The below reccurence is used to compute the k-th derivative of the solution: + c_j^(k) = ( k * c_{j-1}^(k-1) + c_{j-1}^{k} (Delta+psi_{j-1}) ) / psi_j + + Translated in indexes notation: + cjk[j] = ( k*cjk_1[j-1] + cjk[j-1]*(delt+psi[j-2]) ) / psi[j-1] + + For k=0, j=1: c_1 = c_0^(-1) + (delt+psi[-1]) / psi[0] + + In order to be able to deal with k=0 in the same way as for k>0, the + following conventions were adopted: + - c_0(t) = 1 , c_0^(-1)(t)=0 + - psij_1 stands for psi[-1]=0 when j=1 + for psi[j-2] when j>1 + */ + if(i==0) { + + cjk[i] = 1; + psij_1 = 0; + }else { + /* i i-1 1 + c_i^(i) can be always updated since c_i^(i) = ----- -------- ... ----- + psi_j psi_{j-1} psi_1 + */ + cjk[i] = cjk[i-1]*i / IDA_mem->ida_psi[i-1]; + psij_1 = IDA_mem->ida_psi[i-1]; + } + + /* update c_j^(i) */ + + /*j does not need to go till kused */ + for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) { + + cjk[j] = ( i* cjk_1[j-1] + cjk[j-1] * (delt + psij_1) ) / IDA_mem->ida_psi[j-1]; + psij_1 = IDA_mem->ida_psi[j-1]; + } + + /* save existing c_j^(i)'s */ + for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) cjk_1[j] = cjk[j]; + } + + /* Compute sum (c_j(t) * phi(t)) */ + + /* Sum j=k to j<=IDA_mem->ida_kused */ + retval = N_VLinearCombination(IDA_mem->ida_kused-k+1, cjk+k, + IDA_mem->ida_phi+k, dky); + if (retval != IDA_SUCCESS) return(IDA_VECTOROP_ERR); + + return(IDA_SUCCESS); +} + +/* + * IDAComputeY + * + * Computes y based on the current prediction and given correction. + */ +int IDAComputeY(void *ida_mem, N_Vector ycor, N_Vector y) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAComputeY", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + N_VLinearSum(ONE, IDA_mem->ida_yypredict, ONE, ycor, y); + + return(IDA_SUCCESS); +} + +/* + * IDAComputeYp + * + * Computes y' based on the current prediction and given correction. + */ +int IDAComputeYp(void *ida_mem, N_Vector ycor, N_Vector yp) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAComputeYp", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + N_VLinearSum(ONE, IDA_mem->ida_yppredict, IDA_mem->ida_cj, ycor, yp); + + return(IDA_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Deallocation function + * ----------------------------------------------------------------- + */ + +/* + * IDAFree + * + * This routine frees the problem memory allocated by IDAInit + * 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 IDA created the NLS object then free it */ + if (IDA_mem->ownNLS) { + SUNNonlinSolFree(IDA_mem->NLS); + IDA_mem->ownNLS = SUNFALSE; + IDA_mem->NLS = NULL; + } + + if (IDA_mem->ida_lfree != NULL) + IDA_mem->ida_lfree(IDA_mem); + + if (IDA_mem->ida_nrtfn > 0) { + free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL; + free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL; + free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL; + free(IDA_mem->ida_iroots); IDA_mem->ida_iroots = NULL; + free(IDA_mem->ida_rootdir); IDA_mem->ida_rootdir = NULL; + free(IDA_mem->ida_gactive); IDA_mem->ida_gactive = NULL; + } + + free(*ida_mem); + *ida_mem = NULL; +} + +/* + * ================================================================= + * PRIVATE FUNCTIONS + * ================================================================= + */ + +/* + * IDACheckNvector + * + * This routine checks if all required vector operations are present. + * If any of them is missing it returns SUNFALSE. + */ + +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(SUNFALSE); + else + return(SUNTRUE); +} + +/* + * ----------------------------------------------------------------- + * Memory allocation/deallocation + * ----------------------------------------------------------------- + */ + +/* + * IDAAllocVectors + * + * This routine allocates the IDA vectors ewt, tempv1, tempv2, and + * phi[0], ..., phi[maxord]. + * If all memory allocations are successful, IDAAllocVectors returns + * SUNTRUE. Otherwise all allocated memory is freed and IDAAllocVectors + * returns SUNFALSE. + * 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, yypredict, yppredict, savres, tempv1, tempv2, tempv3 */ + + IDA_mem->ida_ewt = N_VClone(tmpl); + if (IDA_mem->ida_ewt == NULL) return(SUNFALSE); + + IDA_mem->ida_ee = N_VClone(tmpl); + if (IDA_mem->ida_ee == NULL) { + N_VDestroy(IDA_mem->ida_ewt); + return(SUNFALSE); + } + + IDA_mem->ida_delta = N_VClone(tmpl); + if (IDA_mem->ida_delta == NULL) { + N_VDestroy(IDA_mem->ida_ewt); + N_VDestroy(IDA_mem->ida_ee); + return(SUNFALSE); + } + + IDA_mem->ida_yypredict = N_VClone(tmpl); + if (IDA_mem->ida_yypredict == NULL) { + N_VDestroy(IDA_mem->ida_ewt); + N_VDestroy(IDA_mem->ida_ee); + N_VDestroy(IDA_mem->ida_delta); + return(SUNFALSE); + } + + IDA_mem->ida_yppredict = N_VClone(tmpl); + if (IDA_mem->ida_yppredict == NULL) { + N_VDestroy(IDA_mem->ida_ewt); + N_VDestroy(IDA_mem->ida_ee); + N_VDestroy(IDA_mem->ida_delta); + N_VDestroy(IDA_mem->ida_yypredict); + return(SUNFALSE); + } + + IDA_mem->ida_savres = N_VClone(tmpl); + if (IDA_mem->ida_savres == NULL) { + N_VDestroy(IDA_mem->ida_ewt); + N_VDestroy(IDA_mem->ida_ee); + N_VDestroy(IDA_mem->ida_delta); + N_VDestroy(IDA_mem->ida_yypredict); + N_VDestroy(IDA_mem->ida_yppredict); + return(SUNFALSE); + } + + IDA_mem->ida_tempv1 = N_VClone(tmpl); + if (IDA_mem->ida_tempv1 == NULL) { + N_VDestroy(IDA_mem->ida_ewt); + N_VDestroy(IDA_mem->ida_ee); + N_VDestroy(IDA_mem->ida_delta); + N_VDestroy(IDA_mem->ida_yypredict); + N_VDestroy(IDA_mem->ida_yppredict); + N_VDestroy(IDA_mem->ida_savres); + return(SUNFALSE); + } + + IDA_mem->ida_tempv2 = N_VClone(tmpl); + if (IDA_mem->ida_tempv2 == NULL) { + N_VDestroy(IDA_mem->ida_ewt); + N_VDestroy(IDA_mem->ida_ee); + N_VDestroy(IDA_mem->ida_delta); + N_VDestroy(IDA_mem->ida_yypredict); + N_VDestroy(IDA_mem->ida_yppredict); + N_VDestroy(IDA_mem->ida_savres); + N_VDestroy(IDA_mem->ida_tempv1); + return(SUNFALSE); + } + + IDA_mem->ida_tempv3 = N_VClone(tmpl); + if (IDA_mem->ida_tempv3 == NULL) { + N_VDestroy(IDA_mem->ida_ewt); + N_VDestroy(IDA_mem->ida_ee); + N_VDestroy(IDA_mem->ida_delta); + N_VDestroy(IDA_mem->ida_yypredict); + N_VDestroy(IDA_mem->ida_yppredict); + N_VDestroy(IDA_mem->ida_savres); + N_VDestroy(IDA_mem->ida_tempv1); + N_VDestroy(IDA_mem->ida_tempv2); + return(SUNFALSE); + } + + /* Allocate phi[0] ... phi[maxord]. Make sure phi[2] and phi[3] are + allocated (for use as temporary vectors), regardless of maxord. */ + + maxcol = SUNMAX(IDA_mem->ida_maxord,3); + for (j=0; j <= maxcol; j++) { + IDA_mem->ida_phi[j] = N_VClone(tmpl); + if (IDA_mem->ida_phi[j] == NULL) { + N_VDestroy(IDA_mem->ida_ewt); + N_VDestroy(IDA_mem->ida_ee); + N_VDestroy(IDA_mem->ida_delta); + N_VDestroy(IDA_mem->ida_yypredict); + N_VDestroy(IDA_mem->ida_yppredict); + N_VDestroy(IDA_mem->ida_savres); + N_VDestroy(IDA_mem->ida_tempv1); + N_VDestroy(IDA_mem->ida_tempv2); + N_VDestroy(IDA_mem->ida_tempv3); + for (i=0; i < j; i++) N_VDestroy(IDA_mem->ida_phi[i]); + return(SUNFALSE); + } + } + + /* Update solver workspace lengths */ + IDA_mem->ida_lrw += (maxcol + 10)*IDA_mem->ida_lrw1; + IDA_mem->ida_liw += (maxcol + 10)*IDA_mem->ida_liw1; + + /* Store the value of maxord used here */ + IDA_mem->ida_maxord_alloc = IDA_mem->ida_maxord; + + return(SUNTRUE); +} + +/* + * IDAfreeVectors + * + * This routine frees the IDA vectors allocated for IDA. + */ + +static void IDAFreeVectors(IDAMem IDA_mem) +{ + int j, maxcol; + + N_VDestroy(IDA_mem->ida_ewt); IDA_mem->ida_ewt = NULL; + N_VDestroy(IDA_mem->ida_ee); IDA_mem->ida_ee = NULL; + N_VDestroy(IDA_mem->ida_delta); IDA_mem->ida_delta = NULL; + N_VDestroy(IDA_mem->ida_yypredict); IDA_mem->ida_yypredict = NULL; + N_VDestroy(IDA_mem->ida_yppredict); IDA_mem->ida_yppredict = NULL; + N_VDestroy(IDA_mem->ida_savres); IDA_mem->ida_savres = NULL; + N_VDestroy(IDA_mem->ida_tempv1); IDA_mem->ida_tempv1 = NULL; + N_VDestroy(IDA_mem->ida_tempv2); IDA_mem->ida_tempv2 = NULL; + N_VDestroy(IDA_mem->ida_tempv3); IDA_mem->ida_tempv3 = NULL; + maxcol = SUNMAX(IDA_mem->ida_maxord_alloc,3); + for(j=0; j <= maxcol; j++) { + N_VDestroy(IDA_mem->ida_phi[j]); + IDA_mem->ida_phi[j] = NULL; + } + + IDA_mem->ida_lrw -= (maxcol + 10)*IDA_mem->ida_lrw1; + IDA_mem->ida_liw -= (maxcol + 10)*IDA_mem->ida_liw1; + + if (IDA_mem->ida_VatolMallocDone) { + N_VDestroy(IDA_mem->ida_Vatol); IDA_mem->ida_Vatol = NULL; + IDA_mem->ida_lrw -= IDA_mem->ida_lrw1; + IDA_mem->ida_liw -= IDA_mem->ida_liw1; + } + + if (IDA_mem->ida_constraintsMallocDone) { + N_VDestroy(IDA_mem->ida_constraints); + IDA_mem->ida_constraints = NULL; + IDA_mem->ida_lrw -= IDA_mem->ida_lrw1; + IDA_mem->ida_liw -= IDA_mem->ida_liw1; + } + + if (IDA_mem->ida_idMallocDone) { + N_VDestroy(IDA_mem->ida_id); IDA_mem->ida_id = NULL; + IDA_mem->ida_lrw -= IDA_mem->ida_lrw1; + IDA_mem->ida_liw -= IDA_mem->ida_liw1; + } + +} + +/* + * ----------------------------------------------------------------- + * Initial setup + * ----------------------------------------------------------------- + */ + +/* + * IDAInitialSetup + * + * This routine is called by IDASolve once at the first step. + * It performs all checks on optional inputs and inputs to + * IDAInit/IDAReInit that could not be done before. + * + * If no error is encountered, IDAInitialSetup returns IDA_SUCCESS. + * Otherwise, it returns an error flag and reported to the error + * handler function. + */ + +int IDAInitialSetup(IDAMem IDA_mem) +{ + booleantype conOK; + int ier; + + /* Test for more vector operations, depending on options */ + if (IDA_mem->ida_suppressalg) + if (IDA_mem->ida_phi[0]->ops->nvwrmsnormmask == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", + MSG_BAD_NVECTOR); + return(IDA_ILL_INPUT); + } + + /* Test id vector for legality */ + if (IDA_mem->ida_suppressalg && (IDA_mem->ida_id==NULL)){ + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", + MSG_MISSING_ID); + return(IDA_ILL_INPUT); + } + + /* Did the user specify tolerances? */ + if (IDA_mem->ida_itol == IDA_NN) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", + MSG_NO_TOLS); + return(IDA_ILL_INPUT); + } + + /* Set data for efun */ + if (IDA_mem->ida_user_efun) IDA_mem->ida_edata = IDA_mem->ida_user_data; + else IDA_mem->ida_edata = IDA_mem; + + /* Initial error weight vector */ + ier = IDA_mem->ida_efun(IDA_mem->ida_phi[0], IDA_mem->ida_ewt, IDA_mem->ida_edata); + if (ier != 0) { + if (IDA_mem->ida_itol == IDA_WF) + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", + MSG_FAIL_EWT); + else + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", + MSG_BAD_EWT); + return(IDA_ILL_INPUT); + } + + /* Check to see if y0 satisfies constraints. */ + if (IDA_mem->ida_constraintsSet) { + conOK = N_VConstrMask(IDA_mem->ida_constraints, IDA_mem->ida_phi[0], IDA_mem->ida_tempv2); + if (!conOK) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", + MSG_Y0_FAIL_CONSTR); + return(IDA_ILL_INPUT); + } + } + + /* Call linit function if it exists. */ + if (IDA_mem->ida_linit != NULL) { + ier = IDA_mem->ida_linit(IDA_mem); + if (ier != 0) { + IDAProcessError(IDA_mem, IDA_LINIT_FAIL, "IDA", "IDAInitialSetup", + MSG_LINIT_FAIL); + return(IDA_LINIT_FAIL); + } + } + + /* Initialize the nonlinear solver (must occur after linear solver is initialize) so + * that lsetup and lsolve pointers have been set */ + ier = idaNlsInit(IDA_mem); + if (ier != IDA_SUCCESS) { + IDAProcessError(IDA_mem, IDA_NLS_INIT_FAIL, "IDA", "IDAInitialSetup", + MSG_NLS_INIT_FAIL); + return(IDA_NLS_INIT_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 * SUNRabs(ycur[i]) + atol), i=0,...,Neq-1 + * if itol = IDA_SS + * (2) ewt[i] = 1 / (rtol * SUNRabs(ycur[i]) + atol[i]), i=0,...,Neq-1 + * if itol = IDA_SV + * + * IDAEwtSet returns 0 if ewt is successfully set as above to a + * positive vector and -1 otherwise. In the latter case, ewt is + * considered undefined. + * + * All the real work is done in the routines IDAEwtSetSS, IDAEwtSetSV. + */ + +int IDAEwtSet(N_Vector ycur, N_Vector weight, void *data) +{ + IDAMem IDA_mem; + int flag = 0; + + /* data points to IDA_mem here */ + + IDA_mem = (IDAMem) data; + + switch(IDA_mem->ida_itol) { + case IDA_SS: + flag = IDAEwtSetSS(IDA_mem, ycur, weight); + break; + case IDA_SV: + flag = IDAEwtSetSV(IDA_mem, ycur, weight); + break; + } + return(flag); +} + +/* + * IDAEwtSetSS + * + * This routine sets ewt as decribed above in the case itol=IDA_SS. + * If the absolute tolerance is zero, it tests for non-positive components + * before inverting. IDAEwtSetSS returns 0 if ewt is successfully set to a + * positive vector and -1 otherwise. In the latter case, ewt is considered + * undefined. + */ + +static int IDAEwtSetSS(IDAMem IDA_mem, N_Vector ycur, N_Vector weight) +{ + N_VAbs(ycur, IDA_mem->ida_tempv1); + N_VScale(IDA_mem->ida_rtol, IDA_mem->ida_tempv1, IDA_mem->ida_tempv1); + N_VAddConst(IDA_mem->ida_tempv1, IDA_mem->ida_Satol, IDA_mem->ida_tempv1); + if (IDA_mem->ida_atolmin0) { + if (N_VMin(IDA_mem->ida_tempv1) <= ZERO) return(-1); + } + N_VInv(IDA_mem->ida_tempv1, weight); + return(0); +} + +/* + * IDAEwtSetSV + * + * This routine sets ewt as decribed above in the case itol=IDA_SV. + * If the absolute tolerance is zero, it tests for non-positive components + * before inverting. IDAEwtSetSV returns 0 if ewt is successfully set to a + * positive vector and -1 otherwise. In the latter case, ewt is considered + * undefined. + */ + +static int IDAEwtSetSV(IDAMem IDA_mem, N_Vector ycur, N_Vector weight) +{ + N_VAbs(ycur, IDA_mem->ida_tempv1); + N_VLinearSum(IDA_mem->ida_rtol, IDA_mem->ida_tempv1, + ONE, IDA_mem->ida_Vatol, IDA_mem->ida_tempv1); + if (IDA_mem->ida_atolmin0) { + if (N_VMin(IDA_mem->ida_tempv1) <= ZERO) return(-1); + } + N_VInv(IDA_mem->ida_tempv1, weight); + return(0); +} + +/* + * ----------------------------------------------------------------- + * Stopping tests + * ----------------------------------------------------------------- + */ + +/* + * IDAStopTest1 + * + * This routine tests for stop conditions before taking a step. + * The tests depend on the value of itask. + * The variable tretlast 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: + + if (IDA_mem->ida_tstopset) { + /* Test for tn past tstop, tn = tretlast, tn past tout, tn near tstop. */ + if ( (IDA_mem->ida_tn - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", + MSG_BAD_TSTOP, IDA_mem->ida_tstop, IDA_mem->ida_tn); + return(IDA_ILL_INPUT); + } + } + + /* Test for tout = tretlast, and for tn past tout. */ + if (tout == IDA_mem->ida_tretlast) { + *tret = IDA_mem->ida_tretlast = tout; + return(IDA_SUCCESS); + } + if ((IDA_mem->ida_tn - tout)*IDA_mem->ida_hh >= ZERO) { + ier = IDAGetSolution(IDA_mem, tout, yret, ypret); + if (ier != IDA_SUCCESS) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TOUT, tout); + return(IDA_ILL_INPUT); + } + *tret = IDA_mem->ida_tretlast = tout; + return(IDA_SUCCESS); + } + + if (IDA_mem->ida_tstopset) { + troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); + if (SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tstop) <= troundoff) { + ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tstop, yret, ypret); + if (ier != IDA_SUCCESS) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", + MSG_BAD_TSTOP, IDA_mem->ida_tstop, IDA_mem->ida_tn); + return(IDA_ILL_INPUT); + } + *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tstop; + IDA_mem->ida_tstopset = SUNFALSE; + return(IDA_TSTOP_RETURN); + } + if ((IDA_mem->ida_tn + IDA_mem->ida_hh - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) + IDA_mem->ida_hh = (IDA_mem->ida_tstop - IDA_mem->ida_tn)*(ONE - FOUR * IDA_mem->ida_uround); + } + + return(CONTINUE_STEPS); + + case IDA_ONE_STEP: + + if (IDA_mem->ida_tstopset) { + /* Test for tn past tstop, tn past tretlast, and tn near tstop. */ + if ((IDA_mem->ida_tn - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", + MSG_BAD_TSTOP, IDA_mem->ida_tstop, IDA_mem->ida_tn); + return(IDA_ILL_INPUT); + } + } + + /* Test for tn past tretlast. */ + if ((IDA_mem->ida_tn - IDA_mem->ida_tretlast)*IDA_mem->ida_hh > ZERO) { + ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret); + *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn; + return(IDA_SUCCESS); + } + + if (IDA_mem->ida_tstopset) { + troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); + if (SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tstop) <= troundoff) { + ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tstop, yret, ypret); + if (ier != IDA_SUCCESS) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", + MSG_BAD_TSTOP, IDA_mem->ida_tstop, IDA_mem->ida_tn); + return(IDA_ILL_INPUT); + } + *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tstop; + IDA_mem->ida_tstopset = SUNFALSE; + return(IDA_TSTOP_RETURN); + } + if ((IDA_mem->ida_tn + IDA_mem->ida_hh - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) + IDA_mem->ida_hh = (IDA_mem->ida_tstop - IDA_mem->ida_tn)*(ONE - FOUR * IDA_mem->ida_uround); + } + + return(CONTINUE_STEPS); + + } + return(IDA_ILL_INPUT); /* This return should never happen. */ +} + +/* + * 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 + * IDA_ILL_INPUT for an illegal-input 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 ((IDA_mem->ida_tn - tout)*IDA_mem->ida_hh >= ZERO) { + /* ier = */ IDAGetSolution(IDA_mem, tout, yret, ypret); + *tret = IDA_mem->ida_tretlast = tout; + return(IDA_SUCCESS); + } + + if (IDA_mem->ida_tstopset) { + /* Test for tn at tstop and for tn near tstop */ + troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); + if (SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tstop) <= troundoff) { + /* ier = */ IDAGetSolution(IDA_mem, IDA_mem->ida_tstop, yret, ypret); + *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tstop; + IDA_mem->ida_tstopset = SUNFALSE; + return(IDA_TSTOP_RETURN); + } + if ((IDA_mem->ida_tn + IDA_mem->ida_hh - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) + IDA_mem->ida_hh = (IDA_mem->ida_tstop - IDA_mem->ida_tn)*(ONE - FOUR * IDA_mem->ida_uround); + } + + return(CONTINUE_STEPS); + + case IDA_ONE_STEP: + + if (IDA_mem->ida_tstopset) { + /* Test for tn at tstop and for tn near tstop */ + troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); + if (SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tstop) <= troundoff) { + /* ier = */ IDAGetSolution(IDA_mem, IDA_mem->ida_tstop, yret, ypret); + *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tstop; + IDA_mem->ida_tstopset = SUNFALSE; + return(IDA_TSTOP_RETURN); + } + if ((IDA_mem->ida_tn + IDA_mem->ida_hh - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) + IDA_mem->ida_hh = (IDA_mem->ida_tstop - IDA_mem->ida_tn)*(ONE - FOUR * IDA_mem->ida_uround); + } + + *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn; + return(IDA_SUCCESS); + + } + return IDA_ILL_INPUT; /* This return should never happen. */ +} + +/* + * ----------------------------------------------------------------- + * Error handler + * ----------------------------------------------------------------- + */ + +/* + * 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: + IDAProcessError(IDA_mem, IDA_ERR_FAIL, "IDA", "IDASolve", + MSG_ERR_FAILS, IDA_mem->ida_tn, IDA_mem->ida_hh); + return(IDA_ERR_FAIL); + + case IDA_CONV_FAIL: + IDAProcessError(IDA_mem, IDA_CONV_FAIL, "IDA", "IDASolve", + MSG_CONV_FAILS, IDA_mem->ida_tn, IDA_mem->ida_hh); + return(IDA_CONV_FAIL); + + case IDA_LSETUP_FAIL: + IDAProcessError(IDA_mem, IDA_LSETUP_FAIL, "IDA", "IDASolve", + MSG_SETUP_FAILED, IDA_mem->ida_tn); + return(IDA_LSETUP_FAIL); + + case IDA_LSOLVE_FAIL: + IDAProcessError(IDA_mem, IDA_LSOLVE_FAIL, "IDA", "IDASolve", + MSG_SOLVE_FAILED, IDA_mem->ida_tn); + return(IDA_LSOLVE_FAIL); + + case IDA_REP_RES_ERR: + IDAProcessError(IDA_mem, IDA_REP_RES_ERR, "IDA", "IDASolve", + MSG_REP_RES_ERR, IDA_mem->ida_tn); + return(IDA_REP_RES_ERR); + + case IDA_RES_FAIL: + IDAProcessError(IDA_mem, IDA_RES_FAIL, "IDA", "IDASolve", + MSG_RES_NONRECOV, IDA_mem->ida_tn); + return(IDA_RES_FAIL); + + case IDA_CONSTR_FAIL: + IDAProcessError(IDA_mem, IDA_CONSTR_FAIL, "IDA", "IDASolve", + MSG_FAILED_CONSTR, IDA_mem->ida_tn); + return(IDA_CONSTR_FAIL); + + case IDA_MEM_NULL: + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASolve", + MSG_NO_MEM); + return(IDA_MEM_NULL); + + case SUN_NLS_MEM_NULL: + IDAProcessError(IDA_mem, IDA_MEM_NULL, "IDA", "IDASolve", + MSG_NLS_INPUT_NULL, IDA_mem->ida_tn); + return(IDA_MEM_NULL); + + case IDA_NLS_SETUP_FAIL: + IDAProcessError(IDA_mem, IDA_NLS_SETUP_FAIL, "IDA", "IDASolve", + MSG_NLS_SETUP_FAILED, IDA_mem->ida_tn); + return(IDA_NLS_SETUP_FAIL); + case IDA_NLS_FAIL: + IDAProcessError(IDA_mem, IDA_NLS_FAIL, "IDA", "IDASolve", + MSG_NLS_FAIL, IDA_mem->ida_tn); + return(IDA_NLS_FAIL); + } + + /* This return should never happen */ + IDAProcessError(IDA_mem, IDA_UNRECOGNIZED_ERROR, "IDA", "IDASolve", + "IDA encountered an unrecognized error. Please report this to the Sundials developers at sundials-users@llnl.gov"); + return (IDA_UNRECOGNIZED_ERROR); +} + +/* + * ----------------------------------------------------------------- + * Main IDAStep function + * ----------------------------------------------------------------- + */ + +/* + * 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; + realtype err_k, err_km1; + int ncf, nef; + int nflag, kflag; + + saved_t = IDA_mem->ida_tn; + ncf = nef = 0; + + if (IDA_mem->ida_nst == ZERO){ + IDA_mem->ida_kk = 1; + IDA_mem->ida_kused = 0; + IDA_mem->ida_hused = ZERO; + IDA_mem->ida_psi[0] = IDA_mem->ida_hh; + IDA_mem->ida_cj = ONE/IDA_mem->ida_hh; + IDA_mem->ida_phase = 0; + IDA_mem->ida_ns = 0; + } + + /* To prevent 'unintialized variable' warnings */ + err_k = ZERO; + err_km1 = ZERO; + + /* Looping point for attempts to take a step */ + + for(;;) { + + /*----------------------- + Set method coefficients + -----------------------*/ + + IDASetCoeffs(IDA_mem, &ck); + + kflag = IDA_SUCCESS; + + /*---------------------------------------------------- + If tn is past tstop (by roundoff), reset it to tstop. + -----------------------------------------------------*/ + + IDA_mem->ida_tn = IDA_mem->ida_tn + IDA_mem->ida_hh; + if (IDA_mem->ida_tstopset) { + if ((IDA_mem->ida_tn - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) + IDA_mem->ida_tn = IDA_mem->ida_tstop; + } + + /*----------------------- + Advance state variables + -----------------------*/ + + /* Compute predicted values for yy and yp */ + IDAPredict(IDA_mem); + + /* Nonlinear system solution */ + nflag = IDANls(IDA_mem); + + /* If NLS was successful, perform error test */ + if (nflag == IDA_SUCCESS) + nflag = IDATestError(IDA_mem, ck, &err_k, &err_km1); + + /* Test for convergence or error test failures */ + if (nflag != IDA_SUCCESS) { + + /* restore and decide what to do */ + IDARestore(IDA_mem, saved_t); + kflag = IDAHandleNFlag(IDA_mem, nflag, err_k, err_km1, + &(IDA_mem->ida_ncfn), &ncf, + &(IDA_mem->ida_netf), &nef); + + /* exit on nonrecoverable failure */ + if (kflag != PREDICT_AGAIN) return(kflag); + + /* recoverable error; predict again */ + if(IDA_mem->ida_nst==0) IDAReset(IDA_mem); + continue; + + } + + /* kflag == IDA_SUCCESS */ + break; + + } /* end loop */ + + /* Nonlinear system solve and error test were both successful; + update data, and consider change of step and/or order */ + + IDACompleteStep(IDA_mem, err_k, err_km1); + + /* + Rescale ee vector to be the estimated local error + Notes: + (1) altering the value of ee is permissible since + it will be overwritten by + IDASolve()->IDAStep()->IDANls() + before it is needed again + (2) the value of ee is only valid if IDAHandleNFlag() + returns either PREDICT_AGAIN or IDA_SUCCESS + */ + + N_VScale(ck, IDA_mem->ida_ee, IDA_mem->ida_ee); + + 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 ( (IDA_mem->ida_hh != IDA_mem->ida_hused) || + (IDA_mem->ida_kk != IDA_mem->ida_kused) ) + IDA_mem->ida_ns = 0; + IDA_mem->ida_ns = SUNMIN(IDA_mem->ida_ns+1, IDA_mem->ida_kused+2); + if (IDA_mem->ida_kk + 1 >= IDA_mem->ida_ns) { + IDA_mem->ida_beta[0] = ONE; + IDA_mem->ida_alpha[0] = ONE; + temp1 = IDA_mem->ida_hh; + IDA_mem->ida_gamma[0] = ZERO; + IDA_mem->ida_sigma[0] = ONE; + for(i=1; i<=IDA_mem->ida_kk; i++) { + temp2 = IDA_mem->ida_psi[i-1]; + IDA_mem->ida_psi[i-1] = temp1; + IDA_mem->ida_beta[i] = IDA_mem->ida_beta[i-1] * IDA_mem->ida_psi[i-1] / temp2; + temp1 = temp2 + IDA_mem->ida_hh; + IDA_mem->ida_alpha[i] = IDA_mem->ida_hh / temp1; + IDA_mem->ida_sigma[i] = i * IDA_mem->ida_sigma[i-1] * IDA_mem->ida_alpha[i]; + IDA_mem->ida_gamma[i] = IDA_mem->ida_gamma[i-1] + IDA_mem->ida_alpha[i-1] / IDA_mem->ida_hh; + } + IDA_mem->ida_psi[IDA_mem->ida_kk] = temp1; + } + /* compute alphas, alpha0 */ + alphas = ZERO; + alpha0 = ZERO; + for(i=0; iida_kk; i++) { + alphas = alphas - ONE/(i+1); + alpha0 = alpha0 - IDA_mem->ida_alpha[i]; + } + + /* compute leading coefficient cj */ + IDA_mem->ida_cjlast = IDA_mem->ida_cj; + IDA_mem->ida_cj = -alphas/IDA_mem->ida_hh; + + /* compute variable stepsize error coefficient ck */ + + *ck = SUNRabs(IDA_mem->ida_alpha[IDA_mem->ida_kk] + alphas - alpha0); + *ck = SUNMAX(*ck, IDA_mem->ida_alpha[IDA_mem->ida_kk]); + + /* change phi to phi-star */ + + /* Scale i=IDA_mem->ida_ns to i<=IDA_mem->ida_kk */ + if (IDA_mem->ida_ns <= IDA_mem->ida_kk) { + (void) N_VScaleVectorArray(IDA_mem->ida_kk - IDA_mem->ida_ns + 1, + IDA_mem->ida_beta+IDA_mem->ida_ns, + IDA_mem->ida_phi+IDA_mem->ida_ns, + IDA_mem->ida_phi+IDA_mem->ida_ns); + } + +} + +/* + * ----------------------------------------------------------------- + * Nonlinear solver functions + * ----------------------------------------------------------------- + */ + +/* + * IDANls + * + * This routine attempts to solve the nonlinear system using the linear + * solver specified. NOTE: this routine uses N_Vector ee as the scratch + * vector tempv3 passed to lsetup. + * + * Possible return values: + * + * IDA_SUCCESS + * + * IDA_RES_RECVR IDA_RES_FAIL + * IDA_LSETUP_RECVR IDA_LSETUP_FAIL + * IDA_LSOLVE_RECVR IDA_LSOLVE_FAIL + * + * IDA_CONSTR_RECVR + * SUN_NLS_CONV_RECVR + * IDA_MEM_NULL + */ + +static int IDANls(IDAMem IDA_mem) +{ + int retval; + booleantype constraintsPassed, callLSetup; + realtype temp1, temp2, vnorm; + N_Vector mm, tmp; + + callLSetup = SUNFALSE; + + /* Initialize if the first time called */ + + if (IDA_mem->ida_nst == 0){ + IDA_mem->ida_cjold = IDA_mem->ida_cj; + IDA_mem->ida_ss = TWENTY; + if (IDA_mem->ida_lsetup) callLSetup = SUNTRUE; + } + + /* Decide if lsetup is to be called */ + + if (IDA_mem->ida_lsetup) { + IDA_mem->ida_cjratio = IDA_mem->ida_cj / IDA_mem->ida_cjold; + temp1 = (ONE - XRATE) / (ONE + XRATE); + temp2 = ONE/temp1; + if (IDA_mem->ida_cjratio < temp1 || IDA_mem->ida_cjratio > temp2) callLSetup = SUNTRUE; + if (IDA_mem->ida_cj != IDA_mem->ida_cjlast) IDA_mem->ida_ss = HUNDRED; + } + + /* initial guess for the correction to the predictor */ + N_VConst(ZERO, IDA_mem->ida_ee); + + /* call nonlinear solver setup if it exists */ + if ((IDA_mem->NLS)->ops->setup) { + retval = SUNNonlinSolSetup(IDA_mem->NLS, IDA_mem->ida_ee, IDA_mem); + if (retval < 0) return(IDA_NLS_SETUP_FAIL); + if (retval > 0) return(IDA_NLS_SETUP_RECVR); + } + + /* solve the nonlinear system */ + retval = SUNNonlinSolSolve(IDA_mem->NLS, + IDA_mem->ida_yypredict, IDA_mem->ida_ee, + IDA_mem->ida_ewt, IDA_mem->ida_epsNewt, + callLSetup, IDA_mem); + + /* update yy and yp based on the final correction from the nonlinear solver */ + N_VLinearSum(ONE, IDA_mem->ida_yypredict, ONE, IDA_mem->ida_ee, IDA_mem->ida_yy); + N_VLinearSum(ONE, IDA_mem->ida_yppredict, IDA_mem->ida_cj, IDA_mem->ida_ee, IDA_mem->ida_yp); + + /* return if nonlinear solver failed */ + if (retval != IDA_SUCCESS) return(retval); + + /* If otherwise successful, check and enforce inequality constraints. */ + + if (IDA_mem->ida_constraintsSet) { + + /* shortcut names for temporary work vectors */ + mm = IDA_mem->ida_tempv2; + tmp = IDA_mem->ida_tempv1; + + /* Get mask vector mm, set where constraints failed */ + constraintsPassed = N_VConstrMask(IDA_mem->ida_constraints, + IDA_mem->ida_yy, mm); + if (constraintsPassed) return(IDA_SUCCESS); + + /* Constraints not met */ + + /* Compute correction to satisfy constraints */ + N_VCompare(ONEPT5, IDA_mem->ida_constraints, tmp); /* a[i] =1 when |c[i]| = 2 */ + N_VProd(tmp, IDA_mem->ida_constraints, tmp); /* a * c */ + N_VDiv(tmp, IDA_mem->ida_ewt, tmp); /* a * c * wt */ + N_VLinearSum(ONE, IDA_mem->ida_yy, -PT1, tmp, tmp); /* y - 0.1 * a * c * wt */ + N_VProd(tmp, mm, tmp); /* v = mm*(y-.1*a*c*wt) */ + + vnorm = IDAWrmsNorm(IDA_mem, tmp, IDA_mem->ida_ewt, SUNFALSE); /* ||v|| */ + + /* If vector v of constraint corrections is small in norm, correct and + accept this step */ + if (vnorm <= IDA_mem->ida_epsNewt) { + N_VLinearSum(ONE, IDA_mem->ida_ee, + -ONE, tmp, IDA_mem->ida_ee); /* ee <- ee - v */ + return(IDA_SUCCESS); + } + + /* Constraints correction is too large, reduce h by computing rr = h'/h */ + N_VLinearSum(ONE, IDA_mem->ida_phi[0], -ONE, IDA_mem->ida_yy, tmp); + N_VProd(mm, tmp, tmp); + IDA_mem->ida_rr = PT9*N_VMinQuotient(IDA_mem->ida_phi[0], tmp); + IDA_mem->ida_rr = SUNMAX(IDA_mem->ida_rr, PT1); + + /* Reattempt step with new step size */ + return(IDA_CONSTR_RECVR); + } + + return(IDA_SUCCESS); +} + + +/* + * IDAPredict + * + * This routine predicts the new values for vectors yy and yp. + */ + +static void IDAPredict(IDAMem IDA_mem) +{ + int j; + + for(j=0; j<=IDA_mem->ida_kk; j++) + IDA_mem->ida_cvals[j] = ONE; + + (void) N_VLinearCombination(IDA_mem->ida_kk+1, IDA_mem->ida_cvals, + IDA_mem->ida_phi, IDA_mem->ida_yypredict); + + (void) N_VLinearCombination(IDA_mem->ida_kk, IDA_mem->ida_gamma+1, + IDA_mem->ida_phi+1, IDA_mem->ida_yppredict); +} + +/* + * ----------------------------------------------------------------- + * Error test + * ----------------------------------------------------------------- + */ + +/* + * IDATestError + * + * This routine estimates errors at orders k, k-1, k-2, decides + * whether or not to suggest an order decrease, and performs + * the local error test. + * + * IDATestError returns either IDA_SUCCESS or ERROR_TEST_FAIL. + */ + +static int IDATestError(IDAMem IDA_mem, realtype ck, + realtype *err_k, realtype *err_km1) +{ + realtype err_km2; /* estimated error at k-2 */ + realtype enorm_k, enorm_km1, enorm_km2; /* error norms */ + realtype terr_k, terr_km1, terr_km2; /* local truncation error norms */ + + /* Compute error for order k. */ + enorm_k = IDAWrmsNorm(IDA_mem, IDA_mem->ida_ee, IDA_mem->ida_ewt, IDA_mem->ida_suppressalg); + *err_k = IDA_mem->ida_sigma[IDA_mem->ida_kk] * enorm_k; + terr_k = (IDA_mem->ida_kk + 1) * (*err_k); + + IDA_mem->ida_knew = IDA_mem->ida_kk; + + if ( IDA_mem->ida_kk > 1 ) { + + /* Compute error at order k-1 */ + N_VLinearSum(ONE, IDA_mem->ida_phi[IDA_mem->ida_kk], ONE, IDA_mem->ida_ee, IDA_mem->ida_delta); + enorm_km1 = IDAWrmsNorm(IDA_mem, IDA_mem->ida_delta, + IDA_mem->ida_ewt, IDA_mem->ida_suppressalg); + *err_km1 = IDA_mem->ida_sigma[IDA_mem->ida_kk - 1] * enorm_km1; + terr_km1 = IDA_mem->ida_kk * (*err_km1); + + if ( IDA_mem->ida_kk > 2 ) { + + /* Compute error at order k-2 */ + N_VLinearSum(ONE, IDA_mem->ida_phi[IDA_mem->ida_kk - 1], ONE, + IDA_mem->ida_delta, IDA_mem->ida_delta); + enorm_km2 = IDAWrmsNorm(IDA_mem, IDA_mem->ida_delta, + IDA_mem->ida_ewt, IDA_mem->ida_suppressalg); + err_km2 = IDA_mem->ida_sigma[IDA_mem->ida_kk - 2] * enorm_km2; + terr_km2 = (IDA_mem->ida_kk - 1) * err_km2; + + /* Decrease order if errors are reduced */ + if (SUNMAX(terr_km1, terr_km2) <= terr_k) + IDA_mem->ida_knew = IDA_mem->ida_kk - 1; + + } else { + + /* Decrease order to 1 if errors are reduced by at least 1/2 */ + if (terr_km1 <= (HALF * terr_k) ) + IDA_mem->ida_knew = IDA_mem->ida_kk - 1; + + } + + } + + /* Perform error test */ + if (ck * enorm_k > ONE) return(ERROR_TEST_FAIL); + else return(IDA_SUCCESS); +} + +/* + * IDARestore + * + * This routine restores tn, psi, and phi in the event of a failure. + * It changes back phi-star to phi (changed in IDASetCoeffs) + */ + +static void IDARestore(IDAMem IDA_mem, realtype saved_t) +{ + int j; + + IDA_mem->ida_tn = saved_t; + + for (j = 1; j <= IDA_mem->ida_kk; j++) + IDA_mem->ida_psi[j-1] = IDA_mem->ida_psi[j] - IDA_mem->ida_hh; + + if (IDA_mem->ida_ns <= IDA_mem->ida_kk) { + + for (j = IDA_mem->ida_ns; j <= IDA_mem->ida_kk; j++) + IDA_mem->ida_cvals[j-IDA_mem->ida_ns] = ONE/IDA_mem->ida_beta[j]; + + (void) N_VScaleVectorArray(IDA_mem->ida_kk - IDA_mem->ida_ns + 1, + IDA_mem->ida_cvals, + IDA_mem->ida_phi+IDA_mem->ida_ns, + IDA_mem->ida_phi+IDA_mem->ida_ns); + } + +} + +/* + * ----------------------------------------------------------------- + * Handler for convergence and/or error test failures + * ----------------------------------------------------------------- + */ + +/* + * 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 + * SUN_NLS_CONV_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 err_k, realtype err_km1, + long int *ncfnPtr, int *ncfPtr, long int *netfPtr, int *nefPtr) +{ + realtype err_knew; + + IDA_mem->ida_phase = 1; + + if (nflag != ERROR_TEST_FAIL) { + + /*----------------------- + Nonlinear solver failed + -----------------------*/ + + (*ncfPtr)++; /* local counter for convergence failures */ + (*ncfnPtr)++; /* global counter for convergence failures */ + + if (nflag < 0) { /* nonrecoverable failure */ + + if (nflag == IDA_LSOLVE_FAIL) return(IDA_LSOLVE_FAIL); + else if (nflag == IDA_LSETUP_FAIL) return(IDA_LSETUP_FAIL); + else if (nflag == IDA_RES_FAIL) return(IDA_RES_FAIL); + else return(IDA_NLS_FAIL); + + } else { /* recoverable failure */ + + /* Reduce step size for a new prediction + Note that if nflag=IDA_CONSTR_RECVR then rr was already set in IDANls */ + if (nflag != IDA_CONSTR_RECVR) IDA_mem->ida_rr = QUARTER; + IDA_mem->ida_hh *= IDA_mem->ida_rr; + + /* Test if there were too many convergence failures */ + if (*ncfPtr < IDA_mem->ida_maxncf) return(PREDICT_AGAIN); + else if (nflag == IDA_RES_RECVR) return(IDA_REP_RES_ERR); + else if (nflag == IDA_CONSTR_RECVR) return(IDA_CONSTR_FAIL); + else return(IDA_CONV_FAIL); + } + + } else { + + /*----------------- + Error Test failed + -----------------*/ + + (*nefPtr)++; /* local counter for error test failures */ + (*netfPtr)++; /* global counter for error test failures */ + + if (*nefPtr == 1) { + + /* On first error test failure, keep current order or lower order by one. + Compute new stepsize based on differences of the solution. */ + + err_knew = (IDA_mem->ida_kk == IDA_mem->ida_knew) ? err_k : err_km1; + + IDA_mem->ida_kk = IDA_mem->ida_knew; + IDA_mem->ida_rr = PT9 * SUNRpowerR( TWO * err_knew + PT0001, -ONE/(IDA_mem->ida_kk + 1) ); + IDA_mem->ida_rr = SUNMAX(QUARTER, SUNMIN(PT9,IDA_mem->ida_rr)); + IDA_mem->ida_hh *= IDA_mem->ida_rr; + return(PREDICT_AGAIN); + + } else if (*nefPtr == 2) { + + /* On second error test failure, use current order or decrease order by one. + Reduce stepsize by factor of 1/4. */ + + IDA_mem->ida_kk = IDA_mem->ida_knew; + IDA_mem->ida_rr = QUARTER; + IDA_mem->ida_hh *= IDA_mem->ida_rr; + return(PREDICT_AGAIN); + + } else if (*nefPtr < IDA_mem->ida_maxnef) { + + /* On third and subsequent error test failures, set order to 1. + Reduce stepsize by factor of 1/4. */ + IDA_mem->ida_kk = 1; + IDA_mem->ida_rr = QUARTER; + IDA_mem->ida_hh *= IDA_mem->ida_rr; + return(PREDICT_AGAIN); + + } else { + + /* Too many error test failures */ + return(IDA_ERR_FAIL); + + } + + } + +} + +/* + * IDAReset + * + * This routine is called only if we need to predict again at the + * very first step. In such a case, reset phi[1] and psi[0]. + */ + +static void IDAReset(IDAMem IDA_mem) +{ + IDA_mem->ida_psi[0] = IDA_mem->ida_hh; + + N_VScale(IDA_mem->ida_rr, IDA_mem->ida_phi[1], IDA_mem->ida_phi[1]); +} + +/* + * ----------------------------------------------------------------- + * Function called after a successful step + * ----------------------------------------------------------------- + */ + +/* + * 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. + */ + +static void IDACompleteStep(IDAMem IDA_mem, realtype err_k, realtype err_km1) +{ + int j, kdiff, action; + realtype terr_k, terr_km1, terr_kp1; + realtype err_knew, err_kp1; + realtype enorm, tmp, hnew; + + IDA_mem->ida_nst++; + kdiff = IDA_mem->ida_kk - IDA_mem->ida_kused; + IDA_mem->ida_kused = IDA_mem->ida_kk; + IDA_mem->ida_hused = IDA_mem->ida_hh; + + if ( (IDA_mem->ida_knew == IDA_mem->ida_kk - 1) || + (IDA_mem->ida_kk == IDA_mem->ida_maxord) ) + IDA_mem->ida_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 (IDA_mem->ida_phase == 0) { + + if(IDA_mem->ida_nst > 1) { + IDA_mem->ida_kk++; + hnew = TWO * IDA_mem->ida_hh; + if( (tmp = SUNRabs(hnew) * IDA_mem->ida_hmax_inv) > ONE ) + hnew /= tmp; + IDA_mem->ida_hh = hnew; + } + + } else { + + action = UNSET; + + /* Set action = LOWER/MAINTAIN/RAISE to specify order decision */ + + if (IDA_mem->ida_knew == IDA_mem->ida_kk - 1) {action = LOWER; goto takeaction;} + if (IDA_mem->ida_kk == IDA_mem->ida_maxord) {action = MAINTAIN; goto takeaction;} + if ( (IDA_mem->ida_kk + 1 >= IDA_mem->ida_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, IDA_mem->ida_ee, -ONE, + IDA_mem->ida_phi[IDA_mem->ida_kk + 1], IDA_mem->ida_tempv1); + enorm = IDAWrmsNorm(IDA_mem, IDA_mem->ida_tempv1, IDA_mem->ida_ewt, + IDA_mem->ida_suppressalg); + err_kp1= enorm/(IDA_mem->ida_kk + 2); + + /* Choose among orders k-1, k, k+1 using local truncation error norms. */ + + terr_k = (IDA_mem->ida_kk + 1) * err_k; + terr_kp1 = (IDA_mem->ida_kk + 2) * err_kp1; + + if (IDA_mem->ida_kk == 1) { + if (terr_kp1 >= HALF * terr_k) {action = MAINTAIN; goto takeaction;} + else {action = RAISE; goto takeaction;} + } else { + terr_km1 = IDA_mem->ida_kk * err_km1; + if (terr_km1 <= SUNMIN(terr_k, terr_kp1)) {action = LOWER; goto takeaction;} + else if (terr_kp1 >= terr_k) {action = MAINTAIN; goto takeaction;} + else {action = RAISE; goto takeaction;} + } + + takeaction: + + /* Set the estimated error norm and, on change of order, reset kk. */ + if (action == RAISE) { IDA_mem->ida_kk++; err_knew = err_kp1; } + else if (action == LOWER) { IDA_mem->ida_kk--; err_knew = err_km1; } + else { err_knew = err_k; } + + /* Compute rr = tentative ratio hnew/hh from error norm estimate. + 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 = IDA_mem->ida_hh; + IDA_mem->ida_rr = SUNRpowerR( TWO * err_knew + PT0001, -ONE/(IDA_mem->ida_kk + 1) ); + + if (IDA_mem->ida_rr >= TWO) { + hnew = TWO * IDA_mem->ida_hh; + if( (tmp = SUNRabs(hnew) * IDA_mem->ida_hmax_inv) > ONE ) + hnew /= tmp; + } else if (IDA_mem->ida_rr <= ONE ) { + IDA_mem->ida_rr = SUNMAX(HALF, SUNMIN(PT9,IDA_mem->ida_rr)); + hnew = IDA_mem->ida_hh * IDA_mem->ida_rr; + } + + IDA_mem->ida_hh = hnew; + + } /* end of phase if block */ + + /* Save ee for possible order increase on next step */ + if (IDA_mem->ida_kused < IDA_mem->ida_maxord) { + N_VScale(ONE, IDA_mem->ida_ee, IDA_mem->ida_phi[IDA_mem->ida_kused + 1]); + } + + /* Update phi arrays */ + + /* To update phi arrays compute X += Z where */ + /* X = [ phi[kused], phi[kused-1], phi[kused-2], ... phi[1] ] */ + /* Z = [ ee, phi[kused], phi[kused-1], ... phi[0] ] */ + + IDA_mem->ida_Zvecs[0] = IDA_mem->ida_ee; + IDA_mem->ida_Xvecs[0] = IDA_mem->ida_phi[IDA_mem->ida_kused]; + for (j=1; j<=IDA_mem->ida_kused; j++) { + IDA_mem->ida_Zvecs[j] = IDA_mem->ida_phi[IDA_mem->ida_kused-j+1]; + IDA_mem->ida_Xvecs[j] = IDA_mem->ida_phi[IDA_mem->ida_kused-j]; + } + + (void) N_VLinearSumVectorArray(IDA_mem->ida_kused+1, + ONE, IDA_mem->ida_Xvecs, + ONE, IDA_mem->ida_Zvecs, + IDA_mem->ida_Xvecs); +} + +/* + * ----------------------------------------------------------------- + * Interpolated output + * ----------------------------------------------------------------- + */ + +/* + * 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, retval; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetSolution", MSG_NO_MEM); + return (IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Check t for legality. Here tn - hused is t_{n-1}. */ + + tfuzz = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); + if (IDA_mem->ida_hh < ZERO) tfuzz = - tfuzz; + tp = IDA_mem->ida_tn - IDA_mem->ida_hused - tfuzz; + if ((t - tp)*IDA_mem->ida_hh < ZERO) { + IDAProcessError(IDA_mem, IDA_BAD_T, "IDA", "IDAGetSolution", MSG_BAD_T, t, + IDA_mem->ida_tn-IDA_mem->ida_hused, IDA_mem->ida_tn); + return(IDA_BAD_T); + } + + /* Initialize kord = (kused or 1). */ + + kord = IDA_mem->ida_kused; + if (IDA_mem->ida_kused == 0) kord = 1; + + /* Accumulate multiples of columns phi[j] into yret and ypret. */ + + delt = t - IDA_mem->ida_tn; + c = ONE; d = ZERO; + gam = delt / IDA_mem->ida_psi[0]; + + IDA_mem->ida_cvals[0] = c; + for (j=1; j <= kord; j++) { + d = d*gam + c / IDA_mem->ida_psi[j-1]; + c = c*gam; + gam = (delt + IDA_mem->ida_psi[j-1]) / IDA_mem->ida_psi[j]; + + IDA_mem->ida_cvals[j] = c; + IDA_mem->ida_dvals[j-1] = d; + } + + retval = N_VLinearCombination(kord+1, IDA_mem->ida_cvals, + IDA_mem->ida_phi, yret); + if (retval != IDA_SUCCESS) return(IDA_VECTOROP_ERR); + + retval = N_VLinearCombination(kord, IDA_mem->ida_dvals, + IDA_mem->ida_phi+1, ypret); + if (retval != IDA_SUCCESS) return(IDA_VECTOROP_ERR); + + return(IDA_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Norm function + * ----------------------------------------------------------------- + */ + +/* + * IDAWrmsNorm + * + * Returns the WRMS norm of vector x with weights w. + * If mask = SUNTRUE, the weight vector w is masked by id, i.e., + * nrm = N_VWrmsNormMask(x,w,id); + * Otherwise, + * nrm = N_VWrmsNorm(x,w); + * + * mask = SUNFALSE 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, IDA_mem->ida_id); + else nrm = N_VWrmsNorm(x, w); + + return(nrm); +} + +/* + * ----------------------------------------------------------------- + * Functions for rootfinding + * ----------------------------------------------------------------- + */ + +/* + * IDARcheck1 + * + * 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: + * IDA_RTFUNC_FAIL < 0 if the g function failed, or + * IDA_SUCCESS = 0 otherwise. + */ + +static int IDARcheck1(IDAMem IDA_mem) +{ + int i, retval; + realtype smallh, hratio, tplus; + booleantype zroot; + + for (i = 0; i < IDA_mem->ida_nrtfn; i++) + IDA_mem->ida_iroots[i] = 0; + IDA_mem->ida_tlo = IDA_mem->ida_tn; + IDA_mem->ida_ttol = ((SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)) * + IDA_mem->ida_uround * HUNDRED); + + /* Evaluate g at initial t and check for zero values. */ + retval = IDA_mem->ida_gfun(IDA_mem->ida_tlo, IDA_mem->ida_phi[0], IDA_mem->ida_phi[1], + IDA_mem->ida_glo, IDA_mem->ida_user_data); + IDA_mem->ida_nge = 1; + if (retval != 0) return(IDA_RTFUNC_FAIL); + + zroot = SUNFALSE; + for (i = 0; i < IDA_mem->ida_nrtfn; i++) { + if (SUNRabs(IDA_mem->ida_glo[i]) == ZERO) { + zroot = SUNTRUE; + IDA_mem->ida_gactive[i] = SUNFALSE; + } + } + if (!zroot) return(IDA_SUCCESS); + + /* Some g_i is zero at t0; look at g at t0+(small increment). */ + hratio = SUNMAX(IDA_mem->ida_ttol / SUNRabs(IDA_mem->ida_hh), PT1); + smallh = hratio * IDA_mem->ida_hh; + tplus = IDA_mem->ida_tlo + smallh; + N_VLinearSum(ONE, IDA_mem->ida_phi[0], smallh, IDA_mem->ida_phi[1], IDA_mem->ida_yy); + retval = IDA_mem->ida_gfun(tplus, IDA_mem->ida_yy, IDA_mem->ida_phi[1], + IDA_mem->ida_ghi, IDA_mem->ida_user_data); + IDA_mem->ida_nge++; + if (retval != 0) return(IDA_RTFUNC_FAIL); + + /* We check now only the components of g which were exactly 0.0 at t0 + * to see if we can 'activate' them. */ + for (i = 0; i < IDA_mem->ida_nrtfn; i++) { + if (!IDA_mem->ida_gactive[i] && SUNRabs(IDA_mem->ida_ghi[i]) != ZERO) { + IDA_mem->ida_gactive[i] = SUNTRUE; + IDA_mem->ida_glo[i] = IDA_mem->ida_ghi[i]; + } + } + return(IDA_SUCCESS); +} + +/* + * IDARcheck2 + * + * 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 array glo = g(tlo) at the left endpoint 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 + * IDASolve. This may be the previous tn, the previous tout value, + * or the last root location. + * + * This routine returns an int equal to: + * IDA_RTFUNC_FAIL < 0 if the g function failed, or + * CLOSERT = 3 if a close pair of zeros was found, or + * RTFOUND = 1 if a new zero of g was found near tlo, or + * IDA_SUCCESS = 0 otherwise. + */ + +static int IDARcheck2(IDAMem IDA_mem) +{ + int i, retval; + realtype smallh, hratio, tplus; + booleantype zroot; + + if (IDA_mem->ida_irfnd == 0) return(IDA_SUCCESS); + + (void) IDAGetSolution(IDA_mem, IDA_mem->ida_tlo, IDA_mem->ida_yy, IDA_mem->ida_yp); + retval = IDA_mem->ida_gfun(IDA_mem->ida_tlo, IDA_mem->ida_yy, IDA_mem->ida_yp, + IDA_mem->ida_glo, IDA_mem->ida_user_data); + IDA_mem->ida_nge++; + if (retval != 0) return(IDA_RTFUNC_FAIL); + + zroot = SUNFALSE; + for (i = 0; i < IDA_mem->ida_nrtfn; i++) + IDA_mem->ida_iroots[i] = 0; + for (i = 0; i < IDA_mem->ida_nrtfn; i++) { + if (!IDA_mem->ida_gactive[i]) continue; + if (SUNRabs(IDA_mem->ida_glo[i]) == ZERO) { + zroot = SUNTRUE; + IDA_mem->ida_iroots[i] = 1; + } + } + if (!zroot) return(IDA_SUCCESS); + + /* One or more g_i has a zero at tlo. Check g at tlo+smallh. */ + IDA_mem->ida_ttol = ((SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)) * + IDA_mem->ida_uround * HUNDRED); + smallh = (IDA_mem->ida_hh > ZERO) ? IDA_mem->ida_ttol : -IDA_mem->ida_ttol; + tplus = IDA_mem->ida_tlo + smallh; + if ( (tplus - IDA_mem->ida_tn)*IDA_mem->ida_hh >= ZERO) { + hratio = smallh/IDA_mem->ida_hh; + N_VLinearSum(ONE, IDA_mem->ida_yy, + hratio, IDA_mem->ida_phi[1], IDA_mem->ida_yy); + } else { + (void) IDAGetSolution(IDA_mem, tplus, IDA_mem->ida_yy, IDA_mem->ida_yp); + } + retval = IDA_mem->ida_gfun(tplus, IDA_mem->ida_yy, IDA_mem->ida_yp, + IDA_mem->ida_ghi, IDA_mem->ida_user_data); + IDA_mem->ida_nge++; + if (retval != 0) return(IDA_RTFUNC_FAIL); + + /* Check for close roots (error return), for a new zero at tlo+smallh, + and for a g_i that changed from zero to nonzero. */ + zroot = SUNFALSE; + for (i = 0; i < IDA_mem->ida_nrtfn; i++) { + if (!IDA_mem->ida_gactive[i]) continue; + if (SUNRabs(IDA_mem->ida_ghi[i]) == ZERO) { + if (IDA_mem->ida_iroots[i] == 1) return(CLOSERT); + zroot = SUNTRUE; + IDA_mem->ida_iroots[i] = 1; + } else { + if (IDA_mem->ida_iroots[i] == 1) + IDA_mem->ida_glo[i] = IDA_mem->ida_ghi[i]; + } + } + if (zroot) return(RTFOUND); + return(IDA_SUCCESS); +} + +/* + * IDARcheck3 + * + * This routine interfaces to IDARootfind 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: + * IDA_RTFUNC_FAIL < 0 if the g function failed, or + * RTFOUND = 1 if a root of g was found, or + * IDA_SUCCESS = 0 otherwise. + */ + +static int IDARcheck3(IDAMem IDA_mem) +{ + int i, ier, retval; + + /* Set thi = tn or tout, whichever comes first. */ + if (IDA_mem->ida_taskc == IDA_ONE_STEP) IDA_mem->ida_thi = IDA_mem->ida_tn; + if (IDA_mem->ida_taskc == IDA_NORMAL) { + IDA_mem->ida_thi = ((IDA_mem->ida_toutc - IDA_mem->ida_tn)*IDA_mem->ida_hh >= ZERO) + ? IDA_mem->ida_tn : IDA_mem->ida_toutc; + } + + /* Get y and y' at thi. */ + (void) IDAGetSolution(IDA_mem, IDA_mem->ida_thi, IDA_mem->ida_yy, IDA_mem->ida_yp); + + + /* Set ghi = g(thi) and call IDARootfind to search (tlo,thi) for roots. */ + retval = IDA_mem->ida_gfun(IDA_mem->ida_thi, IDA_mem->ida_yy, + IDA_mem->ida_yp, IDA_mem->ida_ghi, + IDA_mem->ida_user_data); + IDA_mem->ida_nge++; + if (retval != 0) return(IDA_RTFUNC_FAIL); + + IDA_mem->ida_ttol = ((SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)) * + IDA_mem->ida_uround * HUNDRED); + ier = IDARootfind(IDA_mem); + if (ier == IDA_RTFUNC_FAIL) return(IDA_RTFUNC_FAIL); + for(i=0; iida_nrtfn; i++) { + if(!IDA_mem->ida_gactive[i] && IDA_mem->ida_grout[i] != ZERO) + IDA_mem->ida_gactive[i] = SUNTRUE; + } + IDA_mem->ida_tlo = IDA_mem->ida_trout; + for (i = 0; i < IDA_mem->ida_nrtfn; i++) + IDA_mem->ida_glo[i] = IDA_mem->ida_grout[i]; + + /* If no root found, return IDA_SUCCESS. */ + if (ier == IDA_SUCCESS) return(IDA_SUCCESS); + + /* If a root was found, interpolate to get y(trout) and return. */ + (void) IDAGetSolution(IDA_mem, IDA_mem->ida_trout, IDA_mem->ida_yy, IDA_mem->ida_yp); + return(RTFOUND); +} + +/* + * IDARootfind + * + * 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, yp, gt, user_data) + * + * rootdir = in array specifying the direction of zero-crossings. + * If rootdir[i] > 0, search for roots of g_i only if + * g_i is increasing; if rootdir[i] < 0, search for + * roots of g_i only if g_i is decreasing; otherwise + * always search for roots of g_i. + * + * gactive = array specifying whether a component of g should + * or should not be monitored. gactive[i] is initially + * set to SUNTRUE for all i=0,...,nrtfn-1, but it may be + * reset to SUNFALSE if at the first step g[i] is 0.0 + * both at the I.C. and at a small perturbation of them. + * gactive[i] is then set back on SUNTRUE only after the + * corresponding g function moves away from 0.0. + * + * nge = cumulative counter for gfun calls. + * + * ttol = a convergence tolerance for trout. Input only. + * When a root at trout 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 (SUNRabs(tlo), SUNRabs(thi)) + * where UROUND is the unit roundoff of the machine. + * + * tlo, thi = endpoints of the interval in which roots are sought. + * On input, these 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. + * + * trout = 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, trout is the endpoint thi of the final + * interval bracketing the root, with size at most ttol. + * + * grout = array of length nrtfn containing g(trout) 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 trout. For + * i = 0, ..., nrtfn-1, iroots[i] = 1 if g_i has a root + * and g_i is increasing, iroots[i] = -1 if g_i has a + * root and g_i is decreasing, and iroots[i] = 0 if g_i + * has no roots or g_i varies in the direction opposite + * to that indicated by rootdir[i]. + * + * This routine returns an int equal to: + * IDA_RTFUNC_FAIL < 0 if the g function failed, or + * RTFOUND = 1 if a root of g was found, or + * IDA_SUCCESS = 0 otherwise. + * + */ + +static int IDARootfind(IDAMem IDA_mem) +{ + realtype alph, tmid, gfrac, maxfrac, fracint, fracsub; + int i, retval, 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 = SUNFALSE; + sgnchg = SUNFALSE; + for (i = 0; i < IDA_mem->ida_nrtfn; i++) { + if(!IDA_mem->ida_gactive[i]) continue; + if (SUNRabs(IDA_mem->ida_ghi[i]) == ZERO) { + if(IDA_mem->ida_rootdir[i] * IDA_mem->ida_glo[i] <= ZERO) { + zroot = SUNTRUE; + } + } else { + if ( (IDA_mem->ida_glo[i] * IDA_mem->ida_ghi[i] < ZERO) && + (IDA_mem->ida_rootdir[i] * IDA_mem->ida_glo[i] <= ZERO) ) { + gfrac = SUNRabs(IDA_mem->ida_ghi[i] / (IDA_mem->ida_ghi[i] - IDA_mem->ida_glo[i])); + if (gfrac > maxfrac) { + sgnchg = SUNTRUE; + maxfrac = gfrac; + imax = i; + } + } + } + } + + /* If no sign change was found, reset trout and grout. Then return + IDA_SUCCESS if no zero was found, or set iroots and return RTFOUND. */ + if (!sgnchg) { + IDA_mem->ida_trout = IDA_mem->ida_thi; + for (i = 0; i < IDA_mem->ida_nrtfn; i++) + IDA_mem->ida_grout[i] = IDA_mem->ida_ghi[i]; + if (!zroot) return(IDA_SUCCESS); + for (i = 0; i < IDA_mem->ida_nrtfn; i++) { + IDA_mem->ida_iroots[i] = 0; + if(!IDA_mem->ida_gactive[i]) continue; + if ( (SUNRabs(IDA_mem->ida_ghi[i]) == ZERO) && + (IDA_mem->ida_rootdir[i] * IDA_mem->ida_glo[i] <= ZERO) ) + IDA_mem->ida_iroots[i] = IDA_mem->ida_glo[i] > 0 ? -1:1; + } + return(RTFOUND); + } + + /* Initialize alph to avoid compiler warning */ + alph = ONE; + + /* A sign change was found. Loop to locate nearest root. */ + + side = 0; sideprev = -1; + for(;;) { /* Looping point */ + + /* If interval size is already less than tolerance ttol, break. */ + if (SUNRabs(IDA_mem->ida_thi - IDA_mem->ida_tlo) <= IDA_mem->ida_ttol) + break; + + /* Set weight alph. + On the first two passes, set alph = 1. Thereafter, reset alph + 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 alph = 1. + If the sides were the same, then double alph (if high side), + or halve alph (if low side). + The next guess tmid is the secant method value if alph = 1, but + is closer to tlo if alph < 1, and closer to thi if alph > 1. */ + + if (sideprev == side) { + alph = (side == 2) ? alph*TWO : alph*HALF; + } else { + alph = 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 = IDA_mem->ida_thi - (IDA_mem->ida_thi - IDA_mem->ida_tlo) * + IDA_mem->ida_ghi[imax] / (IDA_mem->ida_ghi[imax] - alph*IDA_mem->ida_glo[imax]); + if (SUNRabs(tmid - IDA_mem->ida_tlo) < HALF * IDA_mem->ida_ttol) { + fracint = SUNRabs(IDA_mem->ida_thi - IDA_mem->ida_tlo) / IDA_mem->ida_ttol; + fracsub = (fracint > FIVE) ? PT1 : HALF/fracint; + tmid = IDA_mem->ida_tlo + fracsub*(IDA_mem->ida_thi - IDA_mem->ida_tlo); + } + if (SUNRabs(IDA_mem->ida_thi - tmid) < HALF * IDA_mem->ida_ttol) { + fracint = SUNRabs(IDA_mem->ida_thi - IDA_mem->ida_tlo) / IDA_mem->ida_ttol; + fracsub = (fracint > FIVE) ? PT1 : HALF/fracint; + tmid = IDA_mem->ida_thi - fracsub*(IDA_mem->ida_thi - IDA_mem->ida_tlo); + } + + (void) IDAGetSolution(IDA_mem, tmid, IDA_mem->ida_yy, IDA_mem->ida_yp); + retval = IDA_mem->ida_gfun(tmid, IDA_mem->ida_yy, IDA_mem->ida_yp, + IDA_mem->ida_grout, IDA_mem->ida_user_data); + IDA_mem->ida_nge++; + if (retval != 0) return(IDA_RTFUNC_FAIL); + + /* 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 = SUNFALSE; + sgnchg = SUNFALSE; + sideprev = side; + for (i = 0; i < IDA_mem->ida_nrtfn; i++) { + if(!IDA_mem->ida_gactive[i]) continue; + if (SUNRabs(IDA_mem->ida_grout[i]) == ZERO) { + if(IDA_mem->ida_rootdir[i] * IDA_mem->ida_glo[i] <= ZERO) + zroot = SUNTRUE; + } else { + if ( (IDA_mem->ida_glo[i] * IDA_mem->ida_grout[i] < ZERO) && + (IDA_mem->ida_rootdir[i] * IDA_mem->ida_glo[i] <= ZERO) ) { + gfrac = SUNRabs(IDA_mem->ida_grout[i] / + (IDA_mem->ida_grout[i] - IDA_mem->ida_glo[i])); + if (gfrac > maxfrac) { + sgnchg = SUNTRUE; + maxfrac = gfrac; + imax = i; + } + } + } + } + if (sgnchg) { + /* Sign change found in (tlo,tmid); replace thi with tmid. */ + IDA_mem->ida_thi = tmid; + for (i = 0; i < IDA_mem->ida_nrtfn; i++) + IDA_mem->ida_ghi[i] = IDA_mem->ida_grout[i]; + side = 1; + /* Stop at root thi if converged; otherwise loop. */ + if (SUNRabs(IDA_mem->ida_thi - IDA_mem->ida_tlo) <= IDA_mem->ida_ttol) + break; + continue; /* Return to looping point. */ + } + + if (zroot) { + /* No sign change in (tlo,tmid), but g = 0 at tmid; return root tmid. */ + IDA_mem->ida_thi = tmid; + for (i = 0; i < IDA_mem->ida_nrtfn; i++) + IDA_mem->ida_ghi[i] = IDA_mem->ida_grout[i]; + break; + } + + /* No sign change in (tlo,tmid), and no zero at tmid. + Sign change must be in (tmid,thi). Replace tlo with tmid. */ + IDA_mem->ida_tlo = tmid; + for (i = 0; i < IDA_mem->ida_nrtfn; i++) + IDA_mem->ida_glo[i] = IDA_mem->ida_grout[i]; + side = 2; + /* Stop at root thi if converged; otherwise loop back. */ + if (SUNRabs(IDA_mem->ida_thi - IDA_mem->ida_tlo) <= IDA_mem->ida_ttol) + break; + + } /* End of root-search loop */ + + /* Reset trout and grout, set iroots, and return RTFOUND. */ + IDA_mem->ida_trout = IDA_mem->ida_thi; + for (i = 0; i < IDA_mem->ida_nrtfn; i++) { + IDA_mem->ida_grout[i] = IDA_mem->ida_ghi[i]; + IDA_mem->ida_iroots[i] = 0; + if(!IDA_mem->ida_gactive[i]) continue; + if ( (SUNRabs(IDA_mem->ida_ghi[i]) == ZERO) && + (IDA_mem->ida_rootdir[i] * IDA_mem->ida_glo[i] <= ZERO) ) + IDA_mem->ida_iroots[i] = IDA_mem->ida_glo[i] > 0 ? -1:1; + if ( (IDA_mem->ida_glo[i] * IDA_mem->ida_ghi[i] < ZERO) && + (IDA_mem->ida_rootdir[i] * IDA_mem->ida_glo[i] <= ZERO) ) + IDA_mem->ida_iroots[i] = IDA_mem->ida_glo[i] > 0 ? -1:1; + } + return(RTFOUND); +} + +/* + * ================================================================= + * IDA error message handling functions + * ================================================================= + */ + +/* + * IDAProcessError is a high level error handling function. + * - If ida_mem==NULL it prints the error message to stderr. + * - Otherwise, it sets up and calls the error handling function + * pointed to by ida_ehfun. + */ + +void IDAProcessError(IDAMem IDA_mem, + int error_code, const char *module, const char *fname, + const char *msgfmt, ...) +{ + va_list ap; + char msg[256]; + + /* Initialize the argument pointer variable + (msgfmt is the last required argument to IDAProcessError) */ + + va_start(ap, msgfmt); + + /* Compose the message */ + + vsprintf(msg, msgfmt, ap); + + if (IDA_mem == NULL) { /* We write to stderr */ +#ifndef NO_FPRINTF_OUTPUT + fprintf(stderr, "\n[%s ERROR] %s\n ", module, fname); + fprintf(stderr, "%s\n\n", msg); +#endif + + } else { /* We can call ehfun */ + IDA_mem->ida_ehfun(error_code, module, fname, msg, IDA_mem->ida_eh_data); + } + + /* Finalize argument processing */ + va_end(ap); + + return; +} + +/* IDAErrHandler is the default error handling function. + It sends the error message to the stream pointed to by ida_errfp */ + +void IDAErrHandler(int error_code, const char *module, + const char *function, char *msg, void *data) +{ + IDAMem IDA_mem; + char err_type[10]; + + /* data points to IDA_mem here */ + + IDA_mem = (IDAMem) data; + + if (error_code == IDA_WARNING) + sprintf(err_type,"WARNING"); + else + sprintf(err_type,"ERROR"); + +#ifndef NO_FPRINTF_OUTPUT + if (IDA_mem->ida_errfp != NULL) { + fprintf(IDA_mem->ida_errfp,"\n[%s %s] %s\n",module,err_type,function); + fprintf(IDA_mem->ida_errfp," %s\n\n",msg); + } +#endif + + return; +} diff --git a/bazaar/plugin/sundials/src/ida/ida_bbdpre.c b/bazaar/plugin/sundials/src/ida/ida_bbdpre.c new file mode 100644 index 000000000..8487469bf --- /dev/null +++ b/bazaar/plugin/sundials/src/ida/ida_bbdpre.c @@ -0,0 +1,665 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * 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, the IDASPILS + * linear solver interface. + * + * 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 "ida_impl.h" +#include "ida_ls_impl.h" +#include "ida_bbdpre_impl.h" +#include +#include + + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) + +/* Prototypes of functions IDABBDPrecSetup and IDABBDPrecSolve */ +static int IDABBDPrecSetup(realtype tt, N_Vector yy, N_Vector yp, + N_Vector rr, realtype c_j, void *prec_data); +static 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); + +/* Prototype for IDABBDPrecFree */ +static int IDABBDPrecFree(IDAMem ida_mem); + +/* 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); + +/*--------------------------------------------------------------- + User-Callable Functions: initialization, reinit and free + ---------------------------------------------------------------*/ +int IDABBDPrecInit(void *ida_mem, sunindextype Nlocal, + sunindextype mudq, sunindextype mldq, + sunindextype mukeep, sunindextype mlkeep, + realtype dq_rel_yy, + IDABBDLocalFn Gres, IDABBDCommFn Gcomm) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + IBBDPrecData pdata; + sunindextype muk, mlk, storage_mu, lrw1, liw1; + long int lrw, liw; + int flag; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDALS_MEM_NULL, "IDABBDPRE", + "IDABBDPrecInit", MSGBBD_MEM_NULL); + return(IDALS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Test if the LS linear solver interface has been created */ + if (IDA_mem->ida_lmem == NULL) { + IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDABBDPRE", + "IDABBDPrecInit", MSGBBD_LMEM_NULL); + return(IDALS_LMEM_NULL); + } + idals_mem = (IDALsMem) IDA_mem->ida_lmem; + + /* Test compatibility of NVECTOR package with the BBD preconditioner */ + if(IDA_mem->ida_tempv1->ops->nvgetarraypointer == NULL) { + IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDABBDPRE", + "IDABBDPrecInit", MSGBBD_BAD_NVECTOR); + return(IDALS_ILL_INPUT); + } + + /* Allocate data memory. */ + pdata = NULL; + pdata = (IBBDPrecData) malloc(sizeof *pdata); + if (pdata == NULL) { + IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDABBDPRE", + "IDABBDPrecInit", MSGBBD_MEM_FAIL); + return(IDALS_MEM_FAIL); + } + + /* Set pointers to glocal and gcomm; load half-bandwidths. */ + pdata->ida_mem = IDA_mem; + pdata->glocal = Gres; + pdata->gcomm = Gcomm; + pdata->mudq = SUNMIN(Nlocal-1, SUNMAX(0, mudq)); + pdata->mldq = SUNMIN(Nlocal-1, SUNMAX(0, mldq)); + muk = SUNMIN(Nlocal-1, SUNMAX(0, mukeep)); + mlk = SUNMIN(Nlocal-1, SUNMAX(0, mlkeep)); + pdata->mukeep = muk; + pdata->mlkeep = mlk; + + /* Set extended upper half-bandwidth for PP (required for pivoting). */ + storage_mu = SUNMIN(Nlocal-1, muk+mlk); + + /* Allocate memory for preconditioner matrix. */ + pdata->PP = NULL; + pdata->PP = SUNBandMatrixStorage(Nlocal, muk, mlk, storage_mu); + if (pdata->PP == NULL) { + free(pdata); pdata = NULL; + IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDABBDPRE", + "IDABBDPrecInit", MSGBBD_MEM_FAIL); + return(IDALS_MEM_FAIL); + } + + /* Allocate memory for temporary N_Vectors */ + pdata->zlocal = NULL; + pdata->zlocal = N_VNewEmpty_Serial(Nlocal); + if (pdata->zlocal == NULL) { + SUNMatDestroy(pdata->PP); + free(pdata); pdata = NULL; + IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDABBDPRE", + "IDABBDPrecInit", MSGBBD_MEM_FAIL); + return(IDALS_MEM_FAIL); + } + pdata->rlocal = NULL; + pdata->rlocal = N_VNewEmpty_Serial(Nlocal); + if (pdata->rlocal == NULL) { + N_VDestroy(pdata->zlocal); + SUNMatDestroy(pdata->PP); + free(pdata); pdata = NULL; + IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDABBDPRE", + "IDABBDPrecInit", MSGBBD_MEM_FAIL); + return(IDALS_MEM_FAIL); + } + pdata->tempv1 = NULL; + pdata->tempv1 = N_VClone(IDA_mem->ida_tempv1); + if (pdata->tempv1 == NULL){ + N_VDestroy(pdata->rlocal); + N_VDestroy(pdata->zlocal); + SUNMatDestroy(pdata->PP); + free(pdata); pdata = NULL; + IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDABBDPRE", + "IDABBDPrecInit", MSGBBD_MEM_FAIL); + return(IDALS_MEM_FAIL); + } + pdata->tempv2 = NULL; + pdata->tempv2 = N_VClone(IDA_mem->ida_tempv1); + if (pdata->tempv2 == NULL){ + N_VDestroy(pdata->rlocal); + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->tempv1); + SUNMatDestroy(pdata->PP); + free(pdata); pdata = NULL; + IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDABBDPRE", + "IDABBDPrecInit", MSGBBD_MEM_FAIL); + return(IDALS_MEM_FAIL); + } + pdata->tempv3 = NULL; + pdata->tempv3 = N_VClone(IDA_mem->ida_tempv1); + if (pdata->tempv3 == NULL){ + N_VDestroy(pdata->rlocal); + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->tempv1); + N_VDestroy(pdata->tempv2); + SUNMatDestroy(pdata->PP); + free(pdata); pdata = NULL; + IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDABBDPRE", + "IDABBDPrecInit", MSGBBD_MEM_FAIL); + return(IDALS_MEM_FAIL); + } + pdata->tempv4 = NULL; + pdata->tempv4 = N_VClone(IDA_mem->ida_tempv1); + if (pdata->tempv4 == NULL){ + N_VDestroy(pdata->rlocal); + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->tempv1); + N_VDestroy(pdata->tempv2); + N_VDestroy(pdata->tempv3); + SUNMatDestroy(pdata->PP); + free(pdata); pdata = NULL; + IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDABBDPRE", + "IDABBDPrecInit", MSGBBD_MEM_FAIL); + return(IDALS_MEM_FAIL); + } + + /* Allocate memory for banded linear solver */ + pdata->LS = NULL; + pdata->LS = SUNLinSol_Band(pdata->rlocal, pdata->PP); + if (pdata->LS == NULL) { + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->rlocal); + N_VDestroy(pdata->tempv1); + N_VDestroy(pdata->tempv2); + N_VDestroy(pdata->tempv3); + N_VDestroy(pdata->tempv4); + SUNMatDestroy(pdata->PP); + free(pdata); pdata = NULL; + IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDABBDPRE", + "IDABBDPrecInit", MSGBBD_MEM_FAIL); + return(IDALS_MEM_FAIL); + } + + /* initialize band linear solver object */ + flag = SUNLinSolInitialize(pdata->LS); + if (flag != SUNLS_SUCCESS) { + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->rlocal); + N_VDestroy(pdata->tempv1); + N_VDestroy(pdata->tempv2); + N_VDestroy(pdata->tempv3); + N_VDestroy(pdata->tempv4); + SUNMatDestroy(pdata->PP); + SUNLinSolFree(pdata->LS); + free(pdata); pdata = NULL; + IDAProcessError(IDA_mem, IDALS_SUNLS_FAIL, "IDABBDPRE", + "IDABBDPrecInit", MSGBBD_SUNLS_FAIL); + return(IDALS_SUNLS_FAIL); + } + + /* Set rel_yy based on input value dq_rel_yy (0 implies default). */ + pdata->rel_yy = (dq_rel_yy > ZERO) ? + dq_rel_yy : SUNRsqrt(IDA_mem->ida_uround); + + /* Store Nlocal to be used in IDABBDPrecSetup */ + pdata->n_local = Nlocal; + + /* Set work space sizes and initialize nge. */ + pdata->rpwsize = 0; + pdata->ipwsize = 0; + if (IDA_mem->ida_tempv1->ops->nvspace) { + N_VSpace(IDA_mem->ida_tempv1, &lrw1, &liw1); + pdata->rpwsize += 4*lrw1; + pdata->ipwsize += 4*liw1; + } + if (pdata->rlocal->ops->nvspace) { + N_VSpace(pdata->rlocal, &lrw1, &liw1); + pdata->rpwsize += 2*lrw1; + pdata->ipwsize += 2*liw1; + } + if (pdata->PP->ops->space) { + flag = SUNMatSpace(pdata->PP, &lrw, &liw); + pdata->rpwsize += lrw; + pdata->ipwsize += liw; + } + if (pdata->LS->ops->space) { + flag = SUNLinSolSpace(pdata->LS, &lrw, &liw); + pdata->rpwsize += lrw; + pdata->ipwsize += liw; + } + pdata->nge = 0; + + /* make sure pdata is free from any previous allocations */ + if (idals_mem->pfree) + idals_mem->pfree(IDA_mem); + + /* Point to the new pdata field in the LS memory */ + idals_mem->pdata = pdata; + + /* Attach the pfree function */ + idals_mem->pfree = IDABBDPrecFree; + + /* Attach preconditioner solve and setup functions */ + flag = IDASetPreconditioner(ida_mem, + IDABBDPrecSetup, + IDABBDPrecSolve); + + return(flag); +} + + +/*-------------------------------------------------------------*/ +int IDABBDPrecReInit(void *ida_mem, sunindextype mudq, + sunindextype mldq, realtype dq_rel_yy) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + IBBDPrecData pdata; + sunindextype Nlocal; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDALS_MEM_NULL, "IDABBDPRE", + "IDABBDPrecReInit", MSGBBD_MEM_NULL); + return(IDALS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Test if the LS linear solver interface has been created */ + if (IDA_mem->ida_lmem == NULL) { + IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDABBDPRE", + "IDABBDPrecReInit", MSGBBD_LMEM_NULL); + return(IDALS_LMEM_NULL); + } + idals_mem = (IDALsMem) IDA_mem->ida_lmem; + + /* Test if the preconditioner data is non-NULL */ + if (idals_mem->pdata == NULL) { + IDAProcessError(IDA_mem, IDALS_PMEM_NULL, "IDABBDPRE", + "IDABBDPrecReInit", MSGBBD_PMEM_NULL); + return(IDALS_PMEM_NULL); + } + pdata = (IBBDPrecData) idals_mem->pdata; + + /* Load half-bandwidths. */ + Nlocal = pdata->n_local; + pdata->mudq = SUNMIN(Nlocal-1, SUNMAX(0, mudq)); + pdata->mldq = SUNMIN(Nlocal-1, SUNMAX(0, mldq)); + + /* Set rel_yy based on input value dq_rel_yy (0 implies default). */ + pdata->rel_yy = (dq_rel_yy > ZERO) ? + dq_rel_yy : SUNRsqrt(IDA_mem->ida_uround); + + /* Re-initialize nge */ + pdata->nge = 0; + + return(IDALS_SUCCESS); +} + + +/*-------------------------------------------------------------*/ +int IDABBDPrecGetWorkSpace(void *ida_mem, + long int *lenrwBBDP, + long int *leniwBBDP) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + IBBDPrecData pdata; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDALS_MEM_NULL, "IDABBDPRE", + "IDABBDPrecGetWorkSpace", MSGBBD_MEM_NULL); + return(IDALS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (IDA_mem->ida_lmem == NULL) { + IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDABBDPRE", + "IDABBDPrecGetWorkSpace", MSGBBD_LMEM_NULL); + return(IDALS_LMEM_NULL); + } + idals_mem = (IDALsMem) IDA_mem->ida_lmem; + + if (idals_mem->pdata == NULL) { + IDAProcessError(IDA_mem, IDALS_PMEM_NULL, "IDABBDPRE", + "IDABBDPrecGetWorkSpace", MSGBBD_PMEM_NULL); + return(IDALS_PMEM_NULL); + } + pdata = (IBBDPrecData) idals_mem->pdata; + + *lenrwBBDP = pdata->rpwsize; + *leniwBBDP = pdata->ipwsize; + + return(IDALS_SUCCESS); +} + + +/*-------------------------------------------------------------*/ +int IDABBDPrecGetNumGfnEvals(void *ida_mem, + long int *ngevalsBBDP) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + IBBDPrecData pdata; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDALS_MEM_NULL, "IDABBDPRE", + "IDABBDPrecGetNumGfnEvals", MSGBBD_MEM_NULL); + return(IDALS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (IDA_mem->ida_lmem == NULL) { + IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDABBDPRE", + "IDABBDPrecGetNumGfnEvals", MSGBBD_LMEM_NULL); + return(IDALS_LMEM_NULL); + } + idals_mem = (IDALsMem) IDA_mem->ida_lmem; + + if (idals_mem->pdata == NULL) { + IDAProcessError(IDA_mem, IDALS_PMEM_NULL, "IDABBDPRE", + "IDABBDPrecGetNumGfnEvals", MSGBBD_PMEM_NULL); + return(IDALS_PMEM_NULL); + } + pdata = (IBBDPrecData) idals_mem->pdata; + + *ngevalsBBDP = pdata->nge; + + return(IDALS_SUCCESS); +} + + +/*--------------------------------------------------------------- + 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. + + bbd_data is the pointer to BBD memory set by IDABBDInit + + The argument rr is 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), or + < 0 for a nonrecoverable error (step fails). + ----------------------------------------------------------------*/ +static int IDABBDPrecSetup(realtype tt, N_Vector yy, N_Vector yp, + N_Vector rr, realtype c_j, void *bbd_data) +{ + IBBDPrecData pdata; + IDAMem IDA_mem; + int retval; + + pdata =(IBBDPrecData) bbd_data; + + IDA_mem = (IDAMem) pdata->ida_mem; + + /* Call IBBDDQJac for a new Jacobian calculation and store in PP. */ + retval = SUNMatZero(pdata->PP); + retval = IBBDDQJac(pdata, tt, c_j, yy, yp, pdata->tempv1, + pdata->tempv2, pdata->tempv3, pdata->tempv4); + if (retval < 0) { + IDAProcessError(IDA_mem, -1, "IDABBDPRE", "IDABBDPrecSetup", + MSGBBD_FUNC_FAILED); + return(-1); + } + if (retval > 0) { + return(1); + } + + /* Do LU factorization of matrix and return error flag */ + retval = SUNLinSolSetup_Band(pdata->LS, pdata->PP); + return(retval); +} + + +/*--------------------------------------------------------------- + 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. + + bbd_data is the pointer to BBD data set by IDABBDInit. + + The arguments tt, yy, yp, rr, c_j and delta are NOT used. + + IDABBDPrecSolve returns the value returned from the linear + solver object. + ---------------------------------------------------------------*/ +static 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 *bbd_data) +{ + IBBDPrecData pdata; + int retval; + + pdata = (IBBDPrecData) bbd_data; + + /* Attach local data arrays for rvec and zvec to rlocal and zlocal */ + N_VSetArrayPointer(N_VGetArrayPointer(rvec), pdata->rlocal); + N_VSetArrayPointer(N_VGetArrayPointer(zvec), pdata->zlocal); + + /* Call banded solver object to do the work */ + retval = SUNLinSolSolve(pdata->LS, pdata->PP, pdata->zlocal, + pdata->rlocal, ZERO); + + /* Detach local data arrays from rlocal and zlocal */ + N_VSetArrayPointer(NULL, pdata->rlocal); + N_VSetArrayPointer(NULL, pdata->zlocal); + + return(retval); +} + + +/*-------------------------------------------------------------*/ +static int IDABBDPrecFree(IDAMem IDA_mem) +{ + IDALsMem idals_mem; + IBBDPrecData pdata; + + if (IDA_mem->ida_lmem == NULL) return(0); + idals_mem = (IDALsMem) IDA_mem->ida_lmem; + + if (idals_mem->pdata == NULL) return(0); + pdata = (IBBDPrecData) idals_mem->pdata; + + SUNLinSolFree(pdata->LS); + N_VDestroy(pdata->rlocal); + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->tempv1); + N_VDestroy(pdata->tempv2); + N_VDestroy(pdata->tempv3); + N_VDestroy(pdata->tempv4); + SUNMatDestroy(pdata->PP); + + free(pdata); + pdata = NULL; + + 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 SUNMatrix 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). + ----------------------------------------------------------------*/ +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; + sunindextype 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 = (IDAMem) 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(IDA_mem->ida_ewt); + if (IDA_mem->ida_constraintsSet) + cnsdata = N_VGetArrayPointer(IDA_mem->ida_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 (pdata->gcomm != NULL) { + retval = pdata->gcomm(pdata->n_local, tt, yy, yp, IDA_mem->ida_user_data); + if (retval != 0) return(retval); + } + + retval = pdata->glocal(pdata->n_local, tt, yy, yp, gref, IDA_mem->ida_user_data); + pdata->nge++; + if (retval != 0) return(retval); + + /* Set bandwidth and number of column groups for band differencing. */ + width = pdata->mldq + pdata->mudq + 1; + ngroups = SUNMIN(width, pdata->n_local); + + /* Loop over groups. */ + for(group = 1; group <= ngroups; group++) { + + /* Loop over the components in this group. */ + for(j = group-1; j < pdata->n_local; 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 = pdata->rel_yy * + SUNMAX(SUNRabs(yj), SUNMAX( SUNRabs(IDA_mem->ida_hh*ypj), ONE/ewtj)); + if (IDA_mem->ida_hh*ypj < ZERO) inc = -inc; + inc = (yj + inc) - yj; + + /* Adjust sign(inc) again if yj has an inequality constraint. */ + if (IDA_mem->ida_constraintsSet) { + conj = cnsdata[j]; + if (SUNRabs(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} + else if (SUNRabs(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 = pdata->glocal(pdata->n_local, tt, ytemp, yptemp, + gtemp, IDA_mem->ida_user_data); + pdata->nge++; + if (retval != 0) return(retval); + + /* Loop over components of the group again; restore ytemp and yptemp. */ + for(j = group-1; j < pdata->n_local; j += width) { + yj = ytempdata[j] = ydata[j]; + ypj = yptempdata[j] = ypdata[j]; + ewtj = ewtdata[j]; + + /* Set increment inc as before .*/ + inc = pdata->rel_yy * + SUNMAX(SUNRabs(yj), SUNMAX( SUNRabs(IDA_mem->ida_hh*ypj), ONE/ewtj)); + if (IDA_mem->ida_hh*ypj < ZERO) inc = -inc; + inc = (yj + inc) - yj; + if (IDA_mem->ida_constraintsSet) { + conj = cnsdata[j]; + if (SUNRabs(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} + else if (SUNRabs(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} + } + + /* Form difference quotients and load into PP. */ + inc_inv = ONE/inc; + col_j = SUNBandMatrix_Column(pdata->PP,j); + i1 = SUNMAX(0, j - pdata->mukeep); + i2 = SUNMIN(j + pdata->mlkeep, pdata->n_local-1); + for(i=i1; i <= i2; i++) + SM_COLUMN_ELEMENT_B(col_j,i,j) = + inc_inv * (gtempdata[i] - grefdata[i]); + } + } + + return(0); +} diff --git a/bazaar/plugin/sundials/src/ida/ida_bbdpre_impl.h b/bazaar/plugin/sundials/src/ida/ida_bbdpre_impl.h new file mode 100644 index 000000000..1ab20fa1b --- /dev/null +++ b/bazaar/plugin/sundials/src/ida/ida_bbdpre_impl.h @@ -0,0 +1,88 @@ +/*----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * Alan C. Hindmarsh and Radu Serban @ LLNL + *----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *----------------------------------------------------------------- + * 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 + * and an IDASPILS linear solver. + *-----------------------------------------------------------------*/ + +#ifndef _IDABBDPRE_IMPL_H +#define _IDABBDPRE_IMPL_H + +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ----------------------------------------------------------------- + * Definition of IBBDPrecData + * ----------------------------------------------------------------- + */ + +typedef struct IBBDPrecDataRec { + + /* passed by user to IDABBDPrecAlloc and used by + IDABBDPrecSetup/IDABBDPrecSolve functions */ + sunindextype mudq, mldq, mukeep, mlkeep; + realtype rel_yy; + IDABBDLocalFn glocal; + IDABBDCommFn gcomm; + + /* set by IDABBDPrecSetup and used by IDABBDPrecSetup and + IDABBDPrecSolve functions */ + sunindextype n_local; + SUNMatrix PP; + SUNLinearSolver LS; + N_Vector zlocal; + N_Vector rlocal; + N_Vector tempv1; + N_Vector tempv2; + N_Vector tempv3; + N_Vector tempv4; + + /* available for optional output */ + long int rpwsize; + long int ipwsize; + long int nge; + + /* pointer to ida_mem */ + void *ida_mem; + +} *IBBDPrecData; + +/* + * ----------------------------------------------------------------- + * IDABBDPRE error messages + * ----------------------------------------------------------------- + */ + +#define MSGBBD_MEM_NULL "Integrator memory is NULL." +#define MSGBBD_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." +#define MSGBBD_MEM_FAIL "A memory request failed." +#define MSGBBD_BAD_NVECTOR "A required vector operation is not implemented." +#define MSGBBD_SUNMAT_FAIL "An error arose from a SUNBandMatrix routine." +#define MSGBBD_SUNLS_FAIL "An error arose from a SUNBandLinearSolver routine." +#define MSGBBD_PMEM_NULL "BBD peconditioner memory is NULL. IDABBDPrecInit must be called." +#define MSGBBD_FUNC_FAILED "The Glocal or Gcomm routine failed in an unrecoverable manner." + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/ida/ida_direct.c b/bazaar/plugin/sundials/src/ida/ida_direct.c new file mode 100644 index 000000000..39fc4d882 --- /dev/null +++ b/bazaar/plugin/sundials/src/ida/ida_direct.c @@ -0,0 +1,56 @@ +/*----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * Radu Serban @ LLNL + *----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *----------------------------------------------------------------- + * Implementation file for the deprecated direct linear solver interface in + * IDA; these routines now just wrap the updated IDA generic + * linear solver interface in ida_ls.h. + *-----------------------------------------------------------------*/ + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/*================================================================= + Exported Functions (wrappers for equivalent routines in ida_ls.h) + =================================================================*/ + +int IDADlsSetLinearSolver(void *ida_mem, SUNLinearSolver LS, SUNMatrix A) +{ return(IDASetLinearSolver(ida_mem, LS, A)); } + +int IDADlsSetJacFn(void *ida_mem, IDADlsJacFn jac) +{ return(IDASetJacFn(ida_mem, jac)); } + +int IDADlsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS) +{ return(IDAGetLinWorkSpace(ida_mem, lenrwLS, leniwLS)); } + +int IDADlsGetNumJacEvals(void *ida_mem, long int *njevals) +{ return(IDAGetNumJacEvals(ida_mem, njevals)); } + +int IDADlsGetNumResEvals(void *ida_mem, long int *nfevalsLS) +{ return(IDAGetNumLinResEvals(ida_mem, nfevalsLS)); } + +int IDADlsGetLastFlag(void *ida_mem, long int *flag) +{ return(IDAGetLastLinFlag(ida_mem, flag)); } + +char *IDADlsGetReturnFlagName(long int flag) +{ return(IDAGetLinReturnFlagName(flag)); } + + +#ifdef __cplusplus +} +#endif + diff --git a/bazaar/plugin/sundials/src/ida/ida_ic.c b/bazaar/plugin/sundials/src/ida/ida_ic.c new file mode 100644 index 000000000..5ecd6b7c1 --- /dev/null +++ b/bazaar/plugin/sundials/src/ida/ida_ic.c @@ -0,0 +1,704 @@ +/* + * ----------------------------------------------------------------- + * $Revision$ + * $Date$ + * ----------------------------------------------------------------- + * Programmers: Alan C. Hindmarsh, and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * 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 + +/* + * ================================================================= + * 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 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); + +/* + * ================================================================= + * EXPORTED FUNCTIONS IMPLEMENTATION + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * IDACalcIC + * ----------------------------------------------------------------- + * IDACalcIC computes consistent initial conditions, given the + * user's initial guess for unknown components of yy0 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 (either on steptol test + * or on the maxbacks test) + * IDA_CONV_FAIL the Newton iterations failed to converge + * ----------------------------------------------------------------- + */ + +int IDACalcIC(void *ida_mem, int icopt, realtype tout1) +{ + int 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) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDACalcIC", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Check if problem was malloc'ed */ + + if(IDA_mem->ida_MallocDone == SUNFALSE) { + IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDACalcIC", MSG_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 = SUNTRUE; + + /* Check legality of input arguments, and set IDA memory copies. */ + + if(icopt != IDA_YA_YDP_INIT && icopt != IDA_Y_INIT) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_BAD_ICOPT); + return(IDA_ILL_INPUT); + } + IDA_mem->ida_icopt = icopt; + + if(icopt == IDA_YA_YDP_INIT && (IDA_mem->ida_id == NULL)) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_MISSING_ID); + return(IDA_ILL_INPUT); + } + + tdist = SUNRabs(tout1 - IDA_mem->ida_tn); + troundoff = TWO * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(tout1)); + if(tdist < troundoff) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_TOO_CLOSE); + return(IDA_ILL_INPUT); + } + + /* Allocate space and initialize temporary vectors */ + + IDA_mem->ida_yy0 = N_VClone(IDA_mem->ida_ee); + IDA_mem->ida_yp0 = N_VClone(IDA_mem->ida_ee); + IDA_mem->ida_t0 = IDA_mem->ida_tn; + N_VScale(ONE, IDA_mem->ida_phi[0], IDA_mem->ida_yy0); + N_VScale(ONE, IDA_mem->ida_phi[1], IDA_mem->ida_yp0); + + /* 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(IDA_mem->ida_id); + if(minid < ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", 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 = IDA_mem->ida_epiccon; + + /* Initializations: + cjratio = 1 (for use in direct linear solvers); + set nbacktr = 0; */ + + IDA_mem->ida_cjratio = ONE; + IDA_mem->ida_nbacktr = 0; + + /* Set hic, hh, cj, and mxnh. */ + + hic = PT001*tdist; + ypnorm = IDAWrmsNorm(IDA_mem, IDA_mem->ida_yp0, + IDA_mem->ida_ewt, IDA_mem->ida_suppressalg); + if(ypnorm > HALF/hic) hic = HALF/ypnorm; + if(tout1 < IDA_mem->ida_tn) hic = -hic; + IDA_mem->ida_hh = hic; + if(icopt == IDA_YA_YDP_INIT) { + IDA_mem->ida_cj = ONE/hic; + mxnh = IDA_mem->ida_maxnh; + } + else { + IDA_mem->ida_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; + IDA_mem->ida_ncfn++; + if(retval < 0) break; + if(nh == mxnh) break; + /* If looping to try again, reset yy0 and yp0 if not converging. */ + if(retval != IC_SLOW_CONVRG) { + N_VScale(ONE, IDA_mem->ida_phi[0], IDA_mem->ida_yy0); + N_VScale(ONE, IDA_mem->ida_phi[1], IDA_mem->ida_yp0); + } + hic *= PT1; + IDA_mem->ida_cj = ONE/hic; + IDA_mem->ida_hh = hic; + } /* End of nh loop */ + + /* Break on failure; else reset ewt, save yy0, yp0 in phi, and loop. */ + if(retval != IDA_SUCCESS) break; + ewtsetOK = IDA_mem->ida_efun(IDA_mem->ida_yy0, IDA_mem->ida_ewt, + IDA_mem->ida_edata); + if(ewtsetOK != 0) { + retval = IDA_BAD_EWT; + break; + } + N_VScale(ONE, IDA_mem->ida_yy0, IDA_mem->ida_phi[0]); + N_VScale(ONE, IDA_mem->ida_yp0, IDA_mem->ida_phi[1]); + + } /* End of nwt loop */ + + /* Free temporary space */ + + N_VDestroy(IDA_mem->ida_yy0); + N_VDestroy(IDA_mem->ida_yp0); + + /* Load the optional outputs. */ + + if(icopt == IDA_YA_YDP_INIT) IDA_mem->ida_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 + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * 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 (either on steptol test + * or on maxbacks 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 + * IDA_LSETUP_FAIL 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 = IDA_mem->ida_ee; + tv2 = IDA_mem->ida_tempv2; + tv3 = IDA_mem->ida_phi[2]; + + retval = IDA_mem->ida_res(IDA_mem->ida_t0, IDA_mem->ida_yy0, + IDA_mem->ida_yp0, IDA_mem->ida_delta, + IDA_mem->ida_user_data); + IDA_mem->ida_nre++; + if(retval < 0) return(IDA_RES_FAIL); + if(retval > 0) return(IDA_FIRST_RES_FAIL); + + N_VScale(ONE, IDA_mem->ida_delta, IDA_mem->ida_savres); + + /* Loop over nj = number of linear solve Jacobian setups. */ + + for(nj = 1; nj <= IDA_mem->ida_maxnj; nj++) { + + /* If there is a setup routine, call it. */ + if(IDA_mem->ida_lsetup) { + IDA_mem->ida_nsetups++; + retval = IDA_mem->ida_lsetup(IDA_mem, IDA_mem->ida_yy0, + IDA_mem->ida_yp0, IDA_mem->ida_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 && IDA_mem->ida_lsetup) { + N_VScale(ONE, IDA_mem->ida_savres, IDA_mem->ida_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 (either on steptol test + * or on maxbacks 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; + + /* Set pointer for vector delnew */ + IDA_mem->ida_delnew = IDA_mem->ida_phi[2]; + + /* Call the linear solve function to get the Newton step, delta. */ + retval = IDA_mem->ida_lsolve(IDA_mem, IDA_mem->ida_delta, + IDA_mem->ida_ewt, IDA_mem->ida_yy0, + IDA_mem->ida_yp0, IDA_mem->ida_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, IDA_mem->ida_delta, IDA_mem->ida_ewt, SUNFALSE); + if(IDA_mem->ida_sysindex == 0) + fnorm *= IDA_mem->ida_tscale * SUNRabs(IDA_mem->ida_cj); + if(fnorm <= IDA_mem->ida_epsNewt) + return(IDA_SUCCESS); + fnorm0 = fnorm; + + /* Initialize rate to avoid compiler warning message */ + rate = ZERO; + + /* Newton iteration loop */ + + for(mnewt = 0; mnewt < IDA_mem->ida_maxnit; mnewt++) { + + IDA_mem->ida_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 <= IDA_mem->ida_epsNewt) return(IDA_SUCCESS); + + /* If not converged, copy new step vector, and loop. */ + N_VScale(ONE, IDA_mem->ida_delnew, IDA_mem->ida_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, yy0 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, yy0, 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 (either on steptol test + * or on maxbacks 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, nbacks; + 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 = IDA_mem->ida_ee; + IDA_mem->ida_dtemp = IDA_mem->ida_phi[3]; + IDA_mem->ida_ynew = IDA_mem->ida_tempv2; + IDA_mem->ida_ypnew = IDA_mem->ida_ee; + f1norm = (*fnorm)*(*fnorm)*HALF; + ratio = ONE; + + /* If there are constraints, check and reduce step if necessary. */ + if(IDA_mem->ida_constraintsSet) { + + /* Update y and check constraints. */ + IDANewy(IDA_mem); + conOK = N_VConstrMask(IDA_mem->ida_constraints, IDA_mem->ida_ynew, mc); + + if(!conOK) { + /* Not satisfied. Compute scaled step to satisfy constraints. */ + N_VProd(mc, IDA_mem->ida_delta, IDA_mem->ida_dtemp); + ratio = PT99*N_VMinQuotient(IDA_mem->ida_yy0, IDA_mem->ida_dtemp); + (*delnorm) *= ratio; + if((*delnorm) <= IDA_mem->ida_steptol) return(IC_CONSTR_FAILED); + N_VScale(ratio, IDA_mem->ida_delta, IDA_mem->ida_delta); + } + + } /* End of constraints check */ + + slpi = -TWO*f1norm*ratio; + minlam = IDA_mem->ida_steptol / (*delnorm); + lambda = ONE; + nbacks = 0; + + /* In IDA_Y_INIT case, set ypnew = yp0 (fixed) for linesearch. */ + if(IDA_mem->ida_icopt == IDA_Y_INIT) + N_VScale(ONE, IDA_mem->ida_yp0, IDA_mem->ida_ypnew); + + /* Loop on linesearch variable lambda. */ + + for(;;) { + + if (nbacks == IDA_mem->ida_maxbacks) return(IC_LINESRCH_FAILED); + /* 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(IDA_mem->ida_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; + IDA_mem->ida_nbacktr++; nbacks++; + + } /* End of breakout linesearch loop */ + + /* Update yy0, yp0, and fnorm, then return. */ + N_VScale(ONE, IDA_mem->ida_ynew, IDA_mem->ida_yy0); + if(IDA_mem->ida_icopt == IDA_YA_YDP_INIT) + N_VScale(ONE, IDA_mem->ida_ypnew, IDA_mem->ida_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 = IDA_mem->ida_res(IDA_mem->ida_t0, IDA_mem->ida_ynew, + IDA_mem->ida_ypnew, IDA_mem->ida_delnew, + IDA_mem->ida_user_data); + IDA_mem->ida_nre++; + if(retval < 0) return(IDA_RES_FAIL); + if(retval > 0) return(IC_FAIL_RECOV); + + N_VScale(ONE, IDA_mem->ida_delnew, IDA_mem->ida_savres); + + /* Call the linear solve function to get J-inverse F; return if failed. */ + retval = IDA_mem->ida_lsolve(IDA_mem, IDA_mem->ida_delnew, + IDA_mem->ida_ewt, IDA_mem->ida_ynew, + IDA_mem->ida_ypnew, IDA_mem->ida_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, IDA_mem->ida_delnew, IDA_mem->ida_ewt, SUNFALSE); + if(IDA_mem->ida_sysindex == 0) + (*fnorm) *= IDA_mem->ida_tscale * SUNRabs(IDA_mem->ida_cj); + + return(IDA_SUCCESS); + +} + +/* + * ----------------------------------------------------------------- + * IDANewyyp + * ----------------------------------------------------------------- + * IDANewyyp updates the vectors ynew and ypnew from yy0 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 = yy0 - lambda*delta where id_i = 0 + ypnew = yp0 - cj*lambda*delta where id_i = 1. */ + if(IDA_mem->ida_icopt == IDA_YA_YDP_INIT) { + N_VProd(IDA_mem->ida_id, IDA_mem->ida_delta, IDA_mem->ida_dtemp); + N_VLinearSum(ONE, IDA_mem->ida_yp0, -IDA_mem->ida_cj*lambda, + IDA_mem->ida_dtemp, IDA_mem->ida_ypnew); + N_VLinearSum(ONE, IDA_mem->ida_delta, -ONE, + IDA_mem->ida_dtemp, IDA_mem->ida_dtemp); + N_VLinearSum(ONE, IDA_mem->ida_yy0, -lambda, + IDA_mem->ida_dtemp, IDA_mem->ida_ynew); + return(IDA_SUCCESS); + } + + /* IDA_Y_INIT case: ynew = yy0 - lambda*delta. (ypnew = yp0 preset.) */ + N_VLinearSum(ONE, IDA_mem->ida_yy0, -lambda, + IDA_mem->ida_delta, IDA_mem->ida_ynew); + return(IDA_SUCCESS); + +} + +/* + * ----------------------------------------------------------------- + * IDANewy + * ----------------------------------------------------------------- + * IDANewy updates the vector ynew from yy0, + * 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 = yy0 - delta where id_i = 0. */ + if(IDA_mem->ida_icopt == IDA_YA_YDP_INIT) { + N_VProd(IDA_mem->ida_id, IDA_mem->ida_delta, IDA_mem->ida_dtemp); + N_VLinearSum(ONE, IDA_mem->ida_delta, -ONE, + IDA_mem->ida_dtemp, IDA_mem->ida_dtemp); + N_VLinearSum(ONE, IDA_mem->ida_yy0, -ONE, + IDA_mem->ida_dtemp, IDA_mem->ida_ynew); + return(IDA_SUCCESS); + } + + /* IDA_Y_INIT case: ynew = yy0 - delta. */ + N_VLinearSum(ONE, IDA_mem->ida_yy0, -ONE, + IDA_mem->ida_delta, IDA_mem->ida_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: + IDAProcessError(IDA_mem, IDA_RES_FAIL, "IDA", "IDACalcIC", MSG_IC_RES_NONREC); + return(IDA_RES_FAIL); + + case IDA_FIRST_RES_FAIL: + IDAProcessError(IDA_mem, IDA_FIRST_RES_FAIL, "IDA", "IDACalcIC", MSG_IC_RES_FAIL); + return(IDA_FIRST_RES_FAIL); + + case IDA_LSETUP_FAIL: + IDAProcessError(IDA_mem, IDA_LSETUP_FAIL, "IDA", "IDACalcIC", MSG_IC_SETUP_FAIL); + return(IDA_LSETUP_FAIL); + + case IDA_LSOLVE_FAIL: + IDAProcessError(IDA_mem, IDA_LSOLVE_FAIL, "IDA", "IDACalcIC", MSG_IC_SOLVE_FAIL); + return(IDA_LSOLVE_FAIL); + + case IC_FAIL_RECOV: + IDAProcessError(IDA_mem, IDA_NO_RECOVERY, "IDA", "IDACalcIC", MSG_IC_NO_RECOVERY); + return(IDA_NO_RECOVERY); + + case IC_CONSTR_FAILED: + IDAProcessError(IDA_mem, IDA_CONSTR_FAIL, "IDA", "IDACalcIC", MSG_IC_FAIL_CONSTR); + return(IDA_CONSTR_FAIL); + + case IC_LINESRCH_FAILED: + IDAProcessError(IDA_mem, IDA_LINESEARCH_FAIL, "IDA", "IDACalcIC", MSG_IC_FAILED_LINS); + return(IDA_LINESEARCH_FAIL); + + case IC_CONV_FAIL: + IDAProcessError(IDA_mem, IDA_CONV_FAIL, "IDA", "IDACalcIC", MSG_IC_CONV_FAILED); + return(IDA_CONV_FAIL); + + case IC_SLOW_CONVRG: + IDAProcessError(IDA_mem, IDA_CONV_FAIL, "IDA", "IDACalcIC", MSG_IC_CONV_FAILED); + return(IDA_CONV_FAIL); + + case IDA_BAD_EWT: + IDAProcessError(IDA_mem, IDA_BAD_EWT, "IDA", "IDACalcIC", MSG_IC_BAD_EWT); + return(IDA_BAD_EWT); + + } + return -99; +} + diff --git a/bazaar/plugin/sundials/src/ida/ida_impl.h b/bazaar/plugin/sundials/src/ida/ida_impl.h new file mode 100644 index 000000000..ea9824803 --- /dev/null +++ b/bazaar/plugin/sundials/src/ida/ida_impl.h @@ -0,0 +1,527 @@ +/* + * ----------------------------------------------------------------- + * $Revision$ + * $Date$ + * ----------------------------------------------------------------- + * Programmer(s): Allan G. Taylor, Alan C. Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file (private version) for the main IDA solver. + * ----------------------------------------------------------------- + */ + +#ifndef _IDA_IMPL_H +#define _IDA_IMPL_H + +#include + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ================================================================= + * 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 IDA constants */ + +#define HMAX_INV_DEFAULT RCONST(0.0) /* hmax_inv default value */ +#define MAXORD_DEFAULT 5 /* maxord default value */ +#define MXORDP1 6 /* max. number of N_Vectors in phi */ +#define MXSTEP_DEFAULT 500 /* mxstep default value */ + +/* Return values for lower level routines used by IDASolve and functions + provided to the nonlinear solver */ + +#define IDA_RES_RECVR +1 +#define IDA_LSETUP_RECVR +2 +#define IDA_LSOLVE_RECVR +3 +#define IDA_CONSTR_RECVR +5 +#define IDA_NLS_SETUP_RECVR +6 + +/* + * ---------------------------------------------------------------- + * 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_user_data; /* user pointer passed to res */ + + int ida_itol; /* itol = IDA_SS, IDA_SV, IDA_WF, IDA_NN */ + realtype ida_rtol; /* relative tolerance */ + realtype ida_Satol; /* scalar absolute tolerance */ + N_Vector ida_Vatol; /* vector absolute tolerance */ + booleantype ida_atolmin0; /* flag indicating that min(atol) = 0 */ + booleantype ida_user_efun; /* SUNTRUE if user provides efun */ + IDAEwtFn ida_efun; /* function to set ewt */ + void *ida_edata; /* user pointer passed to efun */ + + + booleantype ida_constraintsSet; /* constraints vector present: + do constraints calc */ + booleantype ida_suppressalg; /* SUNTRUE 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_yy; /* work space for y vector (= user's yret) */ + N_Vector ida_yp; /* work space for y' vector (= user's ypret) */ + N_Vector ida_yypredict; /* predicted y vector */ + N_Vector ida_yppredict; /* predicted y' vector */ + 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 */ + N_Vector ida_ee; /* accumulated corrections to y vector, but + set equal to estimated local errors upon + successful return */ + N_Vector ida_tempv1; /* work space vector */ + N_Vector ida_tempv2; /* work space vector */ + N_Vector ida_tempv3; /* 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]) */ + + /* Variables for use by IDACalcIC*/ + + realtype ida_t0; /* initial t */ + N_Vector ida_yy0; /* initial y vector (user-supplied). */ + N_Vector ida_yp0; /* initial y' vector (user-supplied). */ + + 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) */ + int ida_maxbacks; /* max backtracks per Newton step */ + 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_tretlast; /* 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_oldnrm; /* norm of previous nonlinear solver update */ + 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_maxnef; /* max number of error test failures */ + + int ida_maxord; /* max value of method order k: */ + int ida_maxord_alloc; /* value of maxord used when allocating memory */ + 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 */ + + sunindextype ida_lrw1; /* no. of realtype words in 1 N_Vector */ + sunindextype 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) */ + + /* Error handler function and error ouput file */ + + IDAErrHandlerFn ida_ehfun; /* Error messages are handled by ehfun */ + void *ida_eh_data; /* dats pointer passed to ehfun */ + FILE *ida_errfp; /* IDA error messages are sent to errfp */ + + /* Flags to verify correct calling sequence */ + + booleantype ida_SetupDone; /* set to SUNFALSE by IDAMalloc and IDAReInit + set to SUNTRUE by IDACalcIC or IDASolve */ + + booleantype ida_VatolMallocDone; + booleantype ida_constraintsMallocDone; + booleantype ida_idMallocDone; + + booleantype ida_MallocDone; /* set to SUNFALSE by IDACreate + set to SUNTRUE by IDAMAlloc + tested by IDAReInit and IDASolve */ + + /* Nonlinear Solver */ + + SUNNonlinearSolver NLS; /* Sundials generic nonlinear solver object */ + booleantype ownNLS; /* flag indicating if IDA created the nonlinear + solver object */ + + /* 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; + + /* Rootfinding Data */ + + IDARootFn ida_gfun; /* Function g for roots sought */ + int ida_nrtfn; /* number of components of g */ + int *ida_iroots; /* array for root information */ + int *ida_rootdir; /* array specifying direction of zero-crossing */ + realtype ida_tlo; /* nearest endpoint of interval in root search */ + realtype ida_thi; /* farthest endpoint of interval in root search */ + realtype ida_trout; /* t return value from rootfinder routine */ + realtype *ida_glo; /* saved array of g values at t = tlo */ + realtype *ida_ghi; /* saved array of g values at t = thi */ + realtype *ida_grout; /* array of g values at t = trout */ + realtype ida_toutc; /* copy of tout (if NORMAL mode) */ + realtype ida_ttol; /* tolerance on root location */ + int ida_taskc; /* copy of parameter itask */ + int ida_irfnd; /* flag showing whether last step had a root */ + long int ida_nge; /* counter for g evaluations */ + booleantype *ida_gactive; /* array with active/inactive event functions */ + int ida_mxgnull; /* number of warning messages about possible g==0 */ + + /* Arrays for Fused Vector Operations */ + + realtype ida_cvals[MXORDP1]; + realtype ida_dvals[MAXORD_DEFAULT]; + + N_Vector ida_Xvecs[MXORDP1]; + N_Vector ida_Zvecs[MXORDP1]; + +} *IDAMem; + +/* + * ================================================================= + * 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 non-zero value otherwise. If an error does occur, an appropriate + * message should be sent to the error handler function. + * ---------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * 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. It should + * return 0 upon success, nonzero on failure. + * ----------------------------------------------------------------- + */ + +/* + * ================================================================= + * I D A I N T E R N A L F U N C T I O N S + * ================================================================= + */ + +/* Prototype of internal ewtSet function */ + +int IDAEwtSet(N_Vector ycur, N_Vector weight, void *data); + +/* High level error handler */ + +void IDAProcessError(IDAMem IDA_mem, + int error_code, const char *module, const char *fname, + const char *msgfmt, ...); + +/* Prototype of internal errHandler function */ + +void IDAErrHandler(int error_code, const char *module, const char *function, + char *msg, void *data); + +/* Norm functions */ + +realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w, booleantype mask); + +/* Nonlinear solver initialization function */ + +int idaNlsInit(IDAMem IDA_mem); + +/* + * ================================================================= + * I D A 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." +#define MSG_TIME_TOUT "tout = %Lg" +#define MSG_TIME_TSTOP "tstop = %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." +#define MSG_TIME_TOUT "tout = %lg" +#define MSG_TIME_TSTOP "tstop = %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." +#define MSG_TIME_TOUT "tout = %g" +#define MSG_TIME_TSTOP "tstop = %g" + +#endif + +/* General errors */ + +#define MSG_MEM_FAIL "A memory request failed." +#define MSG_NO_MEM "ida_mem = NULL illegal." +#define MSG_NO_MALLOC "Attempt to call before IDAMalloc." +#define MSG_BAD_NVECTOR "A required vector operation is not implemented." + +/* Initialization errors */ + +#define MSG_Y0_NULL "y0 = NULL illegal." +#define MSG_YP0_NULL "yp0 = NULL illegal." +#define MSG_BAD_ITOL "Illegal value for itol. The legal values are IDA_SS, IDA_SV, and IDA_WF." +#define MSG_RES_NULL "res = NULL illegal." +#define MSG_BAD_RTOL "reltol < 0 illegal." +#define MSG_ATOL_NULL "abstol = NULL illegal." +#define MSG_BAD_ATOL "Some abstol component < 0.0 illegal." +#define MSG_ROOT_FUNC_NULL "g = NULL illegal." + +#define MSG_MISSING_ID "id = NULL but suppressalg option on." +#define MSG_NO_TOLS "No integration tolerances have been specified." +#define MSG_FAIL_EWT "The user-provide EwtSet function failed." +#define MSG_BAD_EWT "Some initial ewt component = 0.0 illegal." +#define MSG_Y0_FAIL_CONSTR "y0 fails to satisfy constraints." +#define MSG_LSOLVE_NULL "The linear solver's solve routine is NULL." +#define MSG_LINIT_FAIL "The linear solver's init routine failed." +#define MSG_NLS_INIT_FAIL "The nonlinear solver's init routine failed." + +/* IDACalcIC error messages */ + +#define MSG_IC_BAD_ICOPT "icopt has an illegal value." +#define MSG_IC_BAD_MAXBACKS "maxbacks <= 0 illegal." +#define MSG_IC_MISSING_ID "id = NULL conflicts with icopt." +#define MSG_IC_TOO_CLOSE "tout1 too close to t0 to attempt initial condition calculation." +#define MSG_IC_BAD_ID "id has illegal values." +#define MSG_IC_BAD_EWT "Some initial ewt component = 0.0 illegal." +#define MSG_IC_RES_NONREC "The residual function failed unrecoverably. " +#define MSG_IC_RES_FAIL "The residual function failed at the first call. " +#define MSG_IC_SETUP_FAIL "The linear solver setup failed unrecoverably." +#define MSG_IC_SOLVE_FAIL "The linear solver solve failed unrecoverably." +#define MSG_IC_NO_RECOVERY "The residual routine or the linear setup or solve routine had a recoverable error, but IDACalcIC was unable to recover." +#define MSG_IC_FAIL_CONSTR "Unable to satisfy the inequality constraints." +#define MSG_IC_FAILED_LINS "The linesearch algorithm failed: step too small or too many backtracks." +#define MSG_IC_CONV_FAILED "Newton/Linesearch algorithm failed to converge." + +/* IDASolve error messages */ + +#define MSG_YRET_NULL "yret = NULL illegal." +#define MSG_YPRET_NULL "ypret = NULL illegal." +#define MSG_TRET_NULL "tret = NULL illegal." +#define MSG_BAD_ITASK "itask has an illegal value." +#define MSG_TOO_CLOSE "tout too close to t0 to start integration." +#define MSG_BAD_HINIT "Initial step is not towards tout." +#define MSG_BAD_TSTOP "The value " MSG_TIME_TSTOP " is behind current " MSG_TIME "in the direction of integration." +#define MSG_CLOSE_ROOTS "Root found at and very near " MSG_TIME "." +#define MSG_MAX_STEPS "At " MSG_TIME ", mxstep steps taken before reaching tout." +#define MSG_EWT_NOW_FAIL "At " MSG_TIME "the user-provide EwtSet function failed." +#define MSG_EWT_NOW_BAD "At " MSG_TIME "some ewt component has become <= 0.0." +#define MSG_TOO_MUCH_ACC "At " MSG_TIME "too much accuracy requested." + +#define MSG_BAD_K "Illegal value for k." +#define MSG_NULL_DKY "dky = NULL illegal." +#define MSG_BAD_T "Illegal value for t." MSG_TIME_INT +#define MSG_BAD_TOUT "Trouble interpolating at " MSG_TIME_TOUT ". tout too far back in direction of integration." + +#define MSG_ERR_FAILS "At " MSG_TIME_H "the error test failed repeatedly or with |h| = hmin." +#define MSG_CONV_FAILS "At " MSG_TIME_H "the corrector convergence failed repeatedly or with |h| = hmin." +#define MSG_SETUP_FAILED "At " MSG_TIME "the linear solver setup failed unrecoverably." +#define MSG_SOLVE_FAILED "At " MSG_TIME "the linear solver solve failed unrecoverably." +#define MSG_REP_RES_ERR "At " MSG_TIME "repeated recoverable residual errors." +#define MSG_RES_NONRECOV "At " MSG_TIME "the residual function failed unrecoverably." +#define MSG_FAILED_CONSTR "At " MSG_TIME "unable to satisfy inequality constraints." +#define MSG_RTFUNC_FAILED "At " MSG_TIME ", the rootfinding routine failed in an unrecoverable manner." +#define MSG_NO_ROOT "Rootfinding was not initialized." +#define MSG_INACTIVE_ROOTS "At the end of the first step, there are still some root functions identically 0. This warning will not be issued again." +#define MSG_NLS_INPUT_NULL "At " MSG_TIME ", the nonlinear solver was passed a NULL input." +#define MSG_NLS_SETUP_FAILED "At " MSG_TIME ", the nonlinear solver setup failed unrecoverably." +#define MSG_NLS_FAIL "At " MSG_TIME ", the nonlinear solver failed in an unrecoverable manner." + +/* IDASet* / IDAGet* error messages */ + +#define MSG_NEG_MAXORD "maxord <= 0 illegal." +#define MSG_BAD_MAXORD "Illegal attempt to increase maximum order." +#define MSG_NEG_HMAX "hmax < 0 illegal." +#define MSG_NEG_EPCON "epcon <= 0.0 illegal." +#define MSG_BAD_CONSTR "Illegal values in constraints vector." +#define MSG_BAD_EPICCON "epiccon <= 0.0 illegal." +#define MSG_BAD_MAXNH "maxnh <= 0 illegal." +#define MSG_BAD_MAXNJ "maxnj <= 0 illegal." +#define MSG_BAD_MAXNIT "maxnit <= 0 illegal." +#define MSG_BAD_STEPTOL "steptol <= 0.0 illegal." + +#define MSG_TOO_LATE "IDAGetConsistentIC can only be called before IDASolve." + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/ida/ida_io.c b/bazaar/plugin/sundials/src/ida/ida_io.c new file mode 100644 index 000000000..ce6e65bc7 --- /dev/null +++ b/bazaar/plugin/sundials/src/ida/ida_io.c @@ -0,0 +1,1241 @@ +/* + * ----------------------------------------------------------------- + * $Revision$ + * $Date$ + * ----------------------------------------------------------------- + * Programmer(s): Alan Hindmarsh, Radu Serban and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for the optional inputs and + * outputs for the IDA solver. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "ida_impl.h" + +#include + +#define ZERO RCONST(0.0) +#define HALF RCONST(0.5) +#define ONE RCONST(1.0) +#define TWOPT5 RCONST(2.5) + +/* + * ================================================================= + * IDA optional input functions + * ================================================================= + */ + +int IDASetErrHandlerFn(void *ida_mem, IDAErrHandlerFn ehfun, void *eh_data) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetErrHandlerFn", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + IDA_mem->ida_ehfun = ehfun; + IDA_mem->ida_eh_data = eh_data; + + return(IDA_SUCCESS); +} + + +int IDASetErrFile(void *ida_mem, FILE *errfp) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetErrFile", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + IDA_mem->ida_errfp = errfp; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetUserData(void *ida_mem, void *user_data) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetUserData", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + IDA_mem->ida_user_data = user_data; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetMaxOrd(void *ida_mem, int maxord) +{ + IDAMem IDA_mem; + int maxord_alloc; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxOrd", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (maxord <= 0) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxOrd", MSG_NEG_MAXORD); + return(IDA_ILL_INPUT); + } + + /* Cannot increase maximum order beyond the value that + was used when allocating memory */ + maxord_alloc = IDA_mem->ida_maxord_alloc; + + if (maxord > maxord_alloc) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxOrd", MSG_BAD_MAXORD); + return(IDA_ILL_INPUT); + } + + IDA_mem->ida_maxord = SUNMIN(maxord,MAXORD_DEFAULT); + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetMaxNumSteps(void *ida_mem, long int mxsteps) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxNumSteps", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + /* Passing mxsteps=0 sets the default. Passing mxsteps<0 disables the test. */ + + if (mxsteps == 0) + IDA_mem->ida_mxstep = MXSTEP_DEFAULT; + else + IDA_mem->ida_mxstep = mxsteps; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetInitStep(void *ida_mem, realtype hin) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetInitStep", MSG_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) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxStep", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (hmax < 0) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxStep", MSG_NEG_HMAX); + return(IDA_ILL_INPUT); + } + + /* Passing 0 sets hmax = infinity */ + if (hmax == ZERO) { + IDA_mem->ida_hmax_inv = HMAX_INV_DEFAULT; + return(IDA_SUCCESS); + } + + IDA_mem->ida_hmax_inv = ONE/hmax; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetStopTime(void *ida_mem, realtype tstop) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetStopTime", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + /* If IDASolve was called at least once, test if tstop is legal + * (i.e. if it was not already passed). + * If IDASetStopTime is called before the first call to IDASolve, + * tstop will be checked in IDASolve. */ + if (IDA_mem->ida_nst > 0) { + + if ( (tstop - IDA_mem->ida_tn) * IDA_mem->ida_hh < ZERO ) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetStopTime", MSG_BAD_TSTOP, tstop, IDA_mem->ida_tn); + return(IDA_ILL_INPUT); + } + + } + + IDA_mem->ida_tstop = tstop; + IDA_mem->ida_tstopset = SUNTRUE; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetNonlinConvCoef(void *ida_mem, realtype epcon) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetNonlinConvCoef", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (epcon <= ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetNonlinConvCoef", MSG_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) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxErrTestFails", MSG_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) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxConvFails", MSG_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) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", + "IDASetMaxNonlinIters", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + /* check that the NLS is non-NULL */ + if (IDA_mem->NLS == NULL) { + IDAProcessError(NULL, IDA_MEM_FAIL, "IDA", + "IDASetMaxNonlinIters", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + return(SUNNonlinSolSetMaxIters(IDA_mem->NLS, maxcor)); +} + +/*-----------------------------------------------------------------*/ + +int IDASetSuppressAlg(void *ida_mem, booleantype suppressalg) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetSuppressAlg", MSG_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) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetId", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (id == NULL) { + if (IDA_mem->ida_idMallocDone) { + N_VDestroy(IDA_mem->ida_id); + IDA_mem->ida_lrw -= IDA_mem->ida_lrw1; + IDA_mem->ida_liw -= IDA_mem->ida_liw1; + } + IDA_mem->ida_idMallocDone = SUNFALSE; + return(IDA_SUCCESS); + } + + if ( !(IDA_mem->ida_idMallocDone) ) { + IDA_mem->ida_id = N_VClone(id); + IDA_mem->ida_lrw += IDA_mem->ida_lrw1; + IDA_mem->ida_liw += IDA_mem->ida_liw1; + IDA_mem->ida_idMallocDone = SUNTRUE; + } + + /* Load the id vector */ + + N_VScale(ONE, id, IDA_mem->ida_id); + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetConstraints(void *ida_mem, N_Vector constraints) +{ + IDAMem IDA_mem; + realtype temptest; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetConstraints", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (constraints == NULL) { + if (IDA_mem->ida_constraintsMallocDone) { + N_VDestroy(IDA_mem->ida_constraints); + IDA_mem->ida_lrw -= IDA_mem->ida_lrw1; + IDA_mem->ida_liw -= IDA_mem->ida_liw1; + } + IDA_mem->ida_constraintsMallocDone = SUNFALSE; + IDA_mem->ida_constraintsSet = SUNFALSE; + return(IDA_SUCCESS); + } + + /* Test if required vector ops. are defined */ + + if (constraints->ops->nvdiv == NULL || + constraints->ops->nvmaxnorm == NULL || + constraints->ops->nvcompare == NULL || + constraints->ops->nvconstrmask == NULL || + constraints->ops->nvminquotient == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetConstraints", MSG_BAD_NVECTOR); + return(IDA_ILL_INPUT); + } + + /* Check the constraints vector */ + + temptest = N_VMaxNorm(constraints); + if((temptest > TWOPT5) || (temptest < HALF)){ + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetConstraints", MSG_BAD_CONSTR); + return(IDA_ILL_INPUT); + } + + if ( !(IDA_mem->ida_constraintsMallocDone) ) { + IDA_mem->ida_constraints = N_VClone(constraints); + IDA_mem->ida_lrw += IDA_mem->ida_lrw1; + IDA_mem->ida_liw += IDA_mem->ida_liw1; + IDA_mem->ida_constraintsMallocDone = SUNTRUE; + } + + /* Load the constraints vector */ + + N_VScale(ONE, constraints, IDA_mem->ida_constraints); + + IDA_mem->ida_constraintsSet = SUNTRUE; + + return(IDA_SUCCESS); +} + +/* + * IDASetRootDirection + * + * Specifies the direction of zero-crossings to be monitored. + * The default is to monitor both crossings. + */ + +int IDASetRootDirection(void *ida_mem, int *rootdir) +{ + IDAMem IDA_mem; + int i, nrt; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetRootDirection", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + nrt = IDA_mem->ida_nrtfn; + if (nrt==0) { + IDAProcessError(NULL, IDA_ILL_INPUT, "IDA", "IDASetRootDirection", MSG_NO_ROOT); + return(IDA_ILL_INPUT); + } + + for(i=0; iida_rootdir[i] = rootdir[i]; + + return(IDA_SUCCESS); +} + +/* + * IDASetNoInactiveRootWarn + * + * Disables issuing a warning if some root function appears + * to be identically zero at the beginning of the integration + */ + +int IDASetNoInactiveRootWarn(void *ida_mem) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetNoInactiveRootWarn", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + IDA_mem->ida_mxgnull = 0; + + return(IDA_SUCCESS); +} + + +/* + * ================================================================= + * IDA IC optional input functions + * ================================================================= + */ + +int IDASetNonlinConvCoefIC(void *ida_mem, realtype epiccon) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetNonlinConvCoefIC", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (epiccon <= ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetNonlinConvCoefIC", MSG_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) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxNumStepsIC", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (maxnh <= 0) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxNumStepsIC", MSG_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) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxNumJacsIC", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (maxnj <= 0) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxNumJacsIC", MSG_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) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxNumItersIC", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (maxnit <= 0) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxNumItersIC", MSG_BAD_MAXNIT); + return(IDA_ILL_INPUT); + } + + IDA_mem->ida_maxnit = maxnit; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetMaxBacksIC(void *ida_mem, int maxbacks) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxBacksIC", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (maxbacks <= 0) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxBacksIC", MSG_IC_BAD_MAXBACKS); + return(IDA_ILL_INPUT); + } + + IDA_mem->ida_maxbacks = maxbacks; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetLineSearchOffIC(void *ida_mem, booleantype lsoff) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetLineSearchOffIC", MSG_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) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetStepToleranceIC", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (steptol <= ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetStepToleranceIC", MSG_BAD_STEPTOL); + return(IDA_ILL_INPUT); + } + + IDA_mem->ida_steptol = steptol; + + return(IDA_SUCCESS); +} + +/* + * ================================================================= + * IDA optional input functions + * ================================================================= + */ + +int IDAGetNumSteps(void *ida_mem, long int *nsteps) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumSteps", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *nsteps = IDA_mem->ida_nst; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetNumResEvals(void *ida_mem, long int *nrevals) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumResEvals", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *nrevals = IDA_mem->ida_nre; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetNumLinSolvSetups(void *ida_mem, long int *nlinsetups) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumLinSolvSetups", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *nlinsetups = IDA_mem->ida_nsetups; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetNumErrTestFails(void *ida_mem, long int *netfails) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumErrTestFails", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *netfails = IDA_mem->ida_netf; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetNumBacktrackOps(void *ida_mem, long int *nbacktracks) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumBacktrackOps", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *nbacktracks = IDA_mem->ida_nbacktr; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetConsistentIC(void *ida_mem, N_Vector yy0, N_Vector yp0) +{ + IDAMem IDA_mem; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetConsistentIC", MSG_NO_MEM); + return (IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (IDA_mem->ida_kused != 0) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAGetConsistentIC", MSG_TOO_LATE); + return(IDA_ILL_INPUT); + } + + if(yy0 != NULL) N_VScale(ONE, IDA_mem->ida_phi[0], yy0); + if(yp0 != NULL) N_VScale(ONE, IDA_mem->ida_phi[1], yp0); + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetLastOrder(void *ida_mem, int *klast) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetLastOrder", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *klast = IDA_mem->ida_kused; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetCurrentOrder(void *ida_mem, int *kcur) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetCurrentOrder", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *kcur = IDA_mem->ida_kk; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetCurrentCj(void *ida_mem, realtype *cj) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetCurrentCjRatio", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *cj = IDA_mem->ida_cj; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetCurrentY(void *ida_mem, N_Vector *ycur) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetCurrentY", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *ycur = IDA_mem->ida_yy; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetCurrentYp(void *ida_mem, N_Vector *ypcur) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetCurrentYp", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *ypcur = IDA_mem->ida_yp; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetActualInitStep(void *ida_mem, realtype *hinused) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetActualInitStep", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *hinused = IDA_mem->ida_h0u; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetLastStep(void *ida_mem, realtype *hlast) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetLastStep", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *hlast = IDA_mem->ida_hused; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetCurrentStep(void *ida_mem, realtype *hcur) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetCurrentStep", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *hcur = IDA_mem->ida_hh; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetCurrentTime(void *ida_mem, realtype *tcur) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetCurrentTime", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *tcur = IDA_mem->ida_tn; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetTolScaleFactor(void *ida_mem, realtype *tolsfact) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetTolScaleFactor", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *tolsfact = IDA_mem->ida_tolsf; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetErrWeights(void *ida_mem, N_Vector eweight) +{ + IDAMem IDA_mem; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetErrWeights", MSG_NO_MEM); + return (IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + N_VScale(ONE, IDA_mem->ida_ewt, eweight); + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetEstLocalErrors(void *ida_mem, N_Vector ele) +{ + IDAMem IDA_mem; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetEstLocalErrors", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + N_VScale(ONE, IDA_mem->ida_ee, ele); + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetWorkSpace(void *ida_mem, long int *lenrw, long int *leniw) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetWorkSpace", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *leniw = IDA_mem->ida_liw; + *lenrw = IDA_mem->ida_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 *hinused, realtype *hlast, + realtype *hcur, realtype *tcur) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetIntegratorStats", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *nsteps = IDA_mem->ida_nst; + *nrevals = IDA_mem->ida_nre; + *nlinsetups = IDA_mem->ida_nsetups; + *netfails = IDA_mem->ida_netf; + *klast = IDA_mem->ida_kused; + *kcur = IDA_mem->ida_kk; + *hinused = IDA_mem->ida_h0u; + *hlast = IDA_mem->ida_hused; + *hcur = IDA_mem->ida_hh; + *tcur = IDA_mem->ida_tn; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetNumGEvals(void *ida_mem, long int *ngevals) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumGEvals", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *ngevals = IDA_mem->ida_nge; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetRootInfo(void *ida_mem, int *rootsfound) +{ + IDAMem IDA_mem; + int i, nrt; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetRootInfo", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + nrt = IDA_mem->ida_nrtfn; + + for (i=0; iida_iroots[i]; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetNumNonlinSolvIters(void *ida_mem, long int *nniters) +{ + IDAMem IDA_mem; + long int nls_iters; + int retval; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", + "IDAGetNumNonlinSolvIters", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + /* get number of iterations for IC calc */ + *nniters = IDA_mem->ida_nni; + + /* check that the NLS is non-NULL */ + if (IDA_mem->NLS == NULL) { + IDAProcessError(NULL, IDA_MEM_FAIL, "IDA", + "IDAGetNumNonlinSolvIters", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + /* get number of iterations from the NLS */ + retval = SUNNonlinSolGetNumIters(IDA_mem->NLS, &nls_iters); + if (retval != IDA_SUCCESS) return(retval); + + /* update the number of nonlinear iterations */ + *nniters += nls_iters; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetNumNonlinSolvConvFails(void *ida_mem, long int *nncfails) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumNonlinSolvConvFails", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *nncfails = IDA_mem->ida_ncfn; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetNonlinSolvStats(void *ida_mem, long int *nniters, long int *nncfails) +{ + IDAMem IDA_mem; + long int nls_iters; + int retval; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", + "IDAGetNonlinSolvStats", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *nniters = IDA_mem->ida_nni; + *nncfails = IDA_mem->ida_ncfn; + + /* check that the NLS is non-NULL */ + if (IDA_mem->NLS == NULL) { + IDAProcessError(NULL, IDA_MEM_FAIL, "IDA", + "IDAGetNonlinSolvStats", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + /* get number of iterations from the NLS */ + retval = SUNNonlinSolGetNumIters(IDA_mem->NLS, &nls_iters); + if (retval != IDA_SUCCESS) return(retval); + + /* update the number of nonlinear iterations */ + *nniters += nls_iters; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +char *IDAGetReturnFlagName(long int flag) +{ + char *name; + + name = (char *)malloc(24*sizeof(char)); + + switch(flag) { + case IDA_SUCCESS: + sprintf(name,"IDA_SUCCESS"); + break; + case IDA_TSTOP_RETURN: + sprintf(name,"IDA_TSTOP_RETURN"); + break; + case IDA_ROOT_RETURN: + sprintf(name,"IDA_ROOT_RETURN"); + break; + case IDA_TOO_MUCH_WORK: + sprintf(name,"IDA_TOO_MUCH_WORK"); + break; + case IDA_TOO_MUCH_ACC: + sprintf(name,"IDA_TOO_MUCH_ACC"); + break; + case IDA_ERR_FAIL: + sprintf(name,"IDA_ERR_FAIL"); + break; + case IDA_CONV_FAIL: + sprintf(name,"IDA_CONV_FAIL"); + break; + case IDA_LINIT_FAIL: + sprintf(name,"IDA_LINIT_FAIL"); + break; + case IDA_LSETUP_FAIL: + sprintf(name,"IDA_LSETUP_FAIL"); + break; + case IDA_LSOLVE_FAIL: + sprintf(name,"IDA_LSOLVE_FAIL"); + break; + case IDA_CONSTR_FAIL: + sprintf(name,"IDA_CONSTR_FAIL"); + break; + case IDA_RES_FAIL: + sprintf(name,"IDA_RES_FAIL"); + break; + case IDA_FIRST_RES_FAIL: + sprintf(name,"IDA_FIRST_RES_FAIL"); + break; + case IDA_REP_RES_ERR: + sprintf(name,"IDA_REP_RES_ERR"); + break; + case IDA_RTFUNC_FAIL: + sprintf(name,"IDA_RTFUNC_FAIL"); + break; + case IDA_MEM_FAIL: + sprintf(name,"IDA_MEM_FAIL"); + break; + case IDA_MEM_NULL: + sprintf(name,"IDA_MEM_NULL"); + break; + case IDA_ILL_INPUT: + sprintf(name,"IDA_ILL_INPUT"); + break; + case IDA_NO_MALLOC: + sprintf(name,"IDA_NO_MALLOC"); + break; + case IDA_BAD_T: + sprintf(name,"IDA_BAD_T"); + break; + case IDA_BAD_EWT: + sprintf(name,"IDA_BAD_EWT"); + break; + case IDA_NO_RECOVERY: + sprintf(name,"IDA_NO_RECOVERY"); + break; + case IDA_LINESEARCH_FAIL: + sprintf(name,"IDA_LINESEARCH_FAIL"); + break; + case IDA_NLS_SETUP_FAIL: + sprintf(name,"IDA_NLS_SETUP_FAIL"); + break; + case IDA_NLS_FAIL: + sprintf(name,"IDA_NLS_FAIL"); + break; + default: + sprintf(name,"NONE"); + } + + return(name); +} diff --git a/bazaar/plugin/sundials/src/ida/ida_ls.c b/bazaar/plugin/sundials/src/ida/ida_ls.c new file mode 100644 index 000000000..6cede7d2b --- /dev/null +++ b/bazaar/plugin/sundials/src/ida/ida_ls.c @@ -0,0 +1,1587 @@ +/*----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * Alan C. Hindmarsh and Radu Serban @ LLNL + *----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *----------------------------------------------------------------- + * Implementation file for IDA's linear solver interface. + *-----------------------------------------------------------------*/ + +#include +#include +#include + +#include "ida_impl.h" +#include "ida_ls_impl.h" +#include +#include +#include +#include +#include + +/* constants */ +#define MAX_ITERS 3 /* max. number of attempts to recover in DQ J*v */ +#define ZERO RCONST(0.0) +#define PT25 RCONST(0.25) +#define PT05 RCONST(0.05) +#define PT9 RCONST(0.9) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) + + +/*=============================================================== + IDALS Exported functions -- Required + ===============================================================*/ + +/*--------------------------------------------------------------- + IDASetLinearSolver specifies the linear solver + ---------------------------------------------------------------*/ +int IDASetLinearSolver(void *ida_mem, SUNLinearSolver LS, SUNMatrix A) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval, LSType; + booleantype iterative; /* is the solver iterative? */ + booleantype matrixbased; /* is a matrix structure used? */ + + /* Return immediately if any input is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDALS_MEM_NULL, "IDALS", + "IDASetLinearSolver", MSG_LS_IDAMEM_NULL); + return(IDALS_MEM_NULL); + } + if (LS == NULL) { + IDAProcessError(NULL, IDALS_ILL_INPUT, "IDALS", + "IDASetLinearSolver", + "LS must be non-NULL"); + return(IDALS_ILL_INPUT); + } + IDA_mem = (IDAMem) ida_mem; + + /* Test if solver is compatible with LS interface */ + if ( (LS->ops->gettype == NULL) || (LS->ops->solve == NULL) ) { + IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", + "IDASetLinearSolver", + "LS object is missing a required operation"); + return(IDALS_ILL_INPUT); + } + + /* Retrieve the LS type */ + LSType = SUNLinSolGetType(LS); + + /* Set flags based on LS type */ + iterative = (LSType != SUNLINEARSOLVER_DIRECT); + matrixbased = (LSType != SUNLINEARSOLVER_ITERATIVE); + + /* Test if vector is compatible with LS interface */ + if (IDA_mem->ida_tempv1->ops->nvconst == NULL || + IDA_mem->ida_tempv1->ops->nvwrmsnorm == NULL) { + IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", + "IDASetLinearSolver", MSG_LS_BAD_NVECTOR); + return(IDALS_ILL_INPUT); + } + + /* Check for compatible LS type, matrix and "atimes" support */ + if (iterative) { + + if (IDA_mem->ida_tempv1->ops->nvgetlength == NULL) { + IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", + "IDASetLinearSolver", MSG_LS_BAD_NVECTOR); + return(IDALS_ILL_INPUT); + } + + if (LS->ops->resid == NULL || LS->ops->numiters == NULL) { + IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", "IDASetLinearSolver", + "Iterative LS object requires 'resid' and 'numiters' routines"); + return(IDALS_ILL_INPUT); + } + + if (!matrixbased && LS->ops->setatimes == NULL) { + IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", "IDASetLinearSolver", + "Incompatible inputs: iterative LS must support ATimes routine"); + return(IDALS_ILL_INPUT); + } + + if (matrixbased && A == NULL) { + IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", "IDASetLinearSolver", + "Incompatible inputs: matrix-iterative LS requires non-NULL matrix"); + return(IDALS_ILL_INPUT); + } + + } else if (A == NULL) { + + IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", "IDASetLinearSolver", + "Incompatible inputs: direct LS requires non-NULL matrix"); + return(IDALS_ILL_INPUT); + + } + + /* free any existing system solver attached to IDA */ + if (IDA_mem->ida_lfree) IDA_mem->ida_lfree(IDA_mem); + + /* Set four main system linear solver function fields in IDA_mem */ + IDA_mem->ida_linit = idaLsInitialize; + IDA_mem->ida_lsetup = idaLsSetup; + IDA_mem->ida_lsolve = idaLsSolve; + IDA_mem->ida_lfree = idaLsFree; + + /* Set ida_lperf if using an iterative SUNLinearSolver object */ + IDA_mem->ida_lperf = (iterative) ? idaLsPerf : NULL; + + /* Allocate memory for IDALsMemRec */ + idals_mem = NULL; + idals_mem = (IDALsMem) malloc(sizeof(struct IDALsMemRec)); + if (idals_mem == NULL) { + IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDALS", + "IDASetLinearSolver", MSG_LS_MEM_FAIL); + return(IDALS_MEM_FAIL); + } + memset(idals_mem, 0, sizeof(struct IDALsMemRec)); + + /* set SUNLinearSolver pointer */ + idals_mem->LS = LS; + + /* Linear solver type information */ + idals_mem->iterative = iterative; + idals_mem->matrixbased = matrixbased; + + /* Set defaults for Jacobian-related fields */ + idals_mem->J = A; + if (A != NULL) { + idals_mem->jacDQ = SUNTRUE; + idals_mem->jac = idaLsDQJac; + idals_mem->J_data = IDA_mem; + } else { + idals_mem->jacDQ = SUNFALSE; + idals_mem->jac = NULL; + idals_mem->J_data = NULL; + } + idals_mem->jtimesDQ = SUNTRUE; + idals_mem->jtsetup = NULL; + idals_mem->jtimes = idaLsDQJtimes; + idals_mem->jt_data = IDA_mem; + + /* Set defaults for preconditioner-related fields */ + idals_mem->pset = NULL; + idals_mem->psolve = NULL; + idals_mem->pfree = NULL; + idals_mem->pdata = IDA_mem->ida_user_data; + + /* Initialize counters */ + idaLsInitializeCounters(idals_mem); + + /* Set default values for the rest of the Ls parameters */ + idals_mem->eplifac = PT05; + idals_mem->dqincfac = ONE; + idals_mem->last_flag = IDALS_SUCCESS; + + /* If LS supports ATimes, attach IDALs routine */ + if (LS->ops->setatimes) { + retval = SUNLinSolSetATimes(LS, IDA_mem, idaLsATimes); + if (retval != SUNLS_SUCCESS) { + IDAProcessError(IDA_mem, IDALS_SUNLS_FAIL, "IDALS", + "IDASetLinearSolver", + "Error in calling SUNLinSolSetATimes"); + free(idals_mem); idals_mem = NULL; + return(IDALS_SUNLS_FAIL); + } + } + + /* If LS supports preconditioning, initialize pset/psol to NULL */ + if (LS->ops->setpreconditioner) { + retval = SUNLinSolSetPreconditioner(LS, IDA_mem, NULL, NULL); + if (retval != SUNLS_SUCCESS) { + IDAProcessError(IDA_mem, IDALS_SUNLS_FAIL, "IDALS", + "IDASetLinearSolver", + "Error in calling SUNLinSolSetPreconditioner"); + free(idals_mem); idals_mem = NULL; + return(IDALS_SUNLS_FAIL); + } + } + + /* Allocate memory for ytemp, yptemp and x */ + idals_mem->ytemp = N_VClone(IDA_mem->ida_tempv1); + if (idals_mem->ytemp == NULL) { + IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDALS", + "IDASetLinearSolver", MSG_LS_MEM_FAIL); + free(idals_mem); idals_mem = NULL; + return(IDALS_MEM_FAIL); + } + + idals_mem->yptemp = N_VClone(IDA_mem->ida_tempv1); + if (idals_mem->yptemp == NULL) { + IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDALS", + "IDASetLinearSolver", MSG_LS_MEM_FAIL); + N_VDestroy(idals_mem->ytemp); + free(idals_mem); idals_mem = NULL; + return(IDALS_MEM_FAIL); + } + + idals_mem->x = N_VClone(IDA_mem->ida_tempv1); + if (idals_mem->x == NULL) { + IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDALS", + "IDASetLinearSolver", MSG_LS_MEM_FAIL); + N_VDestroy(idals_mem->ytemp); + N_VDestroy(idals_mem->yptemp); + free(idals_mem); idals_mem = NULL; + return(IDALS_MEM_FAIL); + } + + /* For iterative LS, compute sqrtN */ + if (iterative) + idals_mem->sqrtN = SUNRsqrt( N_VGetLength(idals_mem->ytemp) ); + + /* For matrix-based LS, enable solution scaling */ + if (matrixbased) + idals_mem->scalesol = SUNTRUE; + else + idals_mem->scalesol = SUNFALSE; + + /* Attach linear solver memory to integrator memory */ + IDA_mem->ida_lmem = idals_mem; + + return(IDALS_SUCCESS); +} + + +/*=============================================================== + Optional input/output routines + ===============================================================*/ + + +/* IDASetJacFn specifies the Jacobian function */ +int IDASetJacFn(void *ida_mem, IDALsJacFn jac) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure */ + retval = idaLs_AccessLMem(ida_mem, "IDALsSetJacFn", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + + /* return with failure if jac cannot be used */ + if ((jac != NULL) && (idals_mem->J == NULL)) { + IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", "IDASetJacFn", + "Jacobian routine cannot be supplied for NULL SUNMatrix"); + return(IDALS_ILL_INPUT); + } + + /* set Jacobian routine pointer, and update relevant flags */ + if (jac != NULL) { + idals_mem->jacDQ = SUNFALSE; + idals_mem->jac = jac; + idals_mem->J_data = IDA_mem->ida_user_data; + } else { + idals_mem->jacDQ = SUNTRUE; + idals_mem->jac = idaLsDQJac; + idals_mem->J_data = IDA_mem; + } + + return(IDALS_SUCCESS); +} + + +/* IDASetEpsLin specifies the nonlinear -> linear tolerance scale factor */ +int IDASetEpsLin(void *ida_mem, realtype eplifac) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure */ + retval = idaLs_AccessLMem(ida_mem, "IDASetEpsLin", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + + /* Check for legal eplifac */ + if (eplifac < ZERO) { + IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", + "IDASetEpsLin", MSG_LS_NEG_EPLIFAC); + return(IDALS_ILL_INPUT); + } + + idals_mem->eplifac = (eplifac == ZERO) ? PT05 : eplifac; + + return(IDALS_SUCCESS); +} + + +/* IDASetLinearSolutionScaling enables or disables scaling the linear solver + solution to account for changes in cj. */ +int IDASetLinearSolutionScaling(void *ida_mem, booleantype onoff) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure */ + retval = idaLs_AccessLMem(ida_mem, "IDASetLinearSolutionScaling", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + + /* check for valid solver type */ + if (!(idals_mem->matrixbased)) return(IDALS_ILL_INPUT); + + /* set solution scaling flag */ + idals_mem->scalesol = onoff; + + return(IDALS_SUCCESS); +} + + +/* IDASetIncrementFactor specifies increment factor for DQ approximations to Jv */ +int IDASetIncrementFactor(void *ida_mem, realtype dqincfac) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure */ + retval = idaLs_AccessLMem(ida_mem, "IDASetIncrementFactor", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + + /* Check for legal dqincfac */ + if (dqincfac <= ZERO) { + IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", + "IDASetIncrementFactor", MSG_LS_NEG_DQINCFAC); + return(IDALS_ILL_INPUT); + } + + idals_mem->dqincfac = dqincfac; + + return(IDALS_SUCCESS); +} + + +/* IDASetPreconditioner specifies the user-supplied psetup and psolve routines */ +int IDASetPreconditioner(void *ida_mem, + IDALsPrecSetupFn psetup, + IDALsPrecSolveFn psolve) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + PSetupFn idals_psetup; + PSolveFn idals_psolve; + int retval; + + /* access IDALsMem structure */ + retval = idaLs_AccessLMem(ida_mem, "IDASetPreconditioner", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + + /* store function pointers for user-supplied routines in IDALs interface */ + idals_mem->pset = psetup; + idals_mem->psolve = psolve; + + /* issue error if LS object does not allow user-supplied preconditioning */ + if (idals_mem->LS->ops->setpreconditioner == NULL) { + IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", + "IDASetPreconditioner", + "SUNLinearSolver object does not support user-supplied preconditioning"); + return(IDALS_ILL_INPUT); + } + + /* notify iterative linear solver to call IDALs interface routines */ + idals_psetup = (psetup == NULL) ? NULL : idaLsPSetup; + idals_psolve = (psolve == NULL) ? NULL : idaLsPSolve; + retval = SUNLinSolSetPreconditioner(idals_mem->LS, IDA_mem, + idals_psetup, idals_psolve); + if (retval != SUNLS_SUCCESS) { + IDAProcessError(IDA_mem, IDALS_SUNLS_FAIL, "IDALS", + "IDASetPreconditioner", + "Error in calling SUNLinSolSetPreconditioner"); + return(IDALS_SUNLS_FAIL); + } + + return(IDALS_SUCCESS); +} + + +/* IDASetJacTimes specifies the user-supplied Jacobian-vector product + setup and multiply routines */ +int IDASetJacTimes(void *ida_mem, IDALsJacTimesSetupFn jtsetup, + IDALsJacTimesVecFn jtimes) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure */ + retval = idaLs_AccessLMem(ida_mem, "IDASetJacTimes", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + + /* issue error if LS object does not allow user-supplied ATimes */ + if (idals_mem->LS->ops->setatimes == NULL) { + IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", + "IDASetJacTimes", + "SUNLinearSolver object does not support user-supplied ATimes routine"); + return(IDALS_ILL_INPUT); + } + + /* store function pointers for user-supplied routines in IDALs + interface (NULL jtimes implies use of DQ default) */ + if (jtimes != NULL) { + idals_mem->jtimesDQ = SUNFALSE; + idals_mem->jtsetup = jtsetup; + idals_mem->jtimes = jtimes; + idals_mem->jt_data = IDA_mem->ida_user_data; + } else { + idals_mem->jtimesDQ = SUNTRUE; + idals_mem->jtsetup = NULL; + idals_mem->jtimes = idaLsDQJtimes; + idals_mem->jt_data = IDA_mem; + } + + return(IDALS_SUCCESS); +} + + +/* IDAGetLinWorkSpace returns the length of workspace allocated + for the IDALS linear solver interface */ +int IDAGetLinWorkSpace(void *ida_mem, long int *lenrwLS, + long int *leniwLS) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + sunindextype lrw1, liw1; + long int lrw, liw; + int retval; + + /* access IDALsMem structure */ + retval = idaLs_AccessLMem(ida_mem, "IDAGetLinWorkSpace", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + + /* start with fixed sizes plus vector/matrix pointers */ + *lenrwLS = 3; + *leniwLS = 33; + + /* add N_Vector sizes */ + if (IDA_mem->ida_tempv1->ops->nvspace) { + N_VSpace(IDA_mem->ida_tempv1, &lrw1, &liw1); + *lenrwLS += 3*lrw1; + *leniwLS += 3*liw1; + } + + /* add LS sizes */ + if (idals_mem->LS->ops->space) { + retval = SUNLinSolSpace(idals_mem->LS, &lrw, &liw); + if (retval == 0) { + *lenrwLS += lrw; + *leniwLS += liw; + } + } + + return(IDALS_SUCCESS); +} + + +/* IDAGetNumJacEvals returns the number of Jacobian evaluations */ +int IDAGetNumJacEvals(void *ida_mem, long int *njevals) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure; store output and return */ + retval = idaLs_AccessLMem(ida_mem, "IDAGetNumJacEvals", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + *njevals = idals_mem->nje; + return(IDALS_SUCCESS); +} + + +/* IDAGetNumPrecEvals returns the number of preconditioner evaluations */ +int IDAGetNumPrecEvals(void *ida_mem, long int *npevals) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure; store output and return */ + retval = idaLs_AccessLMem(ida_mem, "IDAGetNumPrecEvals", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + *npevals = idals_mem->npe; + return(IDALS_SUCCESS); +} + + +/* IDAGetNumPrecSolves returns the number of preconditioner solves */ +int IDAGetNumPrecSolves(void *ida_mem, long int *npsolves) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure; store output and return */ + retval = idaLs_AccessLMem(ida_mem, "IDAGetNumPrecSolves", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + *npsolves = idals_mem->nps; + return(IDALS_SUCCESS); +} + + +/* IDAGetNumLinIters returns the number of linear iterations */ +int IDAGetNumLinIters(void *ida_mem, long int *nliters) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure; store output and return */ + retval = idaLs_AccessLMem(ida_mem, "IDAGetNumLinIters", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + *nliters = idals_mem->nli; + return(IDALS_SUCCESS); +} + + +/* IDAGetNumLinConvFails returns the number of linear convergence failures */ +int IDAGetNumLinConvFails(void *ida_mem, long int *nlcfails) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure; store output and return */ + retval = idaLs_AccessLMem(ida_mem, "IDAGetNumLinConvFails", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + *nlcfails = idals_mem->ncfl; + return(IDALS_SUCCESS); +} + + +/* IDAGetNumJTSetupEvals returns the number of calls to the + user-supplied Jacobian-vector product setup routine */ +int IDAGetNumJTSetupEvals(void *ida_mem, long int *njtsetups) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure; store output and return */ + retval = idaLs_AccessLMem(ida_mem, "IDAGetNumJTSetupEvals", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + *njtsetups = idals_mem->njtsetup; + return(IDALS_SUCCESS); +} + + +/* IDAGetNumJtimesEvals returns the number of calls to the + Jacobian-vector product multiply routine */ +int IDAGetNumJtimesEvals(void *ida_mem, long int *njvevals) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure; store output and return */ + retval = idaLs_AccessLMem(ida_mem, "IDAGetNumJtimesEvals", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + *njvevals = idals_mem->njtimes; + return(IDALS_SUCCESS); +} + + +/* IDAGetNumLinResEvals returns the number of calls to the DAE + residual needed for the DQ Jacobian approximation or J*v + product approximation */ +int IDAGetNumLinResEvals(void *ida_mem, long int *nrevalsLS) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure; store output and return */ + retval = idaLs_AccessLMem(ida_mem, "IDAGetNumLinResEvals", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + *nrevalsLS = idals_mem->nreDQ; + return(IDALS_SUCCESS); +} + + +/* IDAGetLastLinFlag returns the last flag set in a IDALS function */ +int IDAGetLastLinFlag(void *ida_mem, long int *flag) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure; store output and return */ + retval = idaLs_AccessLMem(ida_mem, "IDAGetLastLinFlag", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + *flag = idals_mem->last_flag; + return(IDALS_SUCCESS); +} + + +/* IDAGetLinReturnFlagName translates from the integer error code + returned by an IDALs routine to the corresponding string + equivalent for that flag */ +char *IDAGetLinReturnFlagName(long int flag) +{ + char *name = (char *)malloc(30*sizeof(char)); + + switch(flag) { + case IDALS_SUCCESS: + sprintf(name,"IDALS_SUCCESS"); + break; + case IDALS_MEM_NULL: + sprintf(name,"IDALS_MEM_NULL"); + break; + case IDALS_LMEM_NULL: + sprintf(name,"IDALS_LMEM_NULL"); + break; + case IDALS_ILL_INPUT: + sprintf(name,"IDALS_ILL_INPUT"); + break; + case IDALS_MEM_FAIL: + sprintf(name,"IDALS_MEM_FAIL"); + break; + case IDALS_PMEM_NULL: + sprintf(name,"IDALS_PMEM_NULL"); + break; + case IDALS_JACFUNC_UNRECVR: + sprintf(name,"IDALS_JACFUNC_UNRECVR"); + break; + case IDALS_JACFUNC_RECVR: + sprintf(name,"IDALS_JACFUNC_RECVR"); + break; + case IDALS_SUNMAT_FAIL: + sprintf(name,"IDALS_SUNMAT_FAIL"); + break; + case IDALS_SUNLS_FAIL: + sprintf(name,"IDALS_SUNLS_FAIL"); + break; + default: + sprintf(name,"NONE"); + } + + return(name); +} + + +/*=============================================================== + IDALS Private functions + ===============================================================*/ + +/*--------------------------------------------------------------- + idaLsATimes: + + 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. The return value is + the same as the value returned by jtimes -- + 0 if successful, nonzero otherwise. + ---------------------------------------------------------------*/ +int idaLsATimes(void *ida_mem, N_Vector v, N_Vector z) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure */ + retval = idaLs_AccessLMem(ida_mem, "idaLsATimes", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + + /* call Jacobian-times-vector product routine + (either user-supplied or internal DQ) */ + retval = idals_mem->jtimes(IDA_mem->ida_tn, idals_mem->ycur, + idals_mem->ypcur, idals_mem->rcur, + v, z, IDA_mem->ida_cj, + idals_mem->jt_data, idals_mem->ytemp, + idals_mem->yptemp); + idals_mem->njtimes++; + return(retval); +} + + +/*--------------------------------------------------------------- + idaLsPSetup: + + This routine interfaces between the generic iterative linear + solvers and the user's psetup routine. It passes to psetup all + required state information from ida_mem. Its return value + is the same as that returned by psetup. Note that the generic + iterative linear solvers guarantee that idaLsPSetup will only + be called in the case that the user's psetup routine is non-NULL. + ---------------------------------------------------------------*/ +int idaLsPSetup(void *ida_mem) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure */ + retval = idaLs_AccessLMem(ida_mem, "idaLsPSetup", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + + /* Call user pset routine to update preconditioner and possibly + reset jcur (pass !jbad as update suggestion) */ + retval = idals_mem->pset(IDA_mem->ida_tn, idals_mem->ycur, + idals_mem->ypcur, idals_mem->rcur, + IDA_mem->ida_cj, idals_mem->pdata); + idals_mem->npe++; + return(retval); +} + + +/*--------------------------------------------------------------- + idaLsPSolve: + + This routine interfaces between the generic SUNLinSolSolve + 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 + SUNLinSol solver guarantees that IDASilsPSolve 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. + ---------------------------------------------------------------*/ +int idaLsPSolve(void *ida_mem, N_Vector r, N_Vector z, realtype tol, int lr) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure */ + retval = idaLs_AccessLMem(ida_mem, "idaLsPSolve", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + + /* call the user-supplied psolve routine, and accumulate count */ + retval = idals_mem->psolve(IDA_mem->ida_tn, idals_mem->ycur, + idals_mem->ypcur, idals_mem->rcur, + r, z, IDA_mem->ida_cj, tol, + idals_mem->pdata); + idals_mem->nps++; + return(retval); +} + + +/*--------------------------------------------------------------- + idaLsDQJac: + + This routine is a wrapper for the Dense and Band + implementations of the difference quotient Jacobian + approximation routines. +---------------------------------------------------------------*/ +int idaLsDQJac(realtype t, realtype c_j, N_Vector y, N_Vector yp, + N_Vector r, SUNMatrix Jac, void *ida_mem, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) +{ + int retval; + IDAMem IDA_mem; + IDA_mem = (IDAMem) ida_mem; + + /* access IDAMem structure */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDALS_MEM_NULL, "IDALS", + "idaLsDQJac", MSG_LS_IDAMEM_NULL); + return(IDALS_MEM_NULL); + } + + /* verify that Jac is non-NULL */ + if (Jac == NULL) { + IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDALS", + "idaLsDQJac", MSG_LS_LMEM_NULL); + return(IDALS_LMEM_NULL); + } + + /* Verify that N_Vector supports required operations */ + if (IDA_mem->ida_tempv1->ops->nvcloneempty == NULL || + IDA_mem->ida_tempv1->ops->nvlinearsum == NULL || + IDA_mem->ida_tempv1->ops->nvdestroy == NULL || + IDA_mem->ida_tempv1->ops->nvscale == NULL || + IDA_mem->ida_tempv1->ops->nvgetarraypointer == NULL || + IDA_mem->ida_tempv1->ops->nvsetarraypointer == NULL) { + IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", + "idaLsDQJac", MSG_LS_BAD_NVECTOR); + return(IDALS_ILL_INPUT); + } + + /* Call the matrix-structure-specific DQ approximation routine */ + if (SUNMatGetID(Jac) == SUNMATRIX_DENSE) { + retval = idaLsDenseDQJac(t, c_j, y, yp, r, Jac, IDA_mem, tmp1); + } else if (SUNMatGetID(Jac) == SUNMATRIX_BAND) { + retval = idaLsBandDQJac(t, c_j, y, yp, r, Jac, IDA_mem, tmp1, tmp2, tmp3); + } else { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDALS", + "idaLsDQJac", + "unrecognized matrix type for idaLsDQJac"); + retval = IDA_ILL_INPUT; + } + return(retval); +} + + +/*--------------------------------------------------------------- + idaLsDenseDQJac + + This routine generates a dense difference quotient approximation + to the Jacobian F_y + c_j*F_y'. It assumes a dense SUNmatrix + input (stored column-wise, and that elements within each column + are contiguous). The address of the jth column of J is obtained + via the function SUNDenseMatrix_Column() 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. +---------------------------------------------------------------*/ +int idaLsDenseDQJac(realtype tt, realtype c_j, N_Vector yy, + N_Vector yp, N_Vector rr, SUNMatrix Jac, + IDAMem IDA_mem, N_Vector tmp1) +{ + realtype inc, inc_inv, yj, ypj, srur, conj; + realtype *y_data, *yp_data, *ewt_data, *cns_data = NULL; + N_Vector rtemp, jthCol; + sunindextype j, N; + IDALsMem idals_mem; + int retval = 0; + + /* access LsMem interface structure */ + idals_mem = (IDALsMem) IDA_mem->ida_lmem; + + /* access matrix dimension */ + N = SUNDenseMatrix_Rows(Jac); + + /* Rename work vectors for readibility */ + rtemp = tmp1; + + /* Create an empty vector for matrix column calculations */ + jthCol = N_VCloneEmpty(tmp1); + + /* Obtain pointers to the data for ewt, yy, yp. */ + ewt_data = N_VGetArrayPointer(IDA_mem->ida_ewt); + y_data = N_VGetArrayPointer(yy); + yp_data = N_VGetArrayPointer(yp); + if(IDA_mem->ida_constraintsSet) + cns_data = N_VGetArrayPointer(IDA_mem->ida_constraints); + + srur = SUNRsqrt(IDA_mem->ida_uround); + + for (j=0; j < N; 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(SUNDenseMatrix_Column(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 = SUNMAX( srur * SUNMAX( SUNRabs(yj), SUNRabs(IDA_mem->ida_hh*ypj) ), + ONE/ewt_data[j] ); + + if (IDA_mem->ida_hh*ypj < ZERO) inc = -inc; + inc = (yj + inc) - yj; + + /* Adjust sign(inc) again if y_j has an inequality constraint. */ + if (IDA_mem->ida_constraintsSet) { + conj = cns_data[j]; + if (SUNRabs(conj) == ONE) {if((yj+inc)*conj < ZERO) inc = -inc;} + else if (SUNRabs(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 = IDA_mem->ida_res(tt, yy, yp, rtemp, IDA_mem->ida_user_data); + idals_mem->nreDQ++; + if (retval != 0) break; + + /* Construct difference quotient in jthCol */ + inc_inv = ONE/inc; + N_VLinearSum(inc_inv, rtemp, -inc_inv, rr, jthCol); + + /* reset y_j, yp_j */ + y_data[j] = yj; + yp_data[j] = ypj; + } + + /* Destroy jthCol vector */ + N_VSetArrayPointer(NULL, jthCol); /* SHOULDN'T BE NEEDED */ + N_VDestroy(jthCol); + + return(retval); +} + + +/*--------------------------------------------------------------- + idaLsBandDQJac + + This routine generates a banded difference quotient approximation + JJ to the DAE system Jacobian J. It assumes a band SUNMatrix + input (stored column-wise, and that elements within each column + are contiguous). This makes it possible to get the address + of a column of JJ via the function SUNBandMatrix_Column(). 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. + ---------------------------------------------------------------*/ +int idaLsBandDQJac(realtype tt, realtype c_j, N_Vector yy, + N_Vector yp, N_Vector rr, SUNMatrix Jac, + IDAMem IDA_mem, 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; + N_Vector rtemp, ytemp, yptemp; + sunindextype i, j, i1, i2, width, ngroups, group; + sunindextype N, mupper, mlower; + IDALsMem idals_mem; + int retval = 0; + + /* access LsMem interface structure */ + idals_mem = (IDALsMem) IDA_mem->ida_lmem; + + /* access matrix dimensions */ + N = SUNBandMatrix_Columns(Jac); + mupper = SUNBandMatrix_UpperBandwidth(Jac); + mlower = SUNBandMatrix_LowerBandwidth(Jac); + + /* Rename work vectors for use as temporary values of r, y and yp */ + rtemp = tmp1; + ytemp = tmp2; + yptemp= tmp3; + + /* Obtain pointers to the data for all eight vectors used. */ + ewt_data = N_VGetArrayPointer(IDA_mem->ida_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 (IDA_mem->ida_constraintsSet) + cns_data = N_VGetArrayPointer(IDA_mem->ida_constraints); + + /* Initialize ytemp and yptemp. */ + N_VScale(ONE, yy, ytemp); + N_VScale(ONE, yp, yptemp); + + /* Compute miscellaneous values for the Jacobian computation. */ + srur = SUNRsqrt(IDA_mem->ida_uround); + width = mlower + mupper + 1; + ngroups = SUNMIN(width, N); + + /* 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; jida_hh*ypj) ), + ONE/ewtj ); + if (IDA_mem->ida_hh*ypj < ZERO) inc = -inc; + inc = (yj + inc) - yj; + + /* Adjust sign(inc) again if yj has an inequality constraint. */ + if (IDA_mem->ida_constraintsSet) { + conj = cns_data[j]; + if (SUNRabs(conj) == ONE) {if((yj+inc)*conj < ZERO) inc = -inc;} + else if (SUNRabs(conj) == TWO) {if((yj+inc)*conj <= ZERO) inc = -inc;} + } + + /* Increment yj and ypj. */ + ytemp_data[j] += inc; + yptemp_data[j] += IDA_mem->ida_cj*inc; + } + + /* Call res routine with incremented arguments. */ + retval = IDA_mem->ida_res(tt, ytemp, yptemp, rtemp, IDA_mem->ida_user_data); + idals_mem->nreDQ++; + if (retval != 0) break; + + /* Loop over the indices j in this group again. */ + for (j=group-1; jida_hh*ypj) ), + ONE/ewtj ); + if (IDA_mem->ida_hh*ypj < ZERO) inc = -inc; + inc = (yj + inc) - yj; + if (IDA_mem->ida_constraintsSet) { + conj = cns_data[j]; + if (SUNRabs(conj) == ONE) {if((yj+inc)*conj < ZERO) inc = -inc;} + else if (SUNRabs(conj) == TWO) {if((yj+inc)*conj <= ZERO) inc = -inc;} + } + + /* Load the difference quotient Jacobian elements for column j */ + inc_inv = ONE/inc; + i1 = SUNMAX(0, j-mupper); + i2 = SUNMIN(j+mlower,N-1); + for (i=i1; i<=i2; i++) + SM_COLUMN_ELEMENT_B(col_j,i,j) = inc_inv * (rtemp_data[i]-r_data[i]); + } + } + + return(retval); +} + + +/*--------------------------------------------------------------- + idaLsDQJtimes + + This routine generates a difference quotient approximation to + the matrix-vector product z = Jv, where J is the system + Jacobian. 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 idaLsSolve. + ---------------------------------------------------------------*/ +int idaLsDQJtimes(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, + N_Vector v, N_Vector Jv, realtype c_j, + void *ida_mem, N_Vector work1, N_Vector work2) +{ + IDAMem IDA_mem; + IDALsMem idals_mem; + N_Vector y_tmp, yp_tmp; + realtype sig, siginv; + int iter, retval; + SUNLinearSolver_ID LSID; + + /* access IDALsMem structure */ + retval = idaLs_AccessLMem(ida_mem, "idaLsDQJtimes", + &IDA_mem, &idals_mem); + if (retval != IDALS_SUCCESS) return(retval); + + LSID = SUNLinSolGetID(idals_mem->LS); + if (LSID == SUNLINEARSOLVER_SPGMR || LSID == SUNLINEARSOLVER_SPFGMR) + sig = idals_mem->sqrtN * idals_mem->dqincfac; + else + sig = idals_mem->dqincfac / N_VWrmsNorm(v, IDA_mem->ida_ewt); + + /* Rename work1 and work2 for readibility */ + y_tmp = work1; + yp_tmp = work2; + + for (iter=0; iterida_res(tt, y_tmp, yp_tmp, Jv, IDA_mem->ida_user_data); + idals_mem->nreDQ++; + if (retval == 0) break; + if (retval < 0) return(-1); + + sig *= PT25; + } + + if (retval > 0) return(+1); + + /* Set Jv to [Jv - rr]/sig and return. */ + siginv = ONE/sig; + N_VLinearSum(siginv, Jv, -siginv, rr, Jv); + + return(0); +} + + +/*--------------------------------------------------------------- + idaLsInitialize + + This routine performs remaining initializations specific + to the iterative linear solver interface (and solver itself) +---------------------------------------------------------------*/ +int idaLsInitialize(IDAMem IDA_mem) +{ + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure */ + if (IDA_mem->ida_lmem == NULL) { + IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDALS", + "idaLsInitialize", MSG_LS_LMEM_NULL); + return(IDALS_LMEM_NULL); + } + idals_mem = (IDALsMem) IDA_mem->ida_lmem; + + + /* Test for valid combinations of matrix & Jacobian routines: */ + if (idals_mem->J == NULL) { + + /* If SUNMatrix A is NULL: ensure 'jac' function pointer is NULL */ + idals_mem->jacDQ = SUNFALSE; + idals_mem->jac = NULL; + idals_mem->J_data = NULL; + + } else if (idals_mem->jacDQ) { + + /* If J is non-NULL, and 'jac' is not user-supplied: + - if J is dense or band, ensure that our DQ approx. is used + - otherwise => error */ + retval = 0; + if (idals_mem->J->ops->getid) { + + if ( (SUNMatGetID(idals_mem->J) == SUNMATRIX_DENSE) || + (SUNMatGetID(idals_mem->J) == SUNMATRIX_BAND) ) { + idals_mem->jac = idaLsDQJac; + idals_mem->J_data = IDA_mem; + } else { + retval++; + } + + } else { + retval++; + } + if (retval) { + IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", "idaLsInitialize", + "No Jacobian constructor available for SUNMatrix type"); + idals_mem->last_flag = IDALS_ILL_INPUT; + return(IDALS_ILL_INPUT); + } + + } else { + + /* If J is non-NULL, and 'jac' is user-supplied, + reset J_data pointer (just in case) */ + idals_mem->J_data = IDA_mem->ida_user_data; + } + + /* reset counters */ + idaLsInitializeCounters(idals_mem); + + /* Set Jacobian-related fields, based on jtimesDQ */ + if (idals_mem->jtimesDQ) { + idals_mem->jtsetup = NULL; + idals_mem->jtimes = idaLsDQJtimes; + idals_mem->jt_data = IDA_mem; + } else { + idals_mem->jt_data = IDA_mem->ida_user_data; + } + + /* if J is NULL and psetup is not present, then idaLsSetup does + not need to be called, so set the lsetup function to NULL */ + if ( (idals_mem->J == NULL) && (idals_mem->pset == NULL) ) + IDA_mem->ida_lsetup = NULL; + + /* Call LS initialize routine */ + idals_mem->last_flag = SUNLinSolInitialize(idals_mem->LS); + return(idals_mem->last_flag); +} + + +/*--------------------------------------------------------------- + idaLsSetup + + This calls the Jacobian evaluation routine (if using a SUNMatrix + object), updates counters, and calls the LS 'setup' routine to + prepare for subsequent calls to the LS 'solve' routine. +---------------------------------------------------------------*/ +int idaLsSetup(IDAMem IDA_mem, N_Vector y, N_Vector yp, N_Vector r, + N_Vector vt1, N_Vector vt2, N_Vector vt3) +{ + IDALsMem idals_mem; + int retval; + + /* access IDALsMem structure */ + if (IDA_mem->ida_lmem == NULL) { + IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDALS", + "idaLsSetup", MSG_LS_LMEM_NULL); + return(IDALS_LMEM_NULL); + } + idals_mem = (IDALsMem) IDA_mem->ida_lmem; + + /* Set IDALs N_Vector pointers to inputs */ + idals_mem->ycur = y; + idals_mem->ypcur = yp; + idals_mem->rcur = r; + + /* recompute if J if it is non-NULL */ + if (idals_mem->J) { + + /* Increment nje counter. */ + idals_mem->nje++; + + /* Clear the linear system matrix if necessary */ + if (SUNLinSolGetType(idals_mem->LS) == SUNLINEARSOLVER_DIRECT) { + retval = SUNMatZero(idals_mem->J); + if (retval != 0) { + IDAProcessError(IDA_mem, IDALS_SUNMAT_FAIL, "IDALS", + "idaLsSetup", MSG_LS_MATZERO_FAILED); + idals_mem->last_flag = IDALS_SUNMAT_FAIL; + return(idals_mem->last_flag); + } + } + + /* Call Jacobian routine */ + retval = idals_mem->jac(IDA_mem->ida_tn, IDA_mem->ida_cj, y, + yp, r, idals_mem->J, + idals_mem->J_data, vt1, vt2, vt3); + if (retval < 0) { + IDAProcessError(IDA_mem, IDALS_JACFUNC_UNRECVR, "IDALS", + "idaLsSetup", MSG_LS_JACFUNC_FAILED); + idals_mem->last_flag = IDALS_JACFUNC_UNRECVR; + return(-1); + } + if (retval > 0) { + idals_mem->last_flag = IDALS_JACFUNC_RECVR; + return(1); + } + + } + + /* Call LS setup routine -- the LS will call idaLsPSetup if applicable */ + idals_mem->last_flag = SUNLinSolSetup(idals_mem->LS, idals_mem->J); + return(idals_mem->last_flag); +} + + +/*--------------------------------------------------------------- + idaLsSolve + + This routine interfaces between IDA and the generic + SUNLinearSolver object LS, by setting the appropriate tolerance + and scaling vectors, calling the solver, accumulating + statistics from the solve for use/reporting by IDA, and scaling + the result if using a non-NULL SUNMatrix and cjratio does not + equal one. +---------------------------------------------------------------*/ +int idaLsSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, + N_Vector ycur, N_Vector ypcur, N_Vector rescur) +{ + IDALsMem idals_mem; + int nli_inc, retval; + realtype tol, w_mean; + + /* access IDALsMem structure */ + if (IDA_mem->ida_lmem == NULL) { + IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDALS", + "idaLsSolve", MSG_LS_LMEM_NULL); + return(IDALS_LMEM_NULL); + } + idals_mem = (IDALsMem) IDA_mem->ida_lmem; + + /* If the linear solver is iterative: set convergence test constant tol, + in terms of the Newton convergence test constant epsNewt and safety + factors. The factor sqrt(Neq) assures that the convergence test is + applied to the WRMS norm of the residual vector, rather than the + weighted L2 norm. */ + if (idals_mem->iterative) { + tol = idals_mem->sqrtN * idals_mem->eplifac * IDA_mem->ida_epsNewt; + } else { + tol = ZERO; + } + + /* Set vectors ycur, ypcur and rcur for use by the Atimes and + Psolve interface routines */ + idals_mem->ycur = ycur; + idals_mem->ypcur = ypcur; + idals_mem->rcur = rescur; + + /* Set scaling vectors for LS to use (if applicable) */ + if (idals_mem->LS->ops->setscalingvectors) { + retval = SUNLinSolSetScalingVectors(idals_mem->LS, weight, weight); + if (retval != SUNLS_SUCCESS) { + IDAProcessError(IDA_mem, IDALS_SUNLS_FAIL, "IDALS", "idaLsSolve", + "Error in calling SUNLinSolSetScalingVectors"); + idals_mem->last_flag = IDALS_SUNLS_FAIL; + return(idals_mem->last_flag); + } + + /* If solver is iterative and does not support scaling vectors, update the + tolerance in an attempt to account for weight vector. We make the + following assumptions: + 1. w_i = w_mean, for i=0,...,n-1 (i.e. the weights are homogeneous) + 2. the linear solver uses a basic 2-norm to measure convergence + Hence (using the notation from sunlinsol_spgmr.h, with S = diag(w)), + || bbar - Abar xbar ||_2 < tol + <=> || S b - S A x ||_2 < tol + <=> || S (b - A x) ||_2 < tol + <=> \sum_{i=0}^{n-1} (w_i (b - A x)_i)^2 < tol^2 + <=> w_mean^2 \sum_{i=0}^{n-1} (b - A x_i)^2 < tol^2 + <=> \sum_{i=0}^{n-1} (b - A x_i)^2 < tol^2 / w_mean^2 + <=> || b - A x ||_2 < tol / w_mean + So we compute w_mean = ||w||_RMS and scale the desired tolerance accordingly. */ + } else if (idals_mem->iterative) { + + N_VConst(ONE, idals_mem->x); + w_mean = N_VWrmsNorm(weight, idals_mem->x); + tol /= w_mean; + + } + + /* Set initial guess x = 0 to LS */ + N_VConst(ZERO, idals_mem->x); + + /* If a user-provided jtsetup routine is supplied, call that here */ + if (idals_mem->jtsetup) { + idals_mem->last_flag = idals_mem->jtsetup(IDA_mem->ida_tn, ycur, ypcur, rescur, + IDA_mem->ida_cj, idals_mem->jt_data); + idals_mem->njtsetup++; + if (idals_mem->last_flag != 0) { + IDAProcessError(IDA_mem, retval, "IDALS", + "idaLsSolve", MSG_LS_JTSETUP_FAILED); + return(idals_mem->last_flag); + } + } + + /* Call solver */ + retval = SUNLinSolSolve(idals_mem->LS, idals_mem->J, + idals_mem->x, b, tol); + + /* Copy appropriate result to b (depending on solver type) */ + if (idals_mem->iterative) { + + /* Retrieve solver statistics */ + nli_inc = SUNLinSolNumIters(idals_mem->LS); + + /* Copy x (or preconditioned residual vector if no iterations required) to b */ + if (nli_inc == 0) N_VScale(ONE, SUNLinSolResid(idals_mem->LS), b); + else N_VScale(ONE, idals_mem->x, b); + + /* Increment nli counter */ + idals_mem->nli += nli_inc; + + } else { + + /* Copy x to b */ + N_VScale(ONE, idals_mem->x, b); + + } + + /* If using a direct or matrix-iterative solver, scale the correction to + account for change in cj */ + if (idals_mem->scalesol && (IDA_mem->ida_cjratio != ONE)) + N_VScale(TWO/(ONE + IDA_mem->ida_cjratio), b, b); + + /* Increment ncfl counter */ + if (retval != SUNLS_SUCCESS) idals_mem->ncfl++; + + /* Interpret solver return value */ + idals_mem->last_flag = retval; + + switch(retval) { + + case SUNLS_SUCCESS: + return(0); + break; + case SUNLS_RES_REDUCED: + case SUNLS_CONV_FAIL: + case SUNLS_PSOLVE_FAIL_REC: + case SUNLS_PACKAGE_FAIL_REC: + case SUNLS_QRFACT_FAIL: + case SUNLS_LUFACT_FAIL: + return(1); + break; + case SUNLS_MEM_NULL: + case SUNLS_ILL_INPUT: + case SUNLS_MEM_FAIL: + case SUNLS_GS_FAIL: + case SUNLS_QRSOL_FAIL: + return(-1); + break; + case SUNLS_PACKAGE_FAIL_UNREC: + IDAProcessError(IDA_mem, SUNLS_PACKAGE_FAIL_UNREC, "IDALS", + "idaLsSolve", + "Failure in SUNLinSol external package"); + return(-1); + break; + case SUNLS_PSOLVE_FAIL_UNREC: + IDAProcessError(IDA_mem, SUNLS_PSOLVE_FAIL_UNREC, "IDALS", + "idaLsSolve", MSG_LS_PSOLVE_FAILED); + return(-1); + break; + } + + return(0); +} + + +/*--------------------------------------------------------------- + idaLsPerf: accumulates performance statistics information + for IDA +---------------------------------------------------------------*/ +int idaLsPerf(IDAMem IDA_mem, int perftask) +{ + IDALsMem idals_mem; + realtype rcfn, rcfl; + long int nstd, nnid; + booleantype lcfn, lcfl; + + /* access IDALsMem structure */ + if (IDA_mem->ida_lmem == NULL) { + IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDALS", + "idaLsPerf", MSG_LS_LMEM_NULL); + return(IDALS_LMEM_NULL); + } + idals_mem = (IDALsMem) IDA_mem->ida_lmem; + + /* when perftask == 0, store current performance statistics */ + if (perftask == 0) { + idals_mem->nst0 = IDA_mem->ida_nst; + idals_mem->nni0 = IDA_mem->ida_nni; + idals_mem->ncfn0 = IDA_mem->ida_ncfn; + idals_mem->ncfl0 = idals_mem->ncfl; + idals_mem->nwarn = 0; + return(0); + } + + /* Compute statistics since last call + + Note: the performance monitor that checked whether the average + number of linear iterations was too close to maxl has been + removed, since the 'maxl' value is no longer owned by the + IDALs interface. + */ + nstd = IDA_mem->ida_nst - idals_mem->nst0; + nnid = IDA_mem->ida_nni - idals_mem->nni0; + if (nstd == 0 || nnid == 0) return(0); + + rcfn = ((realtype) (IDA_mem->ida_ncfn - idals_mem->ncfn0)) / ((realtype) nstd); + rcfl = ((realtype) (idals_mem->ncfl - idals_mem->ncfl0)) / ((realtype) nnid); + lcfn = (rcfn > PT9); + lcfl = (rcfl > PT9); + if (!(lcfn || lcfl)) return(0); + idals_mem->nwarn++; + if (idals_mem->nwarn > 10) return(1); + if (lcfn) + IDAProcessError(IDA_mem, IDA_WARNING, "IDALS", "idaLsPerf", + MSG_LS_CFN_WARN, IDA_mem->ida_tn, rcfn); + if (lcfl) + IDAProcessError(IDA_mem, IDA_WARNING, "IDALS", "idaLsPerf", + MSG_LS_CFL_WARN, IDA_mem->ida_tn, rcfl); + return(0); +} + + +/*--------------------------------------------------------------- + idaLsFree frees memory associates with the IDALs system + solver interface. +---------------------------------------------------------------*/ +int idaLsFree(IDAMem IDA_mem) +{ + IDALsMem idals_mem; + + /* Return immediately if IDA_mem or IDA_mem->ida_lmem are NULL */ + if (IDA_mem == NULL) return (IDALS_SUCCESS); + if (IDA_mem->ida_lmem == NULL) return(IDALS_SUCCESS); + idals_mem = (IDALsMem) IDA_mem->ida_lmem; + + /* Free N_Vector memory */ + if (idals_mem->ytemp) { + N_VDestroy(idals_mem->ytemp); + idals_mem->ytemp = NULL; + } + if (idals_mem->yptemp) { + N_VDestroy(idals_mem->yptemp); + idals_mem->yptemp = NULL; + } + if (idals_mem->x) { + N_VDestroy(idals_mem->x); + idals_mem->x = NULL; + } + + /* Nullify other N_Vector pointers */ + idals_mem->ycur = NULL; + idals_mem->ypcur = NULL; + idals_mem->rcur = NULL; + + /* Nullify SUNMatrix pointer */ + idals_mem->J = NULL; + + /* Free preconditioner memory (if applicable) */ + if (idals_mem->pfree) idals_mem->pfree(IDA_mem); + + /* free IDALs interface structure */ + free(IDA_mem->ida_lmem); + + return(IDALS_SUCCESS); +} + + +/*--------------------------------------------------------------- + idaLsInitializeCounters resets all counters from an + IDALsMem structure. +---------------------------------------------------------------*/ +int idaLsInitializeCounters(IDALsMem idals_mem) +{ + idals_mem->nje = 0; + idals_mem->nreDQ = 0; + idals_mem->npe = 0; + idals_mem->nli = 0; + idals_mem->nps = 0; + idals_mem->ncfl = 0; + idals_mem->njtsetup = 0; + idals_mem->njtimes = 0; + return(0); +} + + +/*--------------------------------------------------------------- + idaLs_AccessLMem + + This routine unpacks the IDA_mem and idals_mem structures from + the void* ida_mem pointer. If either is missing it returns + IDALS_MEM_NULL or IDALS_LMEM_NULL. + ---------------------------------------------------------------*/ +int idaLs_AccessLMem(void* ida_mem, const char* fname, + IDAMem* IDA_mem, IDALsMem* idals_mem) +{ + if (ida_mem==NULL) { + IDAProcessError(NULL, IDALS_MEM_NULL, "IDALS", + fname, MSG_LS_IDAMEM_NULL); + return(IDALS_MEM_NULL); + } + *IDA_mem = (IDAMem) ida_mem; + if ((*IDA_mem)->ida_lmem==NULL) { + IDAProcessError(*IDA_mem, IDALS_LMEM_NULL, "IDALS", + fname, MSG_LS_LMEM_NULL); + return(IDALS_LMEM_NULL); + } + *idals_mem = (IDALsMem) (*IDA_mem)->ida_lmem; + return(IDALS_SUCCESS); +} + + +/*--------------------------------------------------------------- + EOF + ---------------------------------------------------------------*/ diff --git a/bazaar/plugin/sundials/src/ida/ida_ls_impl.h b/bazaar/plugin/sundials/src/ida/ida_ls_impl.h new file mode 100644 index 000000000..d2a042018 --- /dev/null +++ b/bazaar/plugin/sundials/src/ida/ida_ls_impl.h @@ -0,0 +1,195 @@ +/*----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * Alan C. Hindmarsh and Radu Serban @ LLNL + *----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *----------------------------------------------------------------- + * Implementation header file for IDA's linear solver interface. + *-----------------------------------------------------------------*/ + +#ifndef _IDALS_IMPL_H +#define _IDALS_IMPL_H + +#include +#include "ida_impl.h" + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/*----------------------------------------------------------------- + Types : struct IDALsMemRec, struct *IDALsMem + + The type IDALsMem is a pointer to a IDALsMemRec, which is a + structure containing fields that must be accessible by LS module + routines. + -----------------------------------------------------------------*/ +typedef struct IDALsMemRec { + + /* Linear solver type information */ + booleantype iterative; /* is the solver iterative? */ + booleantype matrixbased; /* is a matrix structure used? */ + + /* Jacobian construction & storage */ + booleantype jacDQ; /* SUNTRUE if using internal DQ Jacobian approx. */ + IDALsJacFn jac; /* Jacobian routine to be called */ + void *J_data; /* J_data is passed to jac */ + + /* Linear solver, matrix and vector objects/pointers */ + SUNLinearSolver LS; /* generic linear solver object */ + SUNMatrix J; /* J = dF/dy + cj*dF/dy' */ + N_Vector ytemp; /* temp vector used by IDAAtimesDQ */ + N_Vector yptemp; /* temp vector used by IDAAtimesDQ */ + N_Vector x; /* temp vector used by the solve function */ + N_Vector ycur; /* current y vector in Newton iteration */ + N_Vector ypcur; /* current yp vector in Newton iteration */ + N_Vector rcur; /* rcur = F(tn, ycur, ypcur) */ + + /* Matrix-based solver, scale solution to account for change in cj */ + booleantype scalesol; + + /* Iterative solver tolerance */ + realtype sqrtN; /* sqrt(N) */ + realtype eplifac; /* eplifac = linear convergence factor */ + + /* Statistics and associated parameters */ + realtype dqincfac; /* dqincfac = optional increment factor in Jv */ + long int nje; /* nje = no. of calls to jac */ + long int npe; /* npe = total number of precond calls */ + long int nli; /* nli = total number of linear iterations */ + long int nps; /* nps = total number of psolve calls */ + long int ncfl; /* ncfl = total number of convergence failures */ + long int nreDQ; /* nreDQ = total number of calls to res */ + long int njtsetup; /* njtsetup = total number of calls to jtsetup */ + long int njtimes; /* njtimes = total number of calls to jtimes */ + long int nst0; /* nst0 = saved nst (for performance monitor) */ + long int nni0; /* nni0 = saved nni (for performance monitor) */ + long int ncfn0; /* ncfn0 = saved ncfn (for performance monitor) */ + long int ncfl0; /* ncfl0 = saved ncfl (for performance monitor) */ + long int nwarn; /* nwarn = no. of warnings (for perf. monitor) */ + + int last_flag; /* last error return flag */ + + /* Preconditioner computation + (a) user-provided: + - pdata == user_data + - pfree == NULL (the user dealocates memory) + (b) internal preconditioner module + - pdata == ida_mem + - pfree == set by the prec. module and called in idaLsFree */ + IDALsPrecSetupFn pset; + IDALsPrecSolveFn psolve; + int (*pfree)(IDAMem IDA_mem); + void *pdata; + + /* Jacobian times vector compuation + (a) jtimes function provided by the user: + - jt_data == user_data + - jtimesDQ == SUNFALSE + (b) internal jtimes + - jt_data == ida_mem + - jtimesDQ == SUNTRUE */ + booleantype jtimesDQ; + IDALsJacTimesSetupFn jtsetup; + IDALsJacTimesVecFn jtimes; + void *jt_data; + +} *IDALsMem; + + +/*----------------------------------------------------------------- + Prototypes of internal functions + -----------------------------------------------------------------*/ + +/* Interface routines called by system SUNLinearSolver */ +int idaLsATimes(void *ida_mem, N_Vector v, N_Vector z); +int idaLsPSetup(void *ida_mem); +int idaLsPSolve(void *ida_mem, N_Vector r, N_Vector z, + realtype tol, int lr); + +/* Difference quotient approximation for Jac times vector */ +int idaLsDQJtimes(realtype tt, N_Vector yy, N_Vector yp, + N_Vector rr, N_Vector v, N_Vector Jv, + realtype c_j, void *data, + N_Vector work1, N_Vector work2); + +/* Difference-quotient Jacobian approximation routines */ +int idaLsDQJac(realtype tt, realtype c_j, N_Vector yy, N_Vector yp, + N_Vector rr, SUNMatrix Jac, void *data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); +int idaLsDenseDQJac(realtype tt, realtype c_j, N_Vector yy, + N_Vector yp, N_Vector rr, SUNMatrix Jac, + IDAMem IDA_mem, N_Vector tmp1); +int idaLsBandDQJac(realtype tt, realtype c_j, N_Vector yy, + N_Vector yp, N_Vector rr, SUNMatrix Jac, + IDAMem IDA_mem, N_Vector tmp1, + N_Vector tmp2, N_Vector tmp3); + +/* Generic linit/lsetup/lsolve/lperf/lfree interface routines for IDA to call */ +int idaLsInitialize(IDAMem IDA_mem); +int idaLsSetup(IDAMem IDA_mem, N_Vector y, N_Vector yp, N_Vector r, + N_Vector vt1, N_Vector vt2, N_Vector vt3); +int idaLsSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, + N_Vector ycur, N_Vector ypcur, N_Vector rescur); +int idaLsPerf(IDAMem IDA_mem, int perftask); +int idaLsFree(IDAMem IDA_mem); + + +/* Auxilliary functions */ +int idaLsInitializeCounters(IDALsMem idals_mem); +int idaLs_AccessLMem(void* ida_mem, const char* fname, + IDAMem* IDA_mem, IDALsMem* idals_mem); + + +/*--------------------------------------------------------------- + Error and Warning Messages + ---------------------------------------------------------------*/ + +#if defined(SUNDIALS_EXTENDED_PRECISION) +#define MSG_LS_TIME "at t = %Lg, " +#define MSG_LS_FRMT "%Le." +#elif defined(SUNDIALS_DOUBLE_PRECISION) +#define MSG_LS_TIME "at t = %lg, " +#define MSG_LS_FRMT "%le." +#else +#define MSG_LS_TIME "at t = %g, " +#define MSG_LS_FRMT "%e." +#endif + +/* Error Messages */ +#define MSG_LS_IDAMEM_NULL "Integrator memory is NULL." +#define MSG_LS_MEM_FAIL "A memory request failed." +#define MSG_LS_BAD_NVECTOR "A required vector operation is not implemented." +#define MSG_LS_BAD_SIZES "Illegal bandwidth parameter(s). Must have 0 <= ml, mu <= N-1." +#define MSG_LS_BAD_LSTYPE "Incompatible linear solver type." +#define MSG_LS_LMEM_NULL "Linear solver memory is NULL." +#define MSG_LS_BAD_GSTYPE "gstype has an illegal value." +#define MSG_LS_NEG_MAXRS "maxrs < 0 illegal." +#define MSG_LS_NEG_EPLIFAC "eplifac < 0.0 illegal." +#define MSG_LS_NEG_DQINCFAC "dqincfac < 0.0 illegal." +#define MSG_LS_PSET_FAILED "The preconditioner setup routine failed in an unrecoverable manner." +#define MSG_LS_PSOLVE_FAILED "The preconditioner solve routine failed in an unrecoverable manner." +#define MSG_LS_JTSETUP_FAILED "The Jacobian x vector setup routine failed in an unrecoverable manner." +#define MSG_LS_JTIMES_FAILED "The Jacobian x vector routine failed in an unrecoverable manner." +#define MSG_LS_JACFUNC_FAILED "The Jacobian routine failed in an unrecoverable manner." +#define MSG_LS_MATZERO_FAILED "The SUNMatZero routine failed in an unrecoverable manner." + +/* Warning Messages */ +#define MSG_LS_WARN "Warning: " MSG_LS_TIME "poor iterative algorithm performance. " +#define MSG_LS_CFN_WARN MSG_LS_WARN "Nonlinear convergence failure rate is " MSG_LS_FRMT +#define MSG_LS_CFL_WARN MSG_LS_WARN "Linear convergence failure rate is " MSG_LS_FRMT + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/ida/ida_nls.c b/bazaar/plugin/sundials/src/ida/ida_nls.c new file mode 100644 index 000000000..ee4f67be2 --- /dev/null +++ b/bazaar/plugin/sundials/src/ida/ida_nls.c @@ -0,0 +1,286 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------------------- + * This the implementation file for the IDA nonlinear solver interface. + * ---------------------------------------------------------------------------*/ + +#include "ida_impl.h" +#include "sundials/sundials_math.h" + +/* constant macros */ +#define PT0001 RCONST(0.0001) /* real 0.0001 */ +#define ONE RCONST(1.0) /* real 1.0 */ +#define TWENTY RCONST(20.0) /* real 20.0 */ + +/* nonlinear solver parameters */ +#define MAXIT 4 /* default max number of nonlinear iterations */ +#define RATEMAX RCONST(0.9) /* max convergence rate used in divergence check */ + +/* private functions passed to nonlinear solver */ +static int idaNlsResidual(N_Vector ycor, N_Vector res, void* ida_mem); +static int idaNlsLSetup(booleantype jbad, booleantype* jcur, void* ida_mem); +static int idaNlsLSolve(N_Vector delta, void* ida_mem); +static int idaNlsConvTest(SUNNonlinearSolver NLS, N_Vector ycor, N_Vector del, + realtype tol, N_Vector ewt, void* ida_mem); + +/* ----------------------------------------------------------------------------- + * Exported functions + * ---------------------------------------------------------------------------*/ + +int IDASetNonlinearSolver(void *ida_mem, SUNNonlinearSolver NLS) +{ + IDAMem IDA_mem; + int retval; + + /* return immediately if IDA memory is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", + "IDASetNonlinearSolver", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* return immediately if NLS memory is NULL */ + if (NLS == NULL) { + IDAProcessError(NULL, IDA_ILL_INPUT, "IDA", + "IDASetNonlinearSolver", + "NLS must be non-NULL"); + return(IDA_ILL_INPUT); + } + + /* check for required nonlinear solver functions */ + if ( NLS->ops->gettype == NULL || + NLS->ops->solve == NULL || + NLS->ops->setsysfn == NULL ) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", + "IDASetNonlinearSolver", + "NLS does not support required operations"); + return(IDA_ILL_INPUT); + } + + /* check for allowed nonlinear solver types */ + if (SUNNonlinSolGetType(NLS) != SUNNONLINEARSOLVER_ROOTFIND) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", + "IDASetNonlinearSolver", + "NLS type must be SUNNONLINEARSOLVER_ROOTFIND"); + return(IDA_ILL_INPUT); + } + + /* free any existing nonlinear solver */ + if ((IDA_mem->NLS != NULL) && (IDA_mem->ownNLS)) + retval = SUNNonlinSolFree(IDA_mem->NLS); + + /* set SUNNonlinearSolver pointer */ + IDA_mem->NLS = NLS; + + /* Set NLS ownership flag. If this function was called to attach the default + NLS, IDA will set the flag to SUNTRUE after this function returns. */ + IDA_mem->ownNLS = SUNFALSE; + + /* set the nonlinear residual function */ + retval = SUNNonlinSolSetSysFn(IDA_mem->NLS, idaNlsResidual); + if (retval != IDA_SUCCESS) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", + "IDASetNonlinearSolver", + "Setting nonlinear system function failed"); + return(IDA_ILL_INPUT); + } + + /* set convergence test function */ + retval = SUNNonlinSolSetConvTestFn(IDA_mem->NLS, idaNlsConvTest, ida_mem); + if (retval != IDA_SUCCESS) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", + "IDASetNonlinearSolver", + "Setting convergence test function failed"); + return(IDA_ILL_INPUT); + } + + /* set max allowed nonlinear iterations */ + retval = SUNNonlinSolSetMaxIters(IDA_mem->NLS, MAXIT); + if (retval != IDA_SUCCESS) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", + "IDASetNonlinearSolver", + "Setting maximum number of nonlinear iterations failed"); + return(IDA_ILL_INPUT); + } + + return(IDA_SUCCESS); +} + + +/* ----------------------------------------------------------------------------- + * Private functions + * ---------------------------------------------------------------------------*/ + +int idaNlsInit(IDAMem IDA_mem) +{ + int retval; + + /* set the linear solver setup wrapper function */ + if (IDA_mem->ida_lsetup) + retval = SUNNonlinSolSetLSetupFn(IDA_mem->NLS, idaNlsLSetup); + else + retval = SUNNonlinSolSetLSetupFn(IDA_mem->NLS, NULL); + + if (retval != IDA_SUCCESS) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "idaNlsInit", + "Setting the linear solver setup function failed"); + return(IDA_NLS_INIT_FAIL); + } + + /* set the linear solver solve wrapper function */ + if (IDA_mem->ida_lsolve) + retval = SUNNonlinSolSetLSolveFn(IDA_mem->NLS, idaNlsLSolve); + else + retval = SUNNonlinSolSetLSolveFn(IDA_mem->NLS, NULL); + + if (retval != IDA_SUCCESS) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "idaNlsInit", + "Setting linear solver solve function failed"); + return(IDA_NLS_INIT_FAIL); + } + + /* initialize nonlinear solver */ + retval = SUNNonlinSolInitialize(IDA_mem->NLS); + + if (retval != IDA_SUCCESS) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "idaNlsInit", + MSG_NLS_INIT_FAIL); + return(IDA_NLS_INIT_FAIL); + } + + return(IDA_SUCCESS); +} + + +static int idaNlsLSetup(booleantype jbad, booleantype* jcur, void* ida_mem) +{ + IDAMem IDA_mem; + int retval; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "idaNlsLSetup", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + IDA_mem->ida_nsetups++; + retval = IDA_mem->ida_lsetup(IDA_mem, IDA_mem->ida_yy, IDA_mem->ida_yp, + IDA_mem->ida_savres, IDA_mem->ida_tempv1, + IDA_mem->ida_tempv2, IDA_mem->ida_tempv3); + + /* update Jacobian status */ + *jcur = SUNTRUE; + + /* update convergence test constants */ + IDA_mem->ida_cjold = IDA_mem->ida_cj; + IDA_mem->ida_cjratio = ONE; + IDA_mem->ida_ss = TWENTY; + + if (retval < 0) return(IDA_LSETUP_FAIL); + if (retval > 0) return(IDA_LSETUP_RECVR); + + return(IDA_SUCCESS); +} + + +static int idaNlsLSolve(N_Vector delta, void* ida_mem) +{ + IDAMem IDA_mem; + int retval; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "idaNlsLSolve", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + retval = IDA_mem->ida_lsolve(IDA_mem, delta, IDA_mem->ida_ewt, + IDA_mem->ida_yy, IDA_mem->ida_yp, + IDA_mem->ida_savres); + + if (retval < 0) return(IDA_LSOLVE_FAIL); + if (retval > 0) return(IDA_LSOLVE_RECVR); + + return(IDA_SUCCESS); +} + + +static int idaNlsResidual(N_Vector ycor, N_Vector res, void* ida_mem) +{ + IDAMem IDA_mem; + int retval; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "idaNlsResidual", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* update yy and yp based on the current correction */ + N_VLinearSum(ONE, IDA_mem->ida_yypredict, ONE, ycor, IDA_mem->ida_yy); + N_VLinearSum(ONE, IDA_mem->ida_yppredict, IDA_mem->ida_cj, ycor, IDA_mem->ida_yp); + + /* evaluate residual */ + retval = IDA_mem->ida_res(IDA_mem->ida_tn, IDA_mem->ida_yy, IDA_mem->ida_yp, + res, IDA_mem->ida_user_data); + + /* increment the number of residual evaluations */ + IDA_mem->ida_nre++; + + /* save a copy of the residual vector in savres */ + N_VScale(ONE, res, IDA_mem->ida_savres); + + if (retval < 0) return(IDA_RES_FAIL); + if (retval > 0) return(IDA_RES_RECVR); + + return(IDA_SUCCESS); +} + + +static int idaNlsConvTest(SUNNonlinearSolver NLS, N_Vector ycor, N_Vector del, + realtype tol, N_Vector ewt, void* ida_mem) +{ + IDAMem IDA_mem; + int m, retval; + realtype delnrm; + realtype rate; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "idaNlsConvTest", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* compute the norm of the correction */ + delnrm = N_VWrmsNorm(del, ewt); + + /* get the current nonlinear solver iteration count */ + retval = SUNNonlinSolGetCurIter(NLS, &m); + if (retval != IDA_SUCCESS) return(IDA_MEM_NULL); + + /* test for convergence, first directly, then with rate estimate. */ + if (m == 0){ + IDA_mem->ida_oldnrm = delnrm; + if (delnrm <= PT0001 * IDA_mem->ida_toldel) return(SUN_NLS_SUCCESS); + } else { + rate = SUNRpowerR( delnrm/IDA_mem->ida_oldnrm, ONE/m ); + if (rate > RATEMAX) return(SUN_NLS_CONV_RECVR); + IDA_mem->ida_ss = rate/(ONE - rate); + } + + if (IDA_mem->ida_ss*delnrm <= tol) return(SUN_NLS_SUCCESS); + + /* not yet converged */ + return(SUN_NLS_CONTINUE); +} diff --git a/bazaar/plugin/sundials/src/ida/ida_spils.c b/bazaar/plugin/sundials/src/ida/ida_spils.c new file mode 100644 index 000000000..7e806c5f8 --- /dev/null +++ b/bazaar/plugin/sundials/src/ida/ida_spils.c @@ -0,0 +1,81 @@ +/*----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * Alan Hindmarsh, Radu Serban and Aaron Collier @ LLNL + *----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *----------------------------------------------------------------- + * Implementation file for the deprecated Scaled and Preconditioned + * Iterative Linear Solver interface in IDA; these routines now just + * wrap the updated IDA generic linear solver interface in ida_ls.h. + *-----------------------------------------------------------------*/ + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/*================================================================= + Exported Functions (wrappers for equivalent routines in ida_ls.h) + =================================================================*/ + +int IDASpilsSetLinearSolver(void *ida_mem, SUNLinearSolver LS) +{ return(IDASetLinearSolver(ida_mem, LS, NULL)); } + +int IDASpilsSetPreconditioner(void *ida_mem, IDASpilsPrecSetupFn pset, + IDASpilsPrecSolveFn psolve) +{ return(IDASetPreconditioner(ida_mem, pset, psolve)); } + +int IDASpilsSetJacTimes(void *ida_mem, IDASpilsJacTimesSetupFn jtsetup, + IDASpilsJacTimesVecFn jtimes) +{ return(IDASetJacTimes(ida_mem, jtsetup, jtimes)); } + +int IDASpilsSetEpsLin(void *ida_mem, realtype eplifac) +{ return(IDASetEpsLin(ida_mem, eplifac)); } + +int IDASpilsSetIncrementFactor(void *ida_mem, realtype dqincfac) +{ return(IDASetIncrementFactor(ida_mem, dqincfac)); } + +int IDASpilsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS) +{ return(IDAGetLinWorkSpace(ida_mem, lenrwLS, leniwLS)); } + +int IDASpilsGetNumPrecEvals(void *ida_mem, long int *npevals) +{ return(IDAGetNumPrecEvals(ida_mem, npevals)); } + +int IDASpilsGetNumPrecSolves(void *ida_mem, long int *npsolves) +{ return(IDAGetNumPrecSolves(ida_mem, npsolves)); } + +int IDASpilsGetNumLinIters(void *ida_mem, long int *nliters) +{ return(IDAGetNumLinIters(ida_mem, nliters)); } + +int IDASpilsGetNumConvFails(void *ida_mem, long int *nlcfails) +{ return(IDAGetNumLinConvFails(ida_mem, nlcfails)); } + +int IDASpilsGetNumJTSetupEvals(void *ida_mem, long int *njtsetups) +{ return(IDAGetNumJTSetupEvals(ida_mem, njtsetups)); } + +int IDASpilsGetNumJtimesEvals(void *ida_mem, long int *njvevals) +{ return(IDAGetNumJtimesEvals(ida_mem, njvevals)); } + +int IDASpilsGetNumResEvals(void *ida_mem, long int *nrevalsLS) +{ return(IDAGetNumLinResEvals(ida_mem, nrevalsLS)); } + +int IDASpilsGetLastFlag(void *ida_mem, long int *flag) +{ return(IDAGetLastLinFlag(ida_mem, flag)); } + +char *IDASpilsGetReturnFlagName(long int flag) +{ return(IDAGetLinReturnFlagName(flag)); } + +#ifdef __cplusplus +} +#endif + diff --git a/bazaar/plugin/sundials/src/kinsol/fcmix/fkinbbd.h b/bazaar/plugin/sundials/src/kinsol/fcmix/fkinbbd.h new file mode 100644 index 000000000..e9a16772f --- /dev/null +++ b/bazaar/plugin/sundials/src/kinsol/fcmix/fkinbbd.h @@ -0,0 +1,317 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the Fortran interface include file for the BBD + * preconditioner module KINBBDPRE. + * -----------------------------------------------------------------*/ + +/******************************************************************************* + + FKINBBD Interface Package + + The FKINBBD Interface Package is a package of C functions which support the + use of the KINSOL solver and MPI-parallel N_Vector module, along with the + KINBBDPRE preconditioner module, for the solution of nonlinear systems in a + mixed Fortran/C setting. The combination of KINSOL and KINBBDPRE solves systems + linear system arising from the solution of f(u) = 0 using a Krylov iterative + linear solver via the KINSPILS interface, and with a preconditioner that is + block-diagonal with banded blocks. While KINSOL and KINBBDPRE are written in C, + it is assumed here that the user's calling program and user-supplied + problem-defining routines are written in Fortran. + + The user-callable functions in this package, with the corresponding KINSOL and + KINBBDPRE functions, are as follows: + + FKINBBDINIT : interfaces to KINBBDPrecInit + FKINBBDOPT : accesses optional outputs + FKINBBDFREE : interfaces to KINBBDPrecFree + + In addition to the Fortran system function FKFUN, and optional Jacobian vector + product routine FKJTIMES, the following are the user-supplied functions + required by this package, each with the corresponding interface function which + calls it (and its type within KINBBDPRE): + + FKLOCFN : called by the interface function FKINgloc of type KINBBDLocalFn + FKCOMMFN : called by the interface function FKINgcomm of type KINBBDCommFn + + Note: The names of all user-supplied routines here are fixed, in order to + maximize portability for the resulting mixed-language program. + + Note: The names used within this interface package make use of the preprocessor + to expand them appropriately for different machines/platforms. Later in this + file, each name is expanded appropriately. For example, FKIN_BBDINIT is + replaced with either fkinbbdinit, fkinbbdinit_, or fkinbbdinit__ depending + upon the platform. + + ============================================================================== + + Usage of the FKINSOL/FKINBBD Interface Packages + + The usage of combined interface packages FKINSOL and FKINBBD requires calls + to several interface functions, and a few user-supplied routines which define + the problem to be solved and indirectly define the preconditioner. These + function calls and user routines are summarized separately below. + + Some details have been omitted, and the user is referred to the KINSOL User + Guide for more complete information. + + (1) User-supplied system function routine: FKFUN + + The user must in all cases supply the following Fortran routine: + + SUBROUTINE FKFUN (UU, FVAL, IER) + DIMENSION UU(*), FVAL(*) + + It must set the FVAL array to f(u), the system function, as a function + of the array UU = u. Here UU and FVAL are vectors (distributed in the + parallel case). IER is a return flag (currently not used). + + (2) Optional user-supplied Jacobian-vector product routine: FKJTIMES + + As an option, the user may supply a routine that computes the product + of the system Jacobian and a given vector. The user-supplied function + must have the following form: + + SUBROUTINE FKJTIMES (V, Z, NEWU, UU, IER) + DIMENSION V(*), Z(*), UU(*) + + This must set the array Z to the product J*V, where J is the Jacobian + matrix J = dF/du, and V is a given array. Here UU is an array containing + the current value of the unknown vector u, and NEWU is an input integer + indicating whether UU has changed since FKJTIMES was last called + (1 = yes, 0 = no). If FKJTIMES computes and saves Jacobian data, then + no such computation is necessary when NEWU = 0. Here V, Z, and UU are + arrays of length NLOC - the local length of all distributed vectors. + FKJTIMES should return IER = 0 if successful, or a nonzero IER otherwise. + + (3) User-supplied routines to define preconditoner: FKLOCFN and FKCOMMFN + + The routines in the KINBBDPRE (kinbbdpre.c) module provide a preconditioner + matrix for KINSOL that is block-diagonal with banded blocks. The blocking + corresponds to the distribution of the dependent variable vector u + amongst the processes. Each preconditioner block is generated from the + Jacobian of the local part (associated with the current process) of a given + function g(u) approximating f(u). The blocks are generated by a difference + quotient scheme (independently by each process), utilizing the assumed + banded structure with given half-bandwidths. + + (3.1) Local approximate function: FKLOCFN + + The user must supply a subroutine of the following form: + + SUBROUTINE FKLOCFN (NLOC, ULOC, GLOC, IER) + DIMENSION ULOC(*), GLOC(*) + + The routine is used to compute the function g(u) which approximates the + system function f(u). This function is to be computed locally, i.e. + without inter-process communication. Note: The case where g is + mathematically identical to f is allowed. It takes as input the local + vector length (NLOC) and the local real solution array ULOC. It is to + compute the local part of g(u) and store the result in the realtype + array GLOC. IER is a return flag (currently not used). + + (3.2) Communication function: FKCOMMFN + + The user must also supply a subroutine of the following form: + + SUBROUTINE FKCOMMFN (NLOC, ULOC, IER) + DIMENSION ULOC(*) + + The routine is used to perform all inter-process communication necessary + to evaluate the approximate system function g described above. This + function takes as input the local vector length (NLOC), and the local real + dependent variable array ULOC. It is expected to save communicated data in + work space defined by the user, and made available to FKLOCFN. Each call + to the FKCOMMFN function is preceded by a call to FKFUN with the same + arguments. Thus FKCOMMFN can omit any communications done by FKFUN if + relevant to the evaluation of g. IER is a return flag (currently not + used). + + (4) Initialization: FNVINITP, FKINMALLOC, FKINBBDINIT, and FKINBBDSP* + + (4.1) To initialize the parallel machine environment, the user must make the + following call: + + CALL FNVINITP (5, NLOCAL, NGLOBAL, IER) + + The arguments are: + NLOCAL = local size of vectors associated with process + NGLOBAL = the system size, and the global size of vectors (the sum + of all values of NLOCAL) + IER = return completion flag. Values are 0 = success, and + -1 = failure. + + (4.2) To allocate internal memory for KINSOL, make the following call: + + CALL FKINMALLOC (MSBPRE, FNORMTOL, SCSTEPTOL, CONSTRAINTS, + OPTIN, IOPT, ROPT, IER) + + The arguments are: + MSBPRE = maximum number of preconditioning solve calls without + calling the preconditioning setup routine + Note: 0 indicates default (10). + FNORMTOL = tolerance on the norm of f(u) to accept convergence + SCSTEPTOL = tolerance on minimum scaled step size + CONSTRAINTS = array of constraint values on components of the + solution vector UU + INOPT = integer used as a flag to indicate whether possible + input values in IOPT[] array are to be used for + input: 0 = no and 1 = yes. + IOPT = array for integer optional inputs and outputs (declare + as INTEGER*8 + ROPT = array of real optional inputs and outputs + IER = return completion flag. Values are 0 = success, and + -1 = failure. + + Note: See printed message for details in case of failure. + + (4.3) Initialize and attach one of the SPILS linear solvers. Make one of the + following calls to initialize a solver (see fkinsol.h for more details): + + CALL FSUNPCGINIT(3, PRETYPE, MAXL, IER) + CALL FSUNSPBCGSINIT(3, PRETYPE, MAXL, IER) + CALL FSUNSPFGMRINIT(3, PRETYPE, MAXL, IER) + CALL FSUNSPGMRINIT(3, PRETYPE, MAXL, IER) + CALL FSUNSPTFQMRINIT(3, PRETYPE, MAXL, IER) + + Then to attach the iterative linear solver structure the user must call: + + CALL FKINSPILSINIT(IER) + + (4.4) To allocate memory and initialize data associated with the BBD + preconditioner, make the following call: + + CALL FKINBBDINIT(NLOCAL, MUDQ, MLDQ, MU, ML, IER) + + The arguments are: + NLOCAL = local vector size on this process [long int, input] + MUDQ = upper half-bandwidth to be used in the computation + of the local Jacobian blocks by difference + quotients. These may be smaller than the true + half-bandwidths of the Jacobian of the local block + of g, when smaller values may provide greater + efficiency [long int, input] + MLDQ = lower half-bandwidth to be used in the computation + of the local Jacobian blocks by difference + quotients [long int, input] + MU = upper half-bandwidth of the band matrix that is + retained as an approximation of the local Jacobian + block (may be smaller than MUDQ) [long int, input] + ML = lower half-bandwidth of the band matrix that is + retained as an approximation of the local Jacobian + block (may be smaller than MLDQ) [long int, input] + IER = return completion flag [int, output]: + 0 = success + <0 = an error occurred + + (5) To solve the system, make the following call: + + CALL FKINSOL (UU, GLOBALSTRAT, USCALE, FSCALE, IER) + + The arguments are: + UU = array containing the initial guess when called and the + solution upon termination + GLOBALSTRAT = (INTEGER) a number defining the global strategy choice: + 1 = inexact Newton, 2 = line search. + USCALE = array of scaling factors for the UU vector + FSCALE = array of scaling factors for the FVAL (function) vector + IER = integer error flag as returned by KINSOL. + + Note: See the KINSOL documentation for further information. + + (6) Optional outputs: FKINBBDOPT + + In addition to the optional inputs and outputs available with the FKINSOL + interface package, there are optional outputs specific to the KINBBDPRE + module. These are accessed by making the following call: + + CALL FKINBBDOPT (LENRPW, LENIPW, NGE) + + The arguments returned are: + LENRPW = length of real preconditioner work space, in realtype words + Note: This size is local to the current process. + LENIPW = length of integer preconditioner work space, in integer words + Note: This size is local to the current process. + NGE = number of g(u) evaluations (calls to FKLOCFN) + + (7) Memory freeing: FKINFREE + + To the free the internal memory created by the calls to FNVINITP + and FKINMALLOC, make the following call: + + CALL FKINFREE + +*******************************************************************************/ + +#ifndef _FKINBBD_H +#define _FKINBBD_H + +/* + * ----------------------------------------------------------------- + * header files + * ----------------------------------------------------------------- + */ +#include /* definition of type N_Vector */ +#include /* definition of type realtype */ + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ----------------------------------------------------------------- + * generic names are translated through the define statements below + * ----------------------------------------------------------------- + */ + +#if defined(SUNDIALS_F77_FUNC) + +#define FKIN_BBDINIT SUNDIALS_F77_FUNC(fkinbbdinit, FKINBBDINIT) +#define FKIN_BBDOPT SUNDIALS_F77_FUNC(fkinbbdopt, FKINBBDOPT) +#define FK_COMMFN SUNDIALS_F77_FUNC(fkcommfn, FKCOMMFN) +#define FK_LOCFN SUNDIALS_F77_FUNC(fklocfn, FKLOCFN) + +#else + +#define FKIN_BBDINIT fkinbbdinit_ +#define FKIN_BBDOPT fkinbbdopt_ +#define FK_COMMFN fkcommfn_ +#define FK_LOCFN fklocfn_ + +#endif + +/* + * ----------------------------------------------------------------- + * Prototypes: exported functions + * ----------------------------------------------------------------- + */ + +void FKIN_BBDINIT(long int *nlocal, long int *mudq, long int *mldq, + long int *mu, long int *ml, int *ier); +void FKIN_BBDOPT(long int *lenrpw, long int *lenipw, long int *nge); + +/* + * ----------------------------------------------------------------- + * Prototypes: FKINgloc and FKINgcomm + * ----------------------------------------------------------------- + */ + +int FKINgloc(long int Nloc, N_Vector uu, N_Vector gval, void *user_data); +int FKINgcomm(long int Nloc, N_Vector uu, void *user_data); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/kinsol/fcmix/fkinsol.h b/bazaar/plugin/sundials/src/kinsol/fcmix/fkinsol.h new file mode 100644 index 000000000..96349ed3f --- /dev/null +++ b/bazaar/plugin/sundials/src/kinsol/fcmix/fkinsol.h @@ -0,0 +1,783 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and + * Aaron Collier @ LLNL + * Daniel R. Reynolds @ SMU + * David J. Gardner @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the FKINSOL Interface Package. + * See below for usage details. + * -----------------------------------------------------------------*/ + +/*************************************************************************** + + FKINSOL Interface Package + + The FKINSOL Interface Package is a package of C functions which support the + use of the KINSOL solver for the solution of nonlinear systems f(u) = 0, + in a mixed Fortran/C setting. While KINSOL is written in C, it is assumed + here that the user's calling program and user-supplied problem-defining + routines are written in Fortran. This package provides the necessary + interface to KINSOL for the serial and parallel NVECTOR + implementations. + + The user-callable functions, with the corresponding KINSOL functions, + are as follows: + + FNVINITS, FNVINITP, FNVINITOMP, FNVINITPTS + initialize serial, distributed memory parallel, or threaded + vector computations + FKINMALLOC interfaces to KINInit + FKINCREATE interfaces to KINCreate + FKININIT interfaces to KINInit + FKINSETIIN, FKINSETRIN, FKINSETVIN interface to KINSet* functions + FKINSOL interfaces to KINSol and KINGet* functions + FKINFREE interfaces to KINFree + FKINLSINIT interface to KINSetLinearSolver + FKINDENSESETJAC interface to KINSetJacFn + FKINBANDSETJAC interface to KINSetJacFn + FKINSPARSESETJAC interface to KINSetJacFn + FKINLSSETJAC interface to KINSetJacTimes + FKINLSSETPREC interface to KINSetPreconditioner + + The user-supplied functions, each with the corresponding interface function + which calls it (and its type within KINSOL), are as follows: + + FKFUN : called by the interface function FKINfunc of type KINSysFn + FKDJAC : called by the interface function FKINDenseJac of type + KINLsJacFn + FKBJAC : called by the interface function FKINBandJac of type + KINLsJacFn + FKINSPJAC: called by the interface function FKINSparseJac of type + KINLsJacFn + FKJTIMES : called by the interface function FKINJtimes of type + KINLsJacTimesVecFn + FKPSOL : called by the interface function FKINPSol of type + KINLsPrecSolveFn + FKPSET : called by the interface function FKINPSet of type + KINLsPrecSetupFn + + In contrast to the case of direct use of KINSOL, the names of all + user-supplied routines here are fixed, in order to maximize portability for + the resulting mixed-language program. + + Important note on portability: + In this package, the names of the interface functions, and the names of + the Fortran user routines called by them, appear as dummy names + which are mapped to actual values by a series of definitions, in this + and other header files. + + ========================================================================= + + Usage of the FKINSOL Interface Package + + The usage of FKINSOL requires calls to several interface functions, and + to a few user-supplied routines which define the problem to be solved. + These function calls and user routines are summarized separately below. + + Some details are omitted, and the user is referred to the KINSOL manual + for more complete documentation. Information on the arguments of any + given user-callable interface routine, or of a given user-supplied + function called by an interface function, can be found in the + documentation on the corresponding function in the KINSOL package. + + The number labels on the instructions below end with "s" for instructions + that apply to the serial version of KINSOL only, and end with "p" for + those that apply to the parallel version only. + + (1) User-supplied system routine: FKFUN + + The user must in all cases supply the following Fortran routine: + + SUBROUTINE FKFUN (UU, FVAL, IER) + DIMENSION UU(*), FVAL(*) + + It must set the FVAL array to f(u), the system function, as a + function of the array UU = u. Here UU and FVAL are arrays representing + vectors, which are distributed vectors in the parallel case. + IER is a return flag, which should be 0 if FKFUN was successful. + Return IER > 0 if a recoverable error occurred (and KINSOL is to try + to recover). Return IER < 0 if an unrecoverable error occurred. + + (2s) Optional user-supplied dense Jacobian approximation routine: FKDJAC + + As an option when using the DENSE linear solver, the user may supply a + routine that computes a dense approximation of the system Jacobian + J = df/dy. If supplied, it must have the following form: + + SUBROUTINE FKDJAC(N, UU, FU, DJAC, WK1, WK2, IER) + DIMENSION UU(*), FU(*), DJAC(N,*), WK1(*), WK2(*) + + This routine must compute the Jacobian and store it columnwise in DJAC. + FKDJAC should return IER = 0 if successful, or a nonzero IER otherwise. + + (3s) Optional user-supplied band Jacobian approximation routine: FKBJAC + + As an option when using the BAND linear solver, the user may supply a + routine that computes a band approximation of the system Jacobian + J = df/dy. If supplied, it must have the following form: + + SUBROUTINE FKBJAC(N, MU, ML, MDIM, UU, FU, BJAC, WK1, WK2, IER) + DIMENSION UU(*), FU(*), BJAC(MDIM,*), WK1(*), WK2(*) + + This routine must load the MDIM by N array BJAC with the Jacobian matrix. + FKBJAC should return IER = 0 if successful, or a nonzero IER otherwise. + + (4) Optional user-supplied Jacobian-vector product routine: FKJTIMES + + As an option, the user may supply a routine that computes the product + of the system Jacobian and a given vector. This has the following form: + + SUBROUTINE FKJTIMES(V, Z, NEWU, UU, IER) + DIMENSION V(*), Z(*), UU(*) + + This must set the array Z to the product J*V, where J is the Jacobian + matrix J = dF/du, and V is a given array. Here UU is an array containing + the current value of the unknown vector u. NEWU is an input integer + indicating whether UU has changed since FKJTIMES was last called + (1 = yes, 0 = no). If FKJTIMES computes and saves Jacobian data, then + no such computation is necessary when NEWU = 0. Here V, Z, and UU are + arrays of length NEQ, the problem size, or the local length of all + distributed vectors in the parallel case. FKJTIMES should return IER = 0 + if successful, or a nonzero IER otherwise. + + (4.1s) User-supplied sparse Jacobian approximation routine: FKINSPJAC + + Required when using the KINKLU or KINSuperLUMT linear solvers, the + user must supply a routine that computes a compressed-sparse-column + [or compressed-sparse-row] approximation of the system Jacobian + J = dF(y)/dy. If supplied, it must have the following form: + + SUBROUTINE FKINSPJAC(Y, FY, N, NNZ, JDATA, JRVALS, + & JCPTRS, WK1, WK2, IER) + + Typically this routine will use only N, NNZ, JDATA, JRVALS and + JCPTRS. It must load the N by N compressed sparse column [or compressed + sparse row] matrix with storage for NNZ nonzeros, stored in the arrays + JDATA (nonzero values), JRVALS (row [or column] indices for each nonzero), + JCOLPTRS (indices for start of each column [or row]), with the Jacobian + matrix at the current (y) in CSC [or CSR] form (see sunmatrix_sparse.h for + more information). + + The arguments are: + Y -- array containing state variables [realtype, input] + FY -- array containing residual values [realtype, input] + N -- number of matrix rows/columns in Jacobian [int, input] + NNZ -- allocated length of nonzero storage [int, input] + JDATA -- nonzero values in Jacobian + [realtype of length NNZ, output] + JRVALS -- row [or column] indices for each nonzero in Jacobian + [int of length NNZ, output] + JCPTRS -- pointers to each Jacobian column [or row] in preceding arrays + [int of length N+1, output] + WK* -- array containing temporary workspace of same size as Y + [realtype, input] + IER -- return flag [int, output]: + 0 if successful, + >0 if a recoverable error occurred, + <0 if an unrecoverable error ocurred. + + (5) Initialization: FNVINITS/FNVINITP/FNVINITOMP/FNVINITPTS and + FKINCREATE and FKININIT + + (5.1s) To initialize the serial machine environment, the user must make + the following call: + + CALL FNVINITS (3, NEQ, IER) + + The arguments are: + NEQ = size of vectors + IER = return completion flag. Values are 0 = success, -1 = failure. + + (5.1p) To initialize the distributed memory parallel machine environment, + the user must make the following call: + + CALL FNVINITP (3, NLOCAL, NGLOBAL, IER) + + The arguments are: + NLOCAL = local size of vectors for this process + NGLOBAL = the system size, and the global size of vectors + (the sum of all values of NLOCAL) + IER = return completion flag. Values are 0 = success, + -1 = failure. + + (5.1omp) To initialize the openMP threaded vector kernel, + the user must make the following call: + + CALL FNVINITOMP (3, NEQ, NUM_THREADS, IER) + + The arguments are: + NEQ = size of vectors + NUM_THREADS = number of threads + IER = return completion flag. Values are 0 = success, -1 = failure. + + (5.1pts) To initialize the Pthreads threaded vector kernel, + the user must make the following call: + + CALL FNVINITOMP (3, NEQ, NUM_THREADS, IER) + + The arguments are: + NEQ = size of vectors + NUM_THREADS = number of threads + IER = return completion flag. Values are 0 = success, -1 = failure. + + (5.2) To create the internal memory structure, make the following call: + + CALL FKINCREATE(IER) + + The arguments are: + IER = return completion flag. Values are 0 = success, and + -1 = failure. + + Note: See printed message for details in case of failure. + + (5.3) To set various integer optional inputs, make the folowing call: + + CALL FKINSETIIN(KEY, VALUE, IER) + + to set the optional input specified by the character key KEY to the + integer value VALUE. + KEY is one of the following: 'PRNT_LEVEL', 'MAX_NITERS', 'ETA_FORM', 'MAA', + 'MAX_SETUPS', 'MAX_SP_SETUPS', 'NO_INIT_SETUP', 'NO_MIN_EPS', 'NO_RES_MON'. + + To set various real optional inputs, make the folowing call: + + CALL FKINSETRIN(KEY, VALUE, IER) + + to set the optional input specified by the character key KEY to the + real value VALUE. + KEY is one of the following: 'FNORM_TOL', 'SSTEP_TOL', 'MAX_STEP', + 'RERR_FUNC', 'ETA_CONST', 'ETA_PARAMS', 'RMON_CONST', 'RMON_PARAMS'. + Note that if KEY is 'ETA_PARAMS' or 'RMON_PARAMS', then VALUE must be an + array of dimension 2. + + To set the vector of constraints on the solution, make the following call: + + CALL FKINSETVIN(KEY, ARRAY, IER) + + where ARRAY is an array of reals and KEY is 'CONSTR_VEC'. + + FKINSETIIN, FKINSETRIN, and FKINSETVIN return IER=0 if successful and + IER<0 if an error occured. + + (5.4) To allocate and initialize the internal memory structure, + make the following call: + + CALL FKININIT(IOUT, ROUT, IER) + + The arguments are: + IOUT = array of length at least 16 for integer optional outputs + (declare as INTEGER*8) + ROUT = array of length at least 2 for real optional outputs + IER = return completion flag. Values are 0 = success, and + -1 = failure. + + Note: See printed message for details in case of failure. + + (6) Specification of linear system solution method: + + The solution method in KINSOL involves the solution of linear systems + related to the Jacobian J = dF/du of the nonlinear system. + + (6.1s) DENSE treatment of the linear systems (NVECTOR_SERIAL only): + + To initialize a dense matrix structure for storing the system Jacobian + and for use within a direct linear solver, the user must call: + + CALL FSUNDENSEMATINIT(3, M, N, IER) + + The integer 3 is the KINSOL solver ID and the other arguments are: + M = the number of rows of the matrix [long int, input] + N = the number of columns of the matrix [long int, input] + IER = return completion flag [int, output]: + 0 = success, + -1 = failure. + + To initialize a dense linear solver structure the user must call + the following to use the SUNDIALS or LAPACK dense solvers: + + CALL FSUNDENSELINSOLINIT(3, IER) + + OR + + CALL FSUNLAPACKDENSEINIT(3, IER) + + In the above routines, 3 is the KINSOL solver ID and IER is the return + return completion flag (0 = success and -1 = failure). + + To attach the dense linear solver structure the user must call + the following: + + CALL FKINLSINIT(IER) + + The arguments are: + IER = return completion flag [int, output]: + 0 = SUCCESS, + -1 = failure (see printed message for failure details). + + If the user program includes the FKDJAC routine for the evaluation + of the dense approximation to the system Jacobian, the following call + must be made: + + CALL FKINDENSESETJAC(FLAG, IER) + + with FLAG = 1 to specify that FKDJAC is provided. (FLAG = 0 specifies + using the internal finite difference approximation to the Jacobian.) + + (6.2s) BAND treatment of the linear systems (NVECTOR_SERIAL only): + + To initialize a banded matrix structure for stroing the system Jacobian + and for use within a banded linear solver, the user must call: + + CALL FSUNBANDMATINIT(3, N, MU, ML, SMU, IER) + + The integer 3 is the KINSOL solver ID and the other arguments are: + N = the number of columns of the matrix [long int, input] + MU = the number of upper bands (diagonal not included) in a banded + matrix [long int, input] + ML = the number of lower bands (diagonal not included) in a banded + matrix [long int, input] + SMU = the number of upper bands to store (diagonal not included) + for factorization of a banded matrix [long int, input] + + To initialize a banded linear solver structure the user must call + the following to use the SUNDIALS or LAPACK banded solvers: + + CALL FSUNBANDLINSOLINIT(3, IER) + + OR + + CALL FSUNLAPACKBANDINIT(3, IER) + + In the above routines, 3 is the KINSOL solver ID and IER is the return + return completion flag (0 = success and -1 = failure). + + To attach the banded linear solver structure the user must call + the following: + + CALL FKINLSINIT(IER) + + The arguments are: + IER = return completion flag [int, output]: + 0 = SUCCESS, + -1 = failure (see printed message for failure details). + + If the user program includes the FKBJAC routine for the evaluation + of the band approximation to the system Jacobian, the following call + must be made: + + CALL FKINBANDSETJAC(FLAG, IER) + + with FLAG = 1 to specify that FKBJAC is provided. (FLAG = 0 specifies + using the internal finite difference approximation to the Jacobian.) + + (6.3s) SPARSE treatment of the linear system using the KLU or SuperLU_MT solver. + + To initialize a sparse matrix structure for stroing the system Jacobian + and for use within a sparse linear solver, the user must call: + + CALL FSUNSPARSEMATINIT(3, M, N, NNZ, SPARSETYPE, IER) + + The integer 3 is the KINSOL solver ID and the other arguments are: + M = the number of rows of the matrix [long int, input] + N = the number of columns of the matrix [long int, input] + NNZ = the storage size (upper bound on the number of nonzeros) for + a sparse matrix [long int, input] + SPARSETYPE = integer denoting use of CSC (0) vs CSR (1) storage + for a sparse matrix [int, input] + IER = return completion flag [int, output]: + 0 = success, + -1 = failure. + + To initialize a sparse linear solver structure the user must call + the following to use the KLU or SuperLU_MT sparse solvers: + + CALL FSUNKLUINIT(3, IER) + + OR + + CALL FSUNSUPERLUMTINIT(3, NUM_THREADS, IER) + + In the above routines, 3 is the KINSOL solver ID, NUM_THREADS is the number + of threads, and IER is the return completion flag (0 = success and + -1 = failure). + + To attach the sparse linear solver structure the user must call + the following: + + CALL FKINLSINIT(IER) + + The arguments are: + IER = return completion flag [int, output]: + 0 = SUCCESS, + -1 = failure (see printed message for failure details). + + When using a sparse solver the user must provide the FKINSPJAC routine for the + evalution of the sparse approximation to the Jacobian. To indicate that this + routine has been provided, after the call to FKINKLU, the following call must + be made + + CALL FKINSPARSESETJAC(IER) + + The int return flag IER=0 if successful, and nonzero otherwise. + + The KLU solver will reuse much of the factorization information from one + nonlinear iteration to the next. If at any time the user wants to force a full + refactorization or if the number of nonzeros in the Jacobian matrix changes, the + user should make the call: + + CALL FKINKLUREINIT(NEQ, NNZ, REINIT_TYPE) + + The arguments are: + NEQ = the problem size [int; input] + NNZ = the maximum number of nonzeros [int; input] + REINIT_TYPE = 1 or 2. For a value of 1, the matrix will be destroyed and + a new one will be allocated with NNZ nonzeros. For a value of 2, + only symbolic and numeric factorizations will be completed. + + At this time, there is no reinitialization capability for the SUNDIALS + interface to the SuperLUMT solver. + + Once these the solvers have been initialized, their solver parameters may be + modified via calls to the functions: + + CALL FSUNKLUSETORDERING(3, ORD_CHOICE, IER) + CALL FSUNSUPERLUMTSETORDERING(3, ORD_CHOICE, IER) + + In the above routines, 3 is the KINSOL solver ID and ORD_CHOICE is an integer + denoting ordering choice (see SUNKLUSetOrdering and SUNSuperLUMTSetOrdering + documentation for details), and IER is the return completion flag (0 = success + and -1 = failure). + + (6.4) Scaled Preconditioned Iterative linear Solvers (SPILS): + + To initialize a SPILS treatment of the linear system, the user must call one + of the following: + + CALL FSUNPCGINIT(3, PRETYPE, MAXL, IER) + CALL FSUNSPBCGSINIT(3, PRETYPE, MAXL, IER) + CALL FSUNSPFGMRINIT(3, PRETYPE, MAXL, IER) + CALL FSUNSPGMRINIT(3, PRETYPE, MAXL, IER) + CALL FSUNSPTFQMRINIT(3, PRETYPE, MAXL, IER) + + The integer 3 is the KINSOL solver ID and the other arguments are: + PRETYPE = type of preconditioning to perform (0=none, 1=left, + 2=right, 3=both) [int, input] + MAXL = maximum Krylov subspace dimension [int, input] + IER = return completion flag [int, output]: + 0 = success, + -1 = failure. + + To attach the iterative linear solver structure the user must call + the following: + + CALL FKINLSINIT(IER) + + The arguments are: + IER = return completion flag [int, output]: + 0 = SUCCESS, + -1 = failure (see printed message for failure details). + + Once these the solvers have been initialized, their solver parameters may be + modified via calls to the functions: + + CALL FSUNPCGSETPRECTYPE(3, PRETYPE, IER) + CALL FSUNPCGSETMAXL(3, MAXL, IER) + + CALL FSUNSPBCGSSETPRECTYPE(3, PRETYPE, IER) + CALL FSUNSPBCGSSETMAXL(3, MAXL, IER) + + CALL FSUNSPFGMRSETGSTYPE(3, GSTYPE, IER) + CALL FSUNSPFGMRSETPRECTYPE(3, PRETYPE, IER) + + CALL FSUNSPGMRSETGSTYPE(3, GSTYPE, IER) + CALL FSUNSPGMRSETPRECTYPE(3, PRETYPE, IER) + + CALL FSUNSPTFQMRSETPRECTYPE(3, PRETYPE, IER) + CALL FSUNSPTFQMRSETMAXL(3, MAXL, IER) + + The integer 3 is the KINSOL solver ID and the other arguments are: + PRETYPE = type of preconditioning to perform (0=none, 1=left, + 2=right, 3=both) [int, input] + GSTYPE = choice of Gram-Schmidt orthogonalization algorithm + (0=modified, 1=classical) [int, input] + IER = return completion flag [int, output]: + 0 = success, + -1 = failure. + + (6.5) Specifying user-provided functions for the iterative linear solvers (SPILS) + + If the user program includes the FKJTIMES routine for the evaluation + of the Jacobian-vector product, the following call must be made: + + CALL FKINLSSETJAC(FLAG, IER) + + The argument FLAG = 0 specifies using the internal finite differences + approximation to the Jacobian-vector product, while FLAG = 1 specifies + that FKJTIMES is provided. + + Usage of the user-supplied routines FKPSET and FKPSOL for the setup and + solution of the preconditioned linear system is specified by calling: + + CALL FKINLSSETPREC(FLAG, IER) + + where FLAG = 0 indicates no FKPSET or FKPSOL (default) and FLAG = 1 + specifies using FKPSET and FKPSOL. The user-supplied routines FKPSET + and FKPSOL must be of the form: + + SUBROUTINE FKPSET (UU, USCALE, FVAL, FSCALE, IER) + DIMENSION UU(*), USCALE(*), FVAL(*), FSCALE(*) + + It must perform any evaluation of Jacobian-related data and + preprocessing needed for the solution of the preconditioned linear + systems by FKPSOL. The variables UU through FSCALE are for use in the + preconditioning setup process. Typically, the system function FKFUN is + called, so that FVAL will have been updated. UU is the current solution + iterate. If scaling is being used, USCALE and FSCALE are available for + those operatins requiring scaling. + + On return, set IER = 0 if FKPSET was successful, set IER = 1 if + an error occurred. + + SUBROUTINE FKPSOL (UU, USCALE, FVAL, FSCALE, VTEM, IER) + DIMENSION UU(*), USCALE(*), FVAL(*), FSCALE(*), VTEM(*) + + Typically this routine will use only UU, FVAL, and VTEM. + It must solve the preconditioned linear system Pz = r, where + r = VTEM is input, and store the solution z in VTEM as well. Here + P is the right preconditioner. If scaling is being used, the + routine supplied must also account for scaling on either coordinate + or function value. + + (7) The solver: FKINSOL + + Solving the nonlinear system is accomplished by making the following + call: + + CALL FKINSOL (UU, GLOBALSTRAT, USCALE, FSCALE, IER) + + The arguments are: + UU = array containing the initial guess on input, and the + solution on return + GLOBALSTRAT = (INTEGER) a number defining the global strategy choice: + 0 = No globalization, 1 = LineSearch, 2 = Picard, + 3 = Fixed Point + USCALE = array of scaling factors for the UU vector + FSCALE = array of scaling factors for the FVAL (function) vector + IER = INTEGER error flag as returned by KINSOL: + 0 means success, + 1 means initial guess satisfies f(u) = 0 (approx.), + 2 means apparent stalling (small step), + a value < 0 means other error or failure. + + Note: See KINSOL documentation for detailed information. + + (8) Memory freeing: FKINFREE + + To the free the internal memory created by the calls to FKINCREATE and + FKININIT and any FNVINIT**, make the following call: + + CALL FKINFREE + + (9) Optional outputs: IOUT/ROUT + + The optional outputs available by way of IOUT and ROUT have the + following names, locations, and descriptions. For further details see + the KINSOL documentation. + + LENRW = IOUT(1) = real workspace size + LENRW = IOUT(2) = real workspace size + NNI = IOUT(3) = number of Newton iterations + NFE = IOUT(4) = number of f evaluations + NBCF = IOUT(5) = number of line search beta condition failures + NBKTRK = IOUT(6) = number of line search backtracks + + FNORM = ROUT(1) = final scaled norm of f(u) + STEPL = ROUT(2) = scaled last step length + + The following optional outputs arise from the KINLS module: + + LRW = IOUT( 7) = real workspace size for the linear solver module + LIW = IOUT( 8) = integer workspace size for the linear solver module + LSTF = IOUT( 9) = last flag returned by linear solver + NFE = IOUT(10) = number of f evaluations for DQ Jacobian or + Jacobian*vector approximation + NJE = IOUT(11) = number of Jacobian evaluations + NJT = IOUT(12) = number of Jacobian-vector product evaluations + NPE = IOUT(13) = number of preconditioner evaluations + NPS = IOUT(14) = number of preconditioner solves + NLI = IOUT(15) = number of linear (Krylov) iterations + NCFL = IOUT(16) = number of linear convergence failures + +*******************************************************************************/ + +#ifndef _FKINSOL_H +#define _FKINSOL_H + +/*------------------------------------------------------------------ + header files + ------------------------------------------------------------------*/ + +#include +#include /* definition of SUNLinearSolver */ +#include /* definition of SUNMatrix */ +#include /* definition of type N_Vector */ +#include /* definition of type realtype */ + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/*------------------------------------------------------------------ + generic names are translated through the define statements below + ------------------------------------------------------------------*/ + +#if defined(SUNDIALS_F77_FUNC) + +#define FKIN_MALLOC SUNDIALS_F77_FUNC(fkinmalloc, FKINMALLOC) +#define FKIN_CREATE SUNDIALS_F77_FUNC(fkincreate, FKINCREATE) +#define FKIN_INIT SUNDIALS_F77_FUNC(fkininit, FKININIT) +#define FKIN_SETIIN SUNDIALS_F77_FUNC(fkinsetiin, FKINSETIIN) +#define FKIN_SETRIN SUNDIALS_F77_FUNC(fkinsetrin, FKINSETRIN) +#define FKIN_SETVIN SUNDIALS_F77_FUNC(fkinsetvin, FKINSETVIN) +#define FKIN_SOL SUNDIALS_F77_FUNC(fkinsol, FKINSOL) +#define FKIN_FREE SUNDIALS_F77_FUNC(fkinfree, FKINFREE) +#define FKIN_LSINIT SUNDIALS_F77_FUNC(fkinlsinit, FKINLSINIT) +#define FKIN_LSSETJAC SUNDIALS_F77_FUNC(fkinlssetjac, FKINLSSETJAC) +#define FKIN_LSSETPREC SUNDIALS_F77_FUNC(fkinlssetprec, FKINLSSETPREC) +#define FK_PSET SUNDIALS_F77_FUNC(fkpset, FKPSET) +#define FK_PSOL SUNDIALS_F77_FUNC(fkpsol, FKPSOL) +#define FKIN_DENSESETJAC SUNDIALS_F77_FUNC(fkindensesetjac, FKINDENSESETJAC) +#define FK_DJAC SUNDIALS_F77_FUNC(fkdjac, FKDJAC) +#define FKIN_BANDSETJAC SUNDIALS_F77_FUNC(fkinbandsetjac, FKINBANDSETJAC) +#define FK_BJAC SUNDIALS_F77_FUNC(fkbjac, FKBJAC) +#define FKIN_SPARSESETJAC SUNDIALS_F77_FUNC(fkinsparsesetjac, FKINSPARSESETJAC) +#define FKIN_SPJAC SUNDIALS_F77_FUNC(fkinspjac, FKINSPJAC) +#define FK_JTIMES SUNDIALS_F77_FUNC(fkjtimes, FKJTIMES) +#define FK_FUN SUNDIALS_F77_FUNC(fkfun, FKFUN) + +/*---DEPRECATED---*/ +#define FKIN_DLSINIT SUNDIALS_F77_FUNC(fkindlsinit, FKINDLSINIT) +#define FKIN_SPILSINIT SUNDIALS_F77_FUNC(fkinspilsinit, FKINSPILSINIT) +#define FKIN_SPILSSETJAC SUNDIALS_F77_FUNC(fkinspilssetjac, FKINSPILSSETJAC) +#define FKIN_SPILSSETPREC SUNDIALS_F77_FUNC(fkinspilssetprec, FKINSPILSSETPREC) +/*----------------*/ + +#else + +#define FKIN_MALLOC fkinmalloc_ +#define FKIN_CREATE fkincreate_ +#define FKIN_INIT fkininit_ +#define FKIN_SETIIN fkinsetiin_ +#define FKIN_SETRIN fkinsetrin_ +#define FKIN_SETVIN fkinsetvin_ +#define FKIN_SOL fkinsol_ +#define FKIN_FREE fkinfree_ +#define FKIN_LSINIT fkinlsinit_ +#define FKIN_LSSETJAC fkinlssetjac_ +#define FK_JTIMES fkjtimes_ +#define FKIN_LSSETPREC fkinlssetprec_ +#define FKIN_DENSESETJAC fkindensesetjac_ +#define FK_DJAC fkdjac_ +#define FKIN_BANDSETJAC fkinbandsetjac_ +#define FK_BJAC fkbjac_ +#define FKIN_SPARSESETJAC fkinsparsesetjac_ +#define FKIN_SPJAC fkinspjac_ +#define FK_PSET fkpset_ +#define FK_PSOL fkpsol_ +#define FK_FUN fkfun_ + +/*---DEPRECATED---*/ +#define FKIN_DLSINIT fkindlsinit_ +#define FKIN_SPILSINIT fkinspilsinit_ +#define FKIN_SPILSSETJAC fkinspilssetjac_ +#define FKIN_SPILSSETPREC fkinspilssetprec_ +/*----------------*/ + +#endif + +/*------------------------------------------------------------------ + Prototypes : exported functions + ------------------------------------------------------------------*/ + +void FKIN_MALLOC(long int *iout, realtype *rout, int *ier); +void FKIN_CREATE(int *ier); +void FKIN_INIT(long int *iout, realtype *rout, int *ier); + +void FKIN_SETIIN(char key_name[], long int *ival, int *ier); +void FKIN_SETRIN(char key_name[], realtype *rval, int *ier); +void FKIN_SETVIN(char key_name[], realtype *vval, int *ier); + +void FKIN_LSINIT(int *ier); +void FKIN_LSSETJAC(int *flag, int *ier); +void FKIN_LSSETPREC(int *flag, int *ier); +void FKIN_DENSESETJAC(int *flag, int *ier); +void FKIN_BANDSETJAC(int *flag, int *ier); +void FKIN_SPARSESETJAC(int *ier); + +/*---DEPRECATED---*/ +void FKIN_DLSINIT(int *ier); +void FKIN_SPILSINIT(int *ier); +void FKIN_SPILSSETJAC(int *flag, int *ier); +void FKIN_SPILSSETPREC(int *flag, int *ier); +/*----------------*/ + +void FKIN_SOL(realtype *uu, int *globalstrategy, + realtype *uscale , realtype *fscale, int *ier); + +void FKIN_FREE(void); + +/*------------------------------------------------------------------ + Prototypes : functions called by the solver + ------------------------------------------------------------------*/ + +int FKINfunc(N_Vector uu, N_Vector fval, void *user_data); + +int FKINDenseJac(N_Vector uu, N_Vector fval, SUNMatrix J, + void *user_data, N_Vector vtemp1, N_Vector vtemp2); + +int FKINBandJac(N_Vector uu, N_Vector fval, SUNMatrix J, + void *user_data, N_Vector vtemp1, N_Vector vtemp2); + +int FKINSparseJac(N_Vector uu, N_Vector fval, SUNMatrix J, + void *user_data, N_Vector vtemp1, N_Vector vtemp2); + +int FKINJtimes(N_Vector v, N_Vector Jv, N_Vector uu, + booleantype *new_uu, void *user_data); + +int FKINPSet(N_Vector uu, N_Vector uscale, + N_Vector fval, N_Vector fscale, + void *user_data); + +int FKINPSol(N_Vector uu, N_Vector uscale, + N_Vector fval, N_Vector fscale, + N_Vector vv, void *user_data); + +void FKINNullMatrix(); +void FKINNullLinsol(); + +/*------------------------------------------------------------------ + declarations for global variables shared amongst various routines + ------------------------------------------------------------------*/ + +extern N_Vector F2C_KINSOL_vec; /* defined in FNVECTOR module */ +extern SUNMatrix F2C_KINSOL_matrix; /* defined in FSUNMATRIX module */ +extern SUNLinearSolver F2C_KINSOL_linsol; /* defined in FSUNLINSOL module */ +extern void *KIN_kinmem; /* defined in fkinsol.c */ +extern long int *KIN_iout; /* defined in fkinsol.c */ +extern realtype *KIN_rout; /* defined in fkinsol.c */ + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/kinsol/fmod/fkinsol_mod.c b/bazaar/plugin/sundials/src/kinsol/fmod/fkinsol_mod.c new file mode 100644 index 000000000..79ee37d8b --- /dev/null +++ b/bazaar/plugin/sundials/src/kinsol/fmod/fkinsol_mod.c @@ -0,0 +1,1036 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ + +/* --------------------------------------------------------------- + * Programmer(s): Auto-generated by swig. + * --------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * -------------------------------------------------------------*/ + +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "kinsol/kinsol.h" +#include "kinsol/kinsol_bbdpre.h" +#include "kinsol/kinsol_ls.h" + + +#include +#ifdef _MSC_VER +# ifndef strtoull +# define strtoull _strtoui64 +# endif +# ifndef strtoll +# define strtoll _strtoi64 +# endif +#endif + + +typedef struct { + void* data; + size_t size; +} SwigArrayWrapper; + + +SWIGINTERN SwigArrayWrapper SwigArrayWrapper_uninitialized() { + SwigArrayWrapper result; + result.data = NULL; + result.size = 0; + return result; +} + + +#include + +SWIGEXPORT void * _wrap_FKINCreate() { + void * fresult ; + void *result = 0 ; + + result = (void *)KINCreate(); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FKINInit(void *farg1, KINSysFn farg2, N_Vector farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + KINSysFn arg2 = (KINSysFn) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (KINSysFn)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)KINInit(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSol(void *farg1, N_Vector farg2, int const *farg3, N_Vector farg4, N_Vector farg5) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + int arg3 ; + N_Vector arg4 = (N_Vector) 0 ; + N_Vector arg5 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (int)(*farg3); + arg4 = (N_Vector)(farg4); + arg5 = (N_Vector)(farg5); + result = (int)KINSol(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetErrHandlerFn(void *farg1, KINErrHandlerFn farg2, void *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + KINErrHandlerFn arg2 = (KINErrHandlerFn) 0 ; + void *arg3 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (KINErrHandlerFn)(farg2); + arg3 = (void *)(farg3); + result = (int)KINSetErrHandlerFn(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetErrFile(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + result = (int)KINSetErrFile(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetInfoHandlerFn(void *farg1, KINInfoHandlerFn farg2, void *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + KINInfoHandlerFn arg2 = (KINInfoHandlerFn) 0 ; + void *arg3 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (KINInfoHandlerFn)(farg2); + arg3 = (void *)(farg3); + result = (int)KINSetInfoHandlerFn(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetInfoFile(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + result = (int)KINSetInfoFile(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetUserData(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + void *arg2 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (void *)(farg2); + result = (int)KINSetUserData(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetPrintLevel(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)KINSetPrintLevel(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetMAA(void *farg1, long const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long)(*farg2); + result = (int)KINSetMAA(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetDampingAA(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)KINSetDampingAA(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetNumMaxIters(void *farg1, long const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long)(*farg2); + result = (int)KINSetNumMaxIters(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetNoInitSetup(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)KINSetNoInitSetup(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetNoResMon(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)KINSetNoResMon(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetMaxSetupCalls(void *farg1, long const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long)(*farg2); + result = (int)KINSetMaxSetupCalls(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetMaxSubSetupCalls(void *farg1, long const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long)(*farg2); + result = (int)KINSetMaxSubSetupCalls(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetEtaForm(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)KINSetEtaForm(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetEtaConstValue(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)KINSetEtaConstValue(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetEtaParams(void *farg1, double const *farg2, double const *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + realtype arg3 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (realtype)(*farg3); + result = (int)KINSetEtaParams(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetResMonParams(void *farg1, double const *farg2, double const *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + realtype arg3 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (realtype)(*farg3); + result = (int)KINSetResMonParams(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetResMonConstValue(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)KINSetResMonConstValue(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetNoMinEps(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)KINSetNoMinEps(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetMaxNewtonStep(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)KINSetMaxNewtonStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetMaxBetaFails(void *farg1, long const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long)(*farg2); + result = (int)KINSetMaxBetaFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetRelErrFunc(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)KINSetRelErrFunc(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetFuncNormTol(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)KINSetFuncNormTol(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetScaledStepTol(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)KINSetScaledStepTol(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetConstraints(void *farg1, N_Vector farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + result = (int)KINSetConstraints(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetSysFunc(void *farg1, KINSysFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + KINSysFn arg2 = (KINSysFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (KINSysFn)(farg2); + result = (int)KINSetSysFunc(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINGetWorkSpace(void *farg1, long *farg2, long *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)KINGetWorkSpace(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINGetNumNonlinSolvIters(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)KINGetNumNonlinSolvIters(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINGetNumFuncEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)KINGetNumFuncEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINGetNumBetaCondFails(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)KINGetNumBetaCondFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINGetNumBacktrackOps(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)KINGetNumBacktrackOps(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINGetFuncNorm(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)KINGetFuncNorm(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINGetStepLength(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)KINGetStepLength(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SwigArrayWrapper _wrap_FKINGetReturnFlagName(long const *farg1) { + SwigArrayWrapper fresult ; + long arg1 ; + char *result = 0 ; + + arg1 = (long)(*farg1); + result = (char *)KINGetReturnFlagName(arg1); + fresult.size = strlen((const char*)(result)); + fresult.data = (char *)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_FKINFree(void *farg1) { + void **arg1 = (void **) 0 ; + + arg1 = (void **)(farg1); + KINFree(arg1); +} + + +SWIGEXPORT int _wrap_FKINBBDPrecInit(void *farg1, int64_t const *farg2, int64_t const *farg3, int64_t const *farg4, int64_t const *farg5, int64_t const *farg6, double const *farg7, KINBBDLocalFn farg8, KINBBDCommFn farg9) { + int fresult ; + void *arg1 = (void *) 0 ; + sunindextype arg2 ; + sunindextype arg3 ; + sunindextype arg4 ; + sunindextype arg5 ; + sunindextype arg6 ; + realtype arg7 ; + KINBBDLocalFn arg8 = (KINBBDLocalFn) 0 ; + KINBBDCommFn arg9 = (KINBBDCommFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (sunindextype)(*farg2); + arg3 = (sunindextype)(*farg3); + arg4 = (sunindextype)(*farg4); + arg5 = (sunindextype)(*farg5); + arg6 = (sunindextype)(*farg6); + arg7 = (realtype)(*farg7); + arg8 = (KINBBDLocalFn)(farg8); + arg9 = (KINBBDCommFn)(farg9); + result = (int)KINBBDPrecInit(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINBBDPrecGetWorkSpace(void *farg1, long *farg2, long *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)KINBBDPrecGetWorkSpace(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINBBDPrecGetNumGfnEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)KINBBDPrecGetNumGfnEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetLinearSolver(void *farg1, SUNLinearSolver farg2, SUNMatrix farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + SUNLinearSolver arg2 = (SUNLinearSolver) 0 ; + SUNMatrix arg3 = (SUNMatrix) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (SUNLinearSolver)(farg2); + arg3 = (SUNMatrix)(farg3); + result = (int)KINSetLinearSolver(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetJacFn(void *farg1, KINLsJacFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + KINLsJacFn arg2 = (KINLsJacFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (KINLsJacFn)(farg2); + result = (int)KINSetJacFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetPreconditioner(void *farg1, KINLsPrecSetupFn farg2, KINLsPrecSolveFn farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + KINLsPrecSetupFn arg2 = (KINLsPrecSetupFn) 0 ; + KINLsPrecSolveFn arg3 = (KINLsPrecSolveFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (KINLsPrecSetupFn)(farg2); + arg3 = (KINLsPrecSolveFn)(farg3); + result = (int)KINSetPreconditioner(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINSetJacTimesVecFn(void *farg1, KINLsJacTimesVecFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + KINLsJacTimesVecFn arg2 = (KINLsJacTimesVecFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (KINLsJacTimesVecFn)(farg2); + result = (int)KINSetJacTimesVecFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINGetLinWorkSpace(void *farg1, long *farg2, long *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)KINGetLinWorkSpace(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINGetNumJacEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)KINGetNumJacEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINGetNumLinFuncEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)KINGetNumLinFuncEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINGetNumPrecEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)KINGetNumPrecEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINGetNumPrecSolves(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)KINGetNumPrecSolves(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINGetNumLinIters(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)KINGetNumLinIters(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINGetNumLinConvFails(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)KINGetNumLinConvFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINGetNumJtimesEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)KINGetNumJtimesEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FKINGetLastLinFlag(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)KINGetLastLinFlag(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SwigArrayWrapper _wrap_FKINGetLinReturnFlagName(long const *farg1) { + SwigArrayWrapper fresult ; + long arg1 ; + char *result = 0 ; + + arg1 = (long)(*farg1); + result = (char *)KINGetLinReturnFlagName(arg1); + fresult.size = strlen((const char*)(result)); + fresult.data = (char *)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/kinsol/kinsol.c b/bazaar/plugin/sundials/src/kinsol/kinsol.c new file mode 100644 index 000000000..6d098a19c --- /dev/null +++ b/bazaar/plugin/sundials/src/kinsol/kinsol.c @@ -0,0 +1,2702 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, Carol Woodward, + * John Loffeld, and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for the main KINSol solver. + * It is independent of the KINSol linear solver in use. + * ----------------------------------------------------------------- + * + * EXPORTED FUNCTIONS + * ------------------ + * Creation and allocation functions + * KINCreate + * KINInit + * Main solver function + * KINSol + * Deallocation function + * KINFree + * + * PRIVATE FUNCTIONS + * ----------------- + * KINCheckNvector + * Memory allocation/deallocation + * KINAllocVectors + * KINFreeVectors + * Initial setup + * KINSolInit + * Step functions + * KINLinSolDrv + * KINFullNewton + * KINLineSearch + * KINConstraint + * KINFP + * KINPicardAA + * Stopping tests + * KINStop + * KINForcingTerm + * Norm functions + * KINScFNorm + * KINScSNorm + * KINSOL Verbose output functions + * KINPrintInfo + * KINInfoHandler + * KINSOL Error Handling functions + * KINProcessError + * KINErrHandler + * ----------------------------------------------------------------- + */ + +/* + * ================================================================= + * IMPORTED HEADER FILES + * ================================================================= + */ + +#include +#include +#include +#include + +#include + +#include "kinsol_impl.h" +#include + +/* + * ================================================================= + * KINSOL PRIVATE CONSTANTS + * ================================================================= + */ + +#define HALF RCONST(0.5) +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define ONEPT5 RCONST(1.5) +#define TWO RCONST(2.0) +#define THREE RCONST(3.0) +#define FIVE RCONST(5.0) +#define TWELVE RCONST(12.0) +#define POINT1 RCONST(0.1) +#define POINT01 RCONST(0.01) +#define POINT99 RCONST(0.99) +#define THOUSAND RCONST(1000.0) +#define ONETHIRD RCONST(0.3333333333333333) +#define TWOTHIRDS RCONST(0.6666666666666667) +#define POINT9 RCONST(0.9) +#define POINT0001 RCONST(0.0001) + +/* + * ================================================================= + * KINSOL ROUTINE-SPECIFIC CONSTANTS + * ================================================================= + */ + +/* + * Control constants for lower-level functions used by KINSol + * ---------------------------------------------------------- + * + * KINStop return value requesting more iterations + * RETRY_ITERATION + * CONTINUE_ITERATIONS + * + * KINFullNewton, KINLineSearch, KINFP, and KINPicardAA return values: + * KIN_SUCCESS + * KIN_SYSFUNC_FAIL + * STEP_TOO_SMALL + * + * KINConstraint return values: + * KIN_SUCCESS + * CONSTR_VIOLATED + */ + +#define RETRY_ITERATION -998 +#define CONTINUE_ITERATIONS -999 +#define STEP_TOO_SMALL -997 +#define CONSTR_VIOLATED -996 + +/* + * Algorithmic constants + * --------------------- + * + * MAX_RECVR max. no. of attempts to correct a recoverable func error + */ + +#define MAX_RECVR 5 + +/* + * Keys for KINPrintInfo + * --------------------- + */ + +#define PRNT_RETVAL 1 +#define PRNT_NNI 2 +#define PRNT_TOL 3 +#define PRNT_FMAX 4 +#define PRNT_PNORM 5 +#define PRNT_PNORM1 6 +#define PRNT_FNORM 7 +#define PRNT_LAM 8 +#define PRNT_ALPHA 9 +#define PRNT_BETA 10 +#define PRNT_ALPHABETA 11 +#define PRNT_ADJ 12 + +/* + * ================================================================= + * PRIVATE FUNCTION PROTOTYPES + * ================================================================= + */ + +static booleantype KINCheckNvector(N_Vector tmpl); +static booleantype KINAllocVectors(KINMem kin_mem, N_Vector tmpl); +static int KINSolInit(KINMem kin_mem); +static int KINConstraint(KINMem kin_mem ); +static void KINForcingTerm(KINMem kin_mem, realtype fnormp); +static void KINFreeVectors(KINMem kin_mem); + +static int KINFullNewton(KINMem kin_mem, realtype *fnormp, + realtype *f1normp, booleantype *maxStepTaken); +static int KINLineSearch(KINMem kin_mem, realtype *fnormp, + realtype *f1normp, booleantype *maxStepTaken); +static int KINPicardAA(KINMem kin_mem, long int *iter, realtype *R, + realtype *gamma, realtype *fmax); +static int KINFP(KINMem kin_mem); + +static int KINLinSolDrv(KINMem kinmem); +static int KINPicardFcnEval(KINMem kin_mem, N_Vector gval, N_Vector uval, + N_Vector fval1); +static realtype KINScFNorm(KINMem kin_mem, N_Vector v, N_Vector scale); +static realtype KINScSNorm(KINMem kin_mem, N_Vector v, N_Vector u); +static int KINStop(KINMem kin_mem, booleantype maxStepTaken, + int sflag); +static int AndersonAcc(KINMem kin_mem, N_Vector gval, N_Vector fv, N_Vector x, + N_Vector x_old, long int iter, realtype *R, realtype *gamma); + +/* + * ================================================================= + * EXPORTED FUNCTIONS IMPLEMENTATION + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Creation and allocation functions + * ----------------------------------------------------------------- + */ + +/* + * Function : KINCreate + * + * KINCreate creates an internal memory block for a problem to + * be solved by KINSOL. If successful, KINCreate returns a pointer + * to the problem memory. This pointer should be passed to + * KINInit. If an initialization error occurs, KINCreate prints + * an error message to standard error and returns NULL. + */ + +void *KINCreate(void) +{ + KINMem kin_mem; + realtype uround; + + kin_mem = NULL; + kin_mem = (KINMem) malloc(sizeof(struct KINMemRec)); + if (kin_mem == NULL) { + KINProcessError(kin_mem, 0, "KINSOL", "KINCreate", MSG_MEM_FAIL); + return(NULL); + } + + /* Zero out kin_mem */ + memset(kin_mem, 0, sizeof(struct KINMemRec)); + + /* set uround (unit roundoff) */ + + kin_mem->kin_uround = uround = UNIT_ROUNDOFF; + + /* set default values for solver optional inputs */ + + kin_mem->kin_func = NULL; + kin_mem->kin_user_data = NULL; + kin_mem->kin_uu = NULL; + kin_mem->kin_unew = NULL; + kin_mem->kin_fval = NULL; + kin_mem->kin_gval = NULL; + kin_mem->kin_uscale = NULL; + kin_mem->kin_fscale = NULL; + kin_mem->kin_pp = NULL; + kin_mem->kin_constraints = NULL; + kin_mem->kin_vtemp1 = NULL; + kin_mem->kin_vtemp2 = NULL; + kin_mem->kin_fold_aa = NULL; + kin_mem->kin_gold_aa = NULL; + kin_mem->kin_df_aa = NULL; + kin_mem->kin_dg_aa = NULL; + kin_mem->kin_q_aa = NULL; + kin_mem->kin_gamma_aa = NULL; + kin_mem->kin_R_aa = NULL; + kin_mem->kin_ipt_map = NULL; + kin_mem->kin_cv = NULL; + kin_mem->kin_Xv = NULL; + kin_mem->kin_lmem = NULL; + kin_mem->kin_m_aa = 0; + kin_mem->kin_aamem_aa = 0; + kin_mem->kin_setstop_aa = 0; + kin_mem->kin_beta_aa = ONE; + kin_mem->kin_damping_aa = SUNFALSE; + kin_mem->kin_constraintsSet = SUNFALSE; + kin_mem->kin_ehfun = KINErrHandler; + kin_mem->kin_eh_data = kin_mem; + kin_mem->kin_errfp = stderr; + kin_mem->kin_ihfun = KINInfoHandler; + kin_mem->kin_ih_data = kin_mem; + kin_mem->kin_infofp = stdout; + kin_mem->kin_printfl = PRINTFL_DEFAULT; + kin_mem->kin_mxiter = MXITER_DEFAULT; + kin_mem->kin_noInitSetup = SUNFALSE; + kin_mem->kin_msbset = MSBSET_DEFAULT; + kin_mem->kin_noResMon = SUNFALSE; + kin_mem->kin_msbset_sub = MSBSET_SUB_DEFAULT; + kin_mem->kin_update_fnorm_sub = SUNFALSE; + kin_mem->kin_mxnbcf = MXNBCF_DEFAULT; + kin_mem->kin_sthrsh = TWO; + kin_mem->kin_noMinEps = SUNFALSE; + kin_mem->kin_mxnstepin = ZERO; + kin_mem->kin_sqrt_relfunc = SUNRsqrt(uround); + kin_mem->kin_scsteptol = SUNRpowerR(uround,TWOTHIRDS); + kin_mem->kin_fnormtol = SUNRpowerR(uround,ONETHIRD); + kin_mem->kin_etaflag = KIN_ETACHOICE1; + kin_mem->kin_eta = POINT1; /* default for KIN_ETACONSTANT */ + kin_mem->kin_eta_alpha = TWO; /* default for KIN_ETACHOICE2 */ + kin_mem->kin_eta_gamma = POINT9; /* default for KIN_ETACHOICE2 */ + kin_mem->kin_MallocDone = SUNFALSE; + kin_mem->kin_eval_omega = SUNTRUE; + kin_mem->kin_omega = ZERO; /* default to using min/max */ + kin_mem->kin_omega_min = OMEGA_MIN; + kin_mem->kin_omega_max = OMEGA_MAX; + + /* initialize lrw and liw */ + + kin_mem->kin_lrw = 17; + kin_mem->kin_liw = 22; + + /* NOTE: needed since KINInit could be called after KINSetConstraints */ + + kin_mem->kin_lrw1 = 0; + kin_mem->kin_liw1 = 0; + + return((void *) kin_mem); +} + +/* + * Function : KINInit + * + * KINInit allocates memory for a problem or execution of KINSol. + * If memory is successfully allocated, KIN_SUCCESS is returned. + * Otherwise, an error message is printed and an error flag + * returned. + */ + +int KINInit(void *kinmem, KINSysFn func, N_Vector tmpl) +{ + sunindextype liw1, lrw1; + KINMem kin_mem; + booleantype allocOK, nvectorOK; + + /* check kinmem */ + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINInit", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + kin_mem = (KINMem) kinmem; + + if (func == NULL) { + KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINInit", MSG_FUNC_NULL); + return(KIN_ILL_INPUT); + } + + /* check if all required vector operations are implemented */ + + nvectorOK = KINCheckNvector(tmpl); + if (!nvectorOK) { + KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINInit", MSG_BAD_NVECTOR); + return(KIN_ILL_INPUT); + } + + /* set space requirements for one N_Vector */ + + if (tmpl->ops->nvspace != NULL) { + N_VSpace(tmpl, &lrw1, &liw1); + kin_mem->kin_lrw1 = lrw1; + kin_mem->kin_liw1 = liw1; + } + else { + kin_mem->kin_lrw1 = 0; + kin_mem->kin_liw1 = 0; + } + + /* allocate necessary vectors */ + + allocOK = KINAllocVectors(kin_mem, tmpl); + if (!allocOK) { + KINProcessError(kin_mem, KIN_MEM_FAIL, "KINSOL", "KINInit", MSG_MEM_FAIL); + free(kin_mem); kin_mem = NULL; + return(KIN_MEM_FAIL); + } + + /* copy the input parameter into KINSol state */ + + kin_mem->kin_func = func; + + /* set the linear solver addresses to NULL */ + + kin_mem->kin_linit = NULL; + kin_mem->kin_lsetup = NULL; + kin_mem->kin_lsolve = NULL; + kin_mem->kin_lfree = NULL; + kin_mem->kin_lmem = NULL; + + /* problem memory has been successfully allocated */ + + kin_mem->kin_MallocDone = SUNTRUE; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Main solver function + * ----------------------------------------------------------------- + */ + +/* + * Function : KINSol + * + * KINSol (main KINSOL driver routine) manages the computational + * process of computing an approximate solution of the nonlinear + * system F(uu) = 0. The KINSol routine calls the following + * subroutines: + * + * KINSolInit checks if initial guess satisfies user-supplied + * constraints and initializes linear solver + * + * KINLinSolDrv interfaces with linear solver to find a + * solution of the system J(uu)*x = b (calculate + * Newton step) + * + * KINFullNewton/KINLineSearch implement the global strategy + * + * KINForcingTerm computes the forcing term (eta) + * + * KINStop determines if an approximate solution has been found + */ + +int KINSol(void *kinmem, N_Vector u, int strategy_in, + N_Vector u_scale, N_Vector f_scale) +{ + realtype fnormp, f1normp, epsmin, fmax=ZERO; + KINMem kin_mem; + int ret, sflag; + booleantype maxStepTaken; + + /* intialize to avoid compiler warning messages */ + + maxStepTaken = SUNFALSE; + f1normp = fnormp = -ONE; + + /* initialize epsmin to avoid compiler warning message */ + + epsmin = ZERO; + + /* check for kinmem non-NULL */ + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSol", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + kin_mem = (KINMem) kinmem; + + if(kin_mem->kin_MallocDone == SUNFALSE) { + KINProcessError(NULL, KIN_NO_MALLOC, "KINSOL", "KINSol", MSG_NO_MALLOC); + return(KIN_NO_MALLOC); + } + + /* load input arguments */ + + kin_mem->kin_uu = u; + kin_mem->kin_uscale = u_scale; + kin_mem->kin_fscale = f_scale; + kin_mem->kin_globalstrategy = strategy_in; + + /* CSW: + Call fixed point solver if requested. Note that this should probably + be forked off to a FPSOL solver instead of kinsol in the future. */ + if ( kin_mem->kin_globalstrategy == KIN_FP ) { + if (kin_mem->kin_uu == NULL) { + KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSol", MSG_UU_NULL); + return(KIN_ILL_INPUT); + } + + if (kin_mem->kin_constraintsSet != SUNFALSE) { + KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSol", MSG_CONSTRAINTS_NOTOK); + return(KIN_ILL_INPUT); + } + + if (kin_mem->kin_printfl > 0) + KINPrintInfo(kin_mem, PRNT_TOL, "KINSOL", "KINSol", INFO_TOL, kin_mem->kin_scsteptol, kin_mem->kin_fnormtol); + + kin_mem->kin_nfe = kin_mem->kin_nnilset = kin_mem->kin_nnilset_sub = kin_mem->kin_nni = kin_mem->kin_nbcf = kin_mem->kin_nbktrk = 0; + ret = KINFP(kin_mem); + + switch(ret) { + case KIN_SYSFUNC_FAIL: + KINProcessError(kin_mem, KIN_SYSFUNC_FAIL, "KINSOL", "KINSol", MSG_SYSFUNC_FAILED); + break; + case KIN_MAXITER_REACHED: + KINProcessError(kin_mem, KIN_MAXITER_REACHED, "KINSOL", "KINSol", MSG_MAXITER_REACHED); + break; + } + + return(ret); + } + + /* initialize solver */ + ret = KINSolInit(kin_mem); + if (ret != KIN_SUCCESS) return(ret); + + kin_mem->kin_ncscmx = 0; + + /* Note: The following logic allows the choice of whether or not + to force a call to the linear solver setup upon a given call to + KINSol */ + + if (kin_mem->kin_noInitSetup) kin_mem->kin_sthrsh = ONE; + else kin_mem->kin_sthrsh = TWO; + + /* if eps is to be bounded from below, set the bound */ + + if (kin_mem->kin_inexact_ls && !(kin_mem->kin_noMinEps)) + epsmin = POINT01 * kin_mem->kin_fnormtol; + + + /* if omega is zero at this point, make sure it will be evaluated + at each iteration based on the provided min/max bounds and the + current function norm. */ + if (kin_mem->kin_omega == ZERO) kin_mem->kin_eval_omega = SUNTRUE; + else kin_mem->kin_eval_omega = SUNFALSE; + + + /* CSW: + Call fixed point solver for Picard method if requested. + Note that this should probably be forked off to a part of an + FPSOL solver instead of kinsol in the future. */ + if ( kin_mem->kin_globalstrategy == KIN_PICARD ) { + + if (kin_mem->kin_gval == NULL) { + kin_mem->kin_gval = N_VClone(kin_mem->kin_unew); + if (kin_mem->kin_gval == NULL) { + KINProcessError(kin_mem, KIN_MEM_FAIL, "KINSOL", "KINSol", MSG_MEM_FAIL); + return(KIN_MEM_FAIL); + } + kin_mem->kin_liw += kin_mem->kin_liw1; + kin_mem->kin_lrw += kin_mem->kin_lrw1; + } + ret = KINPicardAA(kin_mem, &(kin_mem->kin_nni), kin_mem->kin_R_aa, kin_mem->kin_gamma_aa, &fmax); + + return(ret); + } + + + for(;;){ + + kin_mem->kin_retry_nni = SUNFALSE; + + kin_mem->kin_nni++; + + /* calculate the epsilon (stopping criteria for iterative linear solver) + for this iteration based on eta from the routine KINForcingTerm */ + + if (kin_mem->kin_inexact_ls) { + kin_mem->kin_eps = (kin_mem->kin_eta + kin_mem->kin_uround) * kin_mem->kin_fnorm; + if(!(kin_mem->kin_noMinEps)) kin_mem->kin_eps = SUNMAX(epsmin, kin_mem->kin_eps); + } + + repeat_nni: + + /* call the appropriate routine to calculate an acceptable step pp */ + + sflag = 0; + + if (kin_mem->kin_globalstrategy == KIN_NONE) { + + /* Full Newton Step*/ + + /* call KINLinSolDrv to calculate the (approximate) Newton step, pp */ + ret = KINLinSolDrv(kin_mem); + if (ret != KIN_SUCCESS) break; + + sflag = KINFullNewton(kin_mem, &fnormp, &f1normp, &maxStepTaken); + + /* if sysfunc failed unrecoverably, stop */ + if ((sflag == KIN_SYSFUNC_FAIL) || (sflag == KIN_REPTD_SYSFUNC_ERR)) { + ret = sflag; + break; + } + + } else if (kin_mem->kin_globalstrategy == KIN_LINESEARCH) { + + /* Line Search */ + + /* call KINLinSolDrv to calculate the (approximate) Newton step, pp */ + ret = KINLinSolDrv(kin_mem); + if (ret != KIN_SUCCESS) break; + + sflag = KINLineSearch(kin_mem, &fnormp, &f1normp, &maxStepTaken); + + /* if sysfunc failed unrecoverably, stop */ + if ((sflag == KIN_SYSFUNC_FAIL) || (sflag == KIN_REPTD_SYSFUNC_ERR)) { + ret = sflag; + break; + } + + /* if too many beta condition failures, then stop iteration */ + if (kin_mem->kin_nbcf > kin_mem->kin_mxnbcf) { + ret = KIN_LINESEARCH_BCFAIL; + break; + } + + } + + if ( (kin_mem->kin_globalstrategy != KIN_PICARD) && + (kin_mem->kin_globalstrategy != KIN_FP) ) { + + /* evaluate eta by calling the forcing term routine */ + if (kin_mem->kin_callForcingTerm) KINForcingTerm(kin_mem, fnormp); + + kin_mem->kin_fnorm = fnormp; + + /* call KINStop to check if tolerances where met by this iteration */ + ret = KINStop(kin_mem, maxStepTaken, sflag); + + if (ret == RETRY_ITERATION) { + kin_mem->kin_retry_nni = SUNTRUE; + goto repeat_nni; + } + } + + /* update uu after the iteration */ + N_VScale(ONE, kin_mem->kin_unew, kin_mem->kin_uu); + + kin_mem->kin_f1norm = f1normp; + + /* print the current nni, fnorm, and nfe values if printfl > 0 */ + + if (kin_mem->kin_printfl > 0) + KINPrintInfo(kin_mem, PRNT_NNI, "KINSOL", "KINSol", INFO_NNI, kin_mem->kin_nni, kin_mem->kin_nfe, kin_mem->kin_fnorm); + + if (ret != CONTINUE_ITERATIONS) break; + + fflush(kin_mem->kin_errfp); + + } /* end of loop; return */ + + + + if (kin_mem->kin_printfl > 0) + KINPrintInfo(kin_mem, PRNT_RETVAL, "KINSOL", "KINSol", INFO_RETVAL, ret); + + switch(ret) { + case KIN_SYSFUNC_FAIL: + KINProcessError(kin_mem, KIN_SYSFUNC_FAIL, "KINSOL", "KINSol", MSG_SYSFUNC_FAILED); + break; + case KIN_REPTD_SYSFUNC_ERR: + KINProcessError(kin_mem, KIN_REPTD_SYSFUNC_ERR, "KINSOL", "KINSol", MSG_SYSFUNC_REPTD); + break; + case KIN_LSETUP_FAIL: + KINProcessError(kin_mem, KIN_LSETUP_FAIL, "KINSOL", "KINSol", MSG_LSETUP_FAILED); + break; + case KIN_LSOLVE_FAIL: + KINProcessError(kin_mem, KIN_LSOLVE_FAIL, "KINSOL", "KINSol", MSG_LSOLVE_FAILED); + break; + case KIN_LINSOLV_NO_RECOVERY: + KINProcessError(kin_mem, KIN_LINSOLV_NO_RECOVERY, "KINSOL", "KINSol", MSG_LINSOLV_NO_RECOVERY); + break; + case KIN_LINESEARCH_NONCONV: + KINProcessError(kin_mem, KIN_LINESEARCH_NONCONV, "KINSOL", "KINSol", MSG_LINESEARCH_NONCONV); + break; + case KIN_LINESEARCH_BCFAIL: + KINProcessError(kin_mem, KIN_LINESEARCH_BCFAIL, "KINSOL", "KINSol", MSG_LINESEARCH_BCFAIL); + break; + case KIN_MAXITER_REACHED: + KINProcessError(kin_mem, KIN_MAXITER_REACHED, "KINSOL", "KINSol", MSG_MAXITER_REACHED); + break; + case KIN_MXNEWT_5X_EXCEEDED: + KINProcessError(kin_mem, KIN_MXNEWT_5X_EXCEEDED, "KINSOL", "KINSol", MSG_MXNEWT_5X_EXCEEDED); + break; + } + + return(ret); +} + +/* + * ----------------------------------------------------------------- + * Deallocation function + * ----------------------------------------------------------------- + */ + +/* + * Function : KINFree + * + * This routine frees the problem memory allocated by KINInit. + * Such memory includes all the vectors allocated by + * KINAllocVectors, and the memory lmem for the linear solver + * (deallocated by a call to lfree). + */ + +void KINFree(void **kinmem) +{ + KINMem kin_mem; + + if (*kinmem == NULL) return; + + kin_mem = (KINMem) (*kinmem); + KINFreeVectors(kin_mem); + + /* call lfree if non-NULL */ + + if (kin_mem->kin_lfree != NULL) kin_mem->kin_lfree(kin_mem); + + free(*kinmem); + *kinmem = NULL; +} + +/* + * ================================================================= + * PRIVATE FUNCTIONS + * ================================================================= + */ + +/* + * Function : KINCheckNvector + * + * This routine checks if all required vector operations are + * implemented (excluding those required by KINConstraint). If all + * necessary operations are present, then KINCheckNvector returns + * SUNTRUE. Otherwise, SUNFALSE is returned. + */ + +static booleantype KINCheckNvector(N_Vector tmpl) +{ + if ((tmpl->ops->nvclone == NULL) || + (tmpl->ops->nvdestroy == NULL) || + (tmpl->ops->nvlinearsum == NULL) || + (tmpl->ops->nvprod == NULL) || + (tmpl->ops->nvdiv == NULL) || + (tmpl->ops->nvscale == NULL) || + (tmpl->ops->nvabs == NULL) || + (tmpl->ops->nvinv == NULL) || + (tmpl->ops->nvmaxnorm == NULL) || + (tmpl->ops->nvmin == NULL) || + (tmpl->ops->nvwl2norm == NULL)) return(SUNFALSE); + else return(SUNTRUE); +} + +/* + * ----------------------------------------------------------------- + * Memory allocation/deallocation + * ----------------------------------------------------------------- + */ + +/* + * Function : KINAllocVectors + * + * This routine allocates the KINSol vectors. If all memory + * allocations are successful, KINAllocVectors returns SUNTRUE. + * Otherwise all allocated memory is freed and KINAllocVectors + * returns SUNFALSE. + */ + +static booleantype KINAllocVectors(KINMem kin_mem, N_Vector tmpl) +{ + /* allocate unew, fval, pp, vtemp1 and vtemp2. */ + /* allocate df, dg, q, for Anderson Acceleration, Broyden and EN */ + + if (kin_mem->kin_unew == NULL) { + kin_mem->kin_unew = N_VClone(tmpl); + if (kin_mem->kin_unew == NULL) return(SUNFALSE); + kin_mem->kin_liw += kin_mem->kin_liw1; + kin_mem->kin_lrw += kin_mem->kin_lrw1; + } + + if (kin_mem->kin_fval == NULL) { + kin_mem->kin_fval = N_VClone(tmpl); + if (kin_mem->kin_fval == NULL) { + N_VDestroy(kin_mem->kin_unew); + kin_mem->kin_liw -= kin_mem->kin_liw1; + kin_mem->kin_lrw -= kin_mem->kin_lrw1; + return(SUNFALSE); + } + kin_mem->kin_liw += kin_mem->kin_liw1; + kin_mem->kin_lrw += kin_mem->kin_lrw1; + } + + if (kin_mem->kin_pp == NULL) { + kin_mem->kin_pp = N_VClone(tmpl); + if (kin_mem->kin_pp == NULL) { + N_VDestroy(kin_mem->kin_unew); + N_VDestroy(kin_mem->kin_fval); + kin_mem->kin_liw -= 2*kin_mem->kin_liw1; + kin_mem->kin_lrw -= 2*kin_mem->kin_lrw1; + return(SUNFALSE); + } + kin_mem->kin_liw += kin_mem->kin_liw1; + kin_mem->kin_lrw += kin_mem->kin_lrw1; + } + + if (kin_mem->kin_vtemp1 == NULL) { + kin_mem->kin_vtemp1 = N_VClone(tmpl); + if (kin_mem->kin_vtemp1 == NULL) { + N_VDestroy(kin_mem->kin_unew); + N_VDestroy(kin_mem->kin_fval); + N_VDestroy(kin_mem->kin_pp); + kin_mem->kin_liw -= 3*kin_mem->kin_liw1; + kin_mem->kin_lrw -= 3*kin_mem->kin_lrw1; + return(SUNFALSE); + } + kin_mem->kin_liw += kin_mem->kin_liw1; + kin_mem->kin_lrw += kin_mem->kin_lrw1; + } + + if (kin_mem->kin_vtemp2 == NULL) { + kin_mem->kin_vtemp2 = N_VClone(tmpl); + if (kin_mem->kin_vtemp2 == NULL) { + N_VDestroy(kin_mem->kin_unew); + N_VDestroy(kin_mem->kin_fval); + N_VDestroy(kin_mem->kin_pp); + N_VDestroy(kin_mem->kin_vtemp1); + kin_mem->kin_liw -= 4*kin_mem->kin_liw1; + kin_mem->kin_lrw -= 4*kin_mem->kin_lrw1; + return(SUNFALSE); + } + kin_mem->kin_liw += kin_mem->kin_liw1; + kin_mem->kin_lrw += kin_mem->kin_lrw1; + } + + /* Vectors for Anderson acceleration */ + + if (kin_mem->kin_m_aa) { + + if (kin_mem->kin_R_aa == NULL) { + kin_mem->kin_R_aa = (realtype *) malloc((kin_mem->kin_m_aa*kin_mem->kin_m_aa) * sizeof(realtype)); + if (kin_mem->kin_R_aa == NULL) { + KINProcessError(kin_mem, 0, "KINSOL", "KINAllocVectors", MSG_MEM_FAIL); + N_VDestroy(kin_mem->kin_unew); + N_VDestroy(kin_mem->kin_fval); + N_VDestroy(kin_mem->kin_pp); + N_VDestroy(kin_mem->kin_vtemp1); + N_VDestroy(kin_mem->kin_vtemp2); + kin_mem->kin_liw -= 5*kin_mem->kin_liw1; + kin_mem->kin_lrw -= 5*kin_mem->kin_lrw1; + return(KIN_MEM_FAIL); + } + } + + if (kin_mem->kin_gamma_aa == NULL) { + kin_mem->kin_gamma_aa = (realtype *) malloc(kin_mem->kin_m_aa * sizeof(realtype)); + if (kin_mem->kin_gamma_aa == NULL) { + KINProcessError(kin_mem, 0, "KINSOL", "KINAllocVectors", MSG_MEM_FAIL); + N_VDestroy(kin_mem->kin_unew); + N_VDestroy(kin_mem->kin_fval); + N_VDestroy(kin_mem->kin_pp); + N_VDestroy(kin_mem->kin_vtemp1); + N_VDestroy(kin_mem->kin_vtemp2); + free(kin_mem->kin_R_aa); + kin_mem->kin_liw -= 5*kin_mem->kin_liw1; + kin_mem->kin_lrw -= 5*kin_mem->kin_lrw1; + return(KIN_MEM_FAIL); + } + } + + if (kin_mem->kin_ipt_map == NULL) { + kin_mem->kin_ipt_map = (long int *) malloc(kin_mem->kin_m_aa * sizeof(long int)); + if (kin_mem->kin_ipt_map == NULL) { + KINProcessError(kin_mem, 0, "KINSOL", "KINAllocVectors", MSG_MEM_FAIL); + N_VDestroy(kin_mem->kin_unew); + N_VDestroy(kin_mem->kin_fval); + N_VDestroy(kin_mem->kin_pp); + N_VDestroy(kin_mem->kin_vtemp1); + N_VDestroy(kin_mem->kin_vtemp2); + free(kin_mem->kin_R_aa); + free(kin_mem->kin_gamma_aa); + kin_mem->kin_liw -= 5*kin_mem->kin_liw1; + kin_mem->kin_lrw -= 5*kin_mem->kin_lrw1; + return(KIN_MEM_FAIL); + } + } + + if (kin_mem->kin_cv == NULL) { + kin_mem->kin_cv = (realtype *) malloc(2 * (kin_mem->kin_m_aa+1) * sizeof(realtype)); + if (kin_mem->kin_cv == NULL) { + KINProcessError(kin_mem, 0, "KINSOL", "KINAllocVectors", MSG_MEM_FAIL); + N_VDestroy(kin_mem->kin_unew); + N_VDestroy(kin_mem->kin_fval); + N_VDestroy(kin_mem->kin_pp); + N_VDestroy(kin_mem->kin_vtemp1); + N_VDestroy(kin_mem->kin_vtemp2); + free(kin_mem->kin_R_aa); + free(kin_mem->kin_gamma_aa); + free(kin_mem->kin_ipt_map); + kin_mem->kin_liw -= 5*kin_mem->kin_liw1; + kin_mem->kin_lrw -= 5*kin_mem->kin_lrw1; + return(KIN_MEM_FAIL); + } + } + + if (kin_mem->kin_Xv == NULL) { + kin_mem->kin_Xv = (N_Vector *) malloc(2 * (kin_mem->kin_m_aa+1) * sizeof(N_Vector)); + if (kin_mem->kin_Xv == NULL) { + KINProcessError(kin_mem, 0, "KINSOL", "KINAllocVectors", MSG_MEM_FAIL); + N_VDestroy(kin_mem->kin_unew); + N_VDestroy(kin_mem->kin_fval); + N_VDestroy(kin_mem->kin_pp); + N_VDestroy(kin_mem->kin_vtemp1); + N_VDestroy(kin_mem->kin_vtemp2); + free(kin_mem->kin_R_aa); + free(kin_mem->kin_gamma_aa); + free(kin_mem->kin_ipt_map); + free(kin_mem->kin_cv); + kin_mem->kin_liw -= 5*kin_mem->kin_liw1; + kin_mem->kin_lrw -= 5*kin_mem->kin_lrw1; + return(KIN_MEM_FAIL); + } + } + + if (kin_mem->kin_fold_aa == NULL) { + kin_mem->kin_fold_aa = N_VClone(tmpl); + if (kin_mem->kin_fold_aa == NULL) { + N_VDestroy(kin_mem->kin_unew); + N_VDestroy(kin_mem->kin_fval); + N_VDestroy(kin_mem->kin_pp); + N_VDestroy(kin_mem->kin_vtemp1); + N_VDestroy(kin_mem->kin_vtemp2); + free(kin_mem->kin_R_aa); + free(kin_mem->kin_gamma_aa); + free(kin_mem->kin_ipt_map); + free(kin_mem->kin_cv); + free(kin_mem->kin_Xv); + kin_mem->kin_liw -= 5*kin_mem->kin_liw1; + kin_mem->kin_lrw -= 5*kin_mem->kin_lrw1; + return(SUNFALSE); + } + kin_mem->kin_liw += kin_mem->kin_liw1; + kin_mem->kin_lrw += kin_mem->kin_lrw1; + } + + if (kin_mem->kin_gold_aa == NULL) { + kin_mem->kin_gold_aa = N_VClone(tmpl); + if (kin_mem->kin_gold_aa == NULL) { + N_VDestroy(kin_mem->kin_unew); + N_VDestroy(kin_mem->kin_fval); + N_VDestroy(kin_mem->kin_pp); + N_VDestroy(kin_mem->kin_vtemp1); + N_VDestroy(kin_mem->kin_vtemp2); + free(kin_mem->kin_R_aa); + free(kin_mem->kin_gamma_aa); + free(kin_mem->kin_ipt_map); + free(kin_mem->kin_cv); + free(kin_mem->kin_Xv); + N_VDestroy(kin_mem->kin_fold_aa); + kin_mem->kin_liw -= 6*kin_mem->kin_liw1; + kin_mem->kin_lrw -= 6*kin_mem->kin_lrw1; + return(SUNFALSE); + } + kin_mem->kin_liw += kin_mem->kin_liw1; + kin_mem->kin_lrw += kin_mem->kin_lrw1; + } + + if (kin_mem->kin_df_aa == NULL) { + kin_mem->kin_df_aa = N_VCloneVectorArray((int) kin_mem->kin_m_aa,tmpl); + if (kin_mem->kin_df_aa == NULL) { + N_VDestroy(kin_mem->kin_unew); + N_VDestroy(kin_mem->kin_fval); + N_VDestroy(kin_mem->kin_pp); + N_VDestroy(kin_mem->kin_vtemp1); + N_VDestroy(kin_mem->kin_vtemp2); + free(kin_mem->kin_R_aa); + free(kin_mem->kin_gamma_aa); + free(kin_mem->kin_ipt_map); + free(kin_mem->kin_cv); + free(kin_mem->kin_Xv); + N_VDestroy(kin_mem->kin_fold_aa); + N_VDestroy(kin_mem->kin_gold_aa); + kin_mem->kin_liw -= 7*kin_mem->kin_liw1; + kin_mem->kin_lrw -= 7*kin_mem->kin_lrw1; + return(SUNFALSE); + } + kin_mem->kin_liw += kin_mem->kin_m_aa * kin_mem->kin_liw1; + kin_mem->kin_lrw += kin_mem->kin_m_aa * kin_mem->kin_lrw1; + } + + if (kin_mem->kin_dg_aa == NULL) { + kin_mem->kin_dg_aa = N_VCloneVectorArray((int) kin_mem->kin_m_aa,tmpl); + if (kin_mem->kin_dg_aa == NULL) { + N_VDestroy(kin_mem->kin_unew); + N_VDestroy(kin_mem->kin_fval); + N_VDestroy(kin_mem->kin_pp); + N_VDestroy(kin_mem->kin_vtemp1); + N_VDestroy(kin_mem->kin_vtemp2); + free(kin_mem->kin_R_aa); + free(kin_mem->kin_gamma_aa); + free(kin_mem->kin_ipt_map); + free(kin_mem->kin_cv); + free(kin_mem->kin_Xv); + N_VDestroy(kin_mem->kin_fold_aa); + N_VDestroy(kin_mem->kin_gold_aa); + N_VDestroyVectorArray(kin_mem->kin_df_aa, (int) kin_mem->kin_m_aa); + kin_mem->kin_liw -= (7 + kin_mem->kin_m_aa) * kin_mem->kin_liw1; + kin_mem->kin_lrw -= (7 + kin_mem->kin_m_aa) * kin_mem->kin_lrw1; + return(SUNFALSE); + } + kin_mem->kin_liw += kin_mem->kin_m_aa * kin_mem->kin_liw1; + kin_mem->kin_lrw += kin_mem->kin_m_aa * kin_mem->kin_lrw1; + } + + if (kin_mem->kin_q_aa == NULL) { + kin_mem->kin_q_aa = N_VCloneVectorArray((int) kin_mem->kin_m_aa,tmpl); + if (kin_mem->kin_q_aa == NULL) { + N_VDestroy(kin_mem->kin_unew); + N_VDestroy(kin_mem->kin_fval); + N_VDestroy(kin_mem->kin_pp); + N_VDestroy(kin_mem->kin_vtemp1); + N_VDestroy(kin_mem->kin_vtemp2); + free(kin_mem->kin_R_aa); + free(kin_mem->kin_gamma_aa); + free(kin_mem->kin_ipt_map); + free(kin_mem->kin_cv); + free(kin_mem->kin_Xv); + N_VDestroy(kin_mem->kin_fold_aa); + N_VDestroy(kin_mem->kin_gold_aa); + N_VDestroyVectorArray(kin_mem->kin_df_aa, (int) kin_mem->kin_m_aa); + N_VDestroyVectorArray(kin_mem->kin_dg_aa, (int) kin_mem->kin_m_aa); + kin_mem->kin_liw -= (7 + 2 * kin_mem->kin_m_aa) * kin_mem->kin_liw1; + kin_mem->kin_lrw -= (7 + 2 * kin_mem->kin_m_aa) * kin_mem->kin_lrw1; + return(SUNFALSE); + } + kin_mem->kin_liw += kin_mem->kin_m_aa * kin_mem->kin_liw1; + kin_mem->kin_lrw += kin_mem->kin_m_aa * kin_mem->kin_lrw1; + } + } + + return(SUNTRUE); +} + +/* + * KINFreeVectors + * + * This routine frees the KINSol vectors allocated by + * KINAllocVectors. + */ + +static void KINFreeVectors(KINMem kin_mem) +{ + if (kin_mem->kin_unew != NULL) { + N_VDestroy(kin_mem->kin_unew); + kin_mem->kin_unew = NULL; + kin_mem->kin_lrw -= kin_mem->kin_lrw1; + kin_mem->kin_liw -= kin_mem->kin_liw1; + } + + if (kin_mem->kin_fval != NULL) { + N_VDestroy(kin_mem->kin_fval); + kin_mem->kin_fval = NULL; + kin_mem->kin_lrw -= kin_mem->kin_lrw1; + kin_mem->kin_liw -= kin_mem->kin_liw1; + } + + if (kin_mem->kin_pp != NULL) { + N_VDestroy(kin_mem->kin_pp); + kin_mem->kin_pp = NULL; + kin_mem->kin_lrw -= kin_mem->kin_lrw1; + kin_mem->kin_liw -= kin_mem->kin_liw1; + } + + if (kin_mem->kin_vtemp1 != NULL) { + N_VDestroy(kin_mem->kin_vtemp1); + kin_mem->kin_vtemp1 = NULL; + kin_mem->kin_lrw -= kin_mem->kin_lrw1; + kin_mem->kin_liw -= kin_mem->kin_liw1; + } + + if (kin_mem->kin_vtemp2 != NULL) { + N_VDestroy(kin_mem->kin_vtemp2); + kin_mem->kin_vtemp2 = NULL; + kin_mem->kin_lrw -= kin_mem->kin_lrw1; + kin_mem->kin_liw -= kin_mem->kin_liw1; + } + + if (kin_mem->kin_gval != NULL) { + N_VDestroy(kin_mem->kin_gval); + kin_mem->kin_gval = NULL; + kin_mem->kin_lrw -= kin_mem->kin_lrw1; + kin_mem->kin_liw -= kin_mem->kin_liw1; + } + + if (kin_mem->kin_R_aa != NULL) { + free(kin_mem->kin_R_aa); + kin_mem->kin_R_aa = NULL; + } + + if (kin_mem->kin_gamma_aa != NULL) { + free(kin_mem->kin_gamma_aa); + kin_mem->kin_gamma_aa = NULL; + } + + if (kin_mem->kin_ipt_map != NULL) { + free(kin_mem->kin_ipt_map); + kin_mem->kin_ipt_map = NULL; + } + + if (kin_mem->kin_cv != NULL) { + free(kin_mem->kin_cv); + kin_mem->kin_cv = NULL; + } + + if (kin_mem->kin_Xv != NULL) { + free(kin_mem->kin_Xv); + kin_mem->kin_Xv = NULL; + } + + if (kin_mem->kin_fold_aa != NULL) { + N_VDestroy(kin_mem->kin_fold_aa); + kin_mem->kin_fold_aa = NULL; + kin_mem->kin_lrw -= kin_mem->kin_lrw1; + kin_mem->kin_liw -= kin_mem->kin_liw1; + } + + if (kin_mem->kin_gold_aa != NULL) { + N_VDestroy(kin_mem->kin_gold_aa); + kin_mem->kin_gold_aa = NULL; + kin_mem->kin_lrw -= kin_mem->kin_lrw1; + kin_mem->kin_liw -= kin_mem->kin_liw1; + } + + if (kin_mem->kin_df_aa != NULL) { + N_VDestroyVectorArray(kin_mem->kin_df_aa, (int) kin_mem->kin_m_aa); + kin_mem->kin_df_aa = NULL; + kin_mem->kin_lrw -= kin_mem->kin_m_aa * kin_mem->kin_lrw1; + kin_mem->kin_liw -= kin_mem->kin_m_aa * kin_mem->kin_liw1; + } + + if (kin_mem->kin_dg_aa != NULL) { + N_VDestroyVectorArray(kin_mem->kin_dg_aa, (int) kin_mem->kin_m_aa); + kin_mem->kin_dg_aa = NULL; + kin_mem->kin_lrw -= kin_mem->kin_m_aa * kin_mem->kin_lrw1; + kin_mem->kin_liw -= kin_mem->kin_m_aa * kin_mem->kin_liw1; + } + + if (kin_mem->kin_q_aa != NULL) { + N_VDestroyVectorArray(kin_mem->kin_q_aa, (int) kin_mem->kin_m_aa); + kin_mem->kin_q_aa = NULL; + kin_mem->kin_lrw -= kin_mem->kin_m_aa * kin_mem->kin_lrw1; + kin_mem->kin_liw -= kin_mem->kin_m_aa * kin_mem->kin_liw1; + } + + if (kin_mem->kin_constraints != NULL) { + N_VDestroy(kin_mem->kin_constraints); + kin_mem->kin_constraints = NULL; + kin_mem->kin_lrw -= kin_mem->kin_lrw1; + kin_mem->kin_liw -= kin_mem->kin_liw1; + } + + return; +} + +/* + * ----------------------------------------------------------------- + * Initial setup + * ----------------------------------------------------------------- + */ + +/* + * KINSolInit + * + * KINSolInit initializes the problem for the specific input + * received in this call to KINSol (which calls KINSolInit). 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 possible return values for KINSolInit are: + * KIN_SUCCESS : indicates a normal initialization + * + * KIN_ILL_INPUT : indicates that an input error has been found + * + * KIN_INITIAL_GUESS_OK : indicates that the guess uu + * satisfied the system func(uu) = 0 + * within the tolerances specified + */ + +static int KINSolInit(KINMem kin_mem) +{ + int retval; + realtype fmax; + + /* check for illegal input parameters */ + + if (kin_mem->kin_uu == NULL) { + KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_UU_NULL); + return(KIN_ILL_INPUT); + } + + /* check for valid strategy */ + + if ( (kin_mem->kin_globalstrategy != KIN_NONE) && + (kin_mem->kin_globalstrategy != KIN_LINESEARCH) && + (kin_mem->kin_globalstrategy != KIN_PICARD) && + (kin_mem->kin_globalstrategy != KIN_FP) ) { + KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_BAD_GLSTRAT); + return(KIN_ILL_INPUT); + } + + if (kin_mem->kin_uscale == NULL) { + KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_BAD_USCALE); + return(KIN_ILL_INPUT); + } + + if (N_VMin(kin_mem->kin_uscale) <= ZERO){ + KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_USCALE_NONPOSITIVE); + return(KIN_ILL_INPUT); + } + + if (kin_mem->kin_fscale == NULL) { + KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_BAD_FSCALE); + return(KIN_ILL_INPUT); + } + + if (N_VMin(kin_mem->kin_fscale) <= ZERO){ + KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_FSCALE_NONPOSITIVE); + return(KIN_ILL_INPUT); + } + + if ( (kin_mem->kin_constraints != NULL) && + ( (kin_mem->kin_globalstrategy == KIN_PICARD) || + (kin_mem->kin_globalstrategy == KIN_FP) ) ) { + KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_CONSTRAINTS_NOTOK); + return(KIN_ILL_INPUT); + } + + + /* set the constraints flag */ + + if (kin_mem->kin_constraints == NULL) + kin_mem->kin_constraintsSet = SUNFALSE; + else { + kin_mem->kin_constraintsSet = SUNTRUE; + if ((kin_mem->kin_constraints->ops->nvconstrmask == NULL) || + (kin_mem->kin_constraints->ops->nvminquotient == NULL)) { + KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_BAD_NVECTOR); + return(KIN_ILL_INPUT); + } + } + + /* check the initial guess uu against the constraints */ + + if (kin_mem->kin_constraintsSet) { + if (!N_VConstrMask(kin_mem->kin_constraints, kin_mem->kin_uu, kin_mem->kin_vtemp1)) { + KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_INITIAL_CNSTRNT); + return(KIN_ILL_INPUT); + } + } + + /* all error checking is complete at this point */ + + if (kin_mem->kin_printfl > 0) + KINPrintInfo(kin_mem, PRNT_TOL, "KINSOL", "KINSolInit", INFO_TOL, kin_mem->kin_scsteptol, kin_mem->kin_fnormtol); + + /* calculate the default value for mxnewtstep (maximum Newton step) */ + + if (kin_mem->kin_mxnstepin == ZERO) kin_mem->kin_mxnewtstep = THOUSAND * N_VWL2Norm(kin_mem->kin_uu, kin_mem->kin_uscale); + else kin_mem->kin_mxnewtstep = kin_mem->kin_mxnstepin; + + if (kin_mem->kin_mxnewtstep < ONE) kin_mem->kin_mxnewtstep = ONE; + + /* additional set-up for inexact linear solvers */ + + if (kin_mem->kin_inexact_ls) { + + /* set up the coefficients for the eta calculation */ + + kin_mem->kin_callForcingTerm = (kin_mem->kin_etaflag != KIN_ETACONSTANT); + + /* this value is always used for choice #1 */ + + if (kin_mem->kin_etaflag == KIN_ETACHOICE1) kin_mem->kin_eta_alpha = (ONE + SUNRsqrt(FIVE)) * HALF; + + /* initial value for eta set to 0.5 for other than the + KIN_ETACONSTANT option */ + + if (kin_mem->kin_etaflag != KIN_ETACONSTANT) kin_mem->kin_eta = HALF; + + /* disable residual monitoring if using an inexact linear solver */ + + kin_mem->kin_noResMon = SUNTRUE; + + } else { + + kin_mem->kin_callForcingTerm = SUNFALSE; + + } + + /* initialize counters */ + + kin_mem->kin_nfe = kin_mem->kin_nnilset = kin_mem->kin_nnilset_sub = kin_mem->kin_nni = kin_mem->kin_nbcf = kin_mem->kin_nbktrk = 0; + + /* see if the initial guess uu satisfies the nonlinear system */ + retval = kin_mem->kin_func(kin_mem->kin_uu, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; + + if (retval < 0) { + KINProcessError(kin_mem, KIN_SYSFUNC_FAIL, "KINSOL", "KINSolInit", + MSG_SYSFUNC_FAILED); + return(KIN_SYSFUNC_FAIL); + } else if (retval > 0) { + KINProcessError(kin_mem, KIN_FIRST_SYSFUNC_ERR, "KINSOL", "KINSolInit", + MSG_SYSFUNC_FIRST); + return(KIN_FIRST_SYSFUNC_ERR); + } + + fmax = KINScFNorm(kin_mem, kin_mem->kin_fval, kin_mem->kin_fscale); + if (fmax <= (POINT01 * kin_mem->kin_fnormtol)) { + kin_mem->kin_fnorm = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); + return(KIN_INITIAL_GUESS_OK); + } + + if (kin_mem->kin_printfl > 1) + KINPrintInfo(kin_mem, PRNT_FMAX, "KINSOL", "KINSolInit", INFO_FMAX, fmax); + + /* initialize the linear solver if linit != NULL */ + + if (kin_mem->kin_linit != NULL) { + retval = kin_mem->kin_linit(kin_mem); + if (retval != 0) { + KINProcessError(kin_mem, KIN_LINIT_FAIL, "KINSOL", "KINSolInit", MSG_LINIT_FAIL); + return(KIN_LINIT_FAIL); + } + } + + /* initialize the L2 (Euclidean) norms of f for the linear iteration steps */ + + kin_mem->kin_fnorm = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); + kin_mem->kin_f1norm = HALF * kin_mem->kin_fnorm * kin_mem->kin_fnorm; + kin_mem->kin_fnorm_sub = kin_mem->kin_fnorm; + + if (kin_mem->kin_printfl > 0) + KINPrintInfo(kin_mem, PRNT_NNI, "KINSOL", "KINSolInit", + INFO_NNI, kin_mem->kin_nni, kin_mem->kin_nfe, kin_mem->kin_fnorm); + + /* problem has now been successfully initialized */ + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Step functions + * ----------------------------------------------------------------- + */ + +/* + * KINLinSolDrv + * + * This routine handles the process of solving for the approximate + * solution of the Newton equations in the Newton iteration. + * Subsequent routines handle the nonlinear aspects of its + * application. + */ + +static int KINLinSolDrv(KINMem kin_mem) +{ + N_Vector x, b; + int retval; + + if ((kin_mem->kin_nni - kin_mem->kin_nnilset) >= kin_mem->kin_msbset) { + kin_mem->kin_sthrsh = TWO; + kin_mem->kin_update_fnorm_sub = SUNTRUE; + } + + for(;;){ + + kin_mem->kin_jacCurrent = SUNFALSE; + + if ((kin_mem->kin_sthrsh > ONEPT5) && (kin_mem->kin_lsetup != NULL)) { + retval = kin_mem->kin_lsetup(kin_mem); + kin_mem->kin_jacCurrent = SUNTRUE; + kin_mem->kin_nnilset = kin_mem->kin_nni; + kin_mem->kin_nnilset_sub = kin_mem->kin_nni; + if (retval != 0) return(KIN_LSETUP_FAIL); + } + + /* rename vectors for readability */ + + b = kin_mem->kin_unew; + x = kin_mem->kin_pp; + + /* load b with the current value of -fval */ + + N_VScale(-ONE, kin_mem->kin_fval, b); + + /* call the generic 'lsolve' routine to solve the system Jx = b */ + + retval = kin_mem->kin_lsolve(kin_mem, x, b, &(kin_mem->kin_sJpnorm), + &(kin_mem->kin_sFdotJp)); + + if (retval == 0) return(KIN_SUCCESS); + else if (retval < 0) return(KIN_LSOLVE_FAIL); + else if ((kin_mem->kin_lsetup == NULL) || (kin_mem->kin_jacCurrent)) return(KIN_LINSOLV_NO_RECOVERY); + + /* loop back only if the linear solver setup is in use + and Jacobian information is not current */ + + kin_mem->kin_sthrsh = TWO; + + } +} + +/* + * KINFullNewton + * + * This routine is the main driver for the Full Newton + * algorithm. Its purpose is to compute unew = uu + pp in the + * direction pp from uu, taking the full Newton step. The + * step may be constrained if the constraint conditions are + * violated, or if the norm of pp is greater than mxnewtstep. + */ + +static int KINFullNewton(KINMem kin_mem, realtype *fnormp, realtype *f1normp, + booleantype *maxStepTaken) +{ + realtype pnorm, ratio; + booleantype fOK; + int ircvr, retval; + + *maxStepTaken = SUNFALSE; + pnorm = N_VWL2Norm(kin_mem->kin_pp, kin_mem->kin_uscale); + ratio = ONE; + if (pnorm > kin_mem->kin_mxnewtstep) { + ratio = kin_mem->kin_mxnewtstep / pnorm; + N_VScale(ratio, kin_mem->kin_pp, kin_mem->kin_pp); + pnorm = kin_mem->kin_mxnewtstep; + } + + if (kin_mem->kin_printfl > 0) + KINPrintInfo(kin_mem, PRNT_PNORM, "KINSOL", "KINFullNewton", INFO_PNORM, pnorm); + + /* If constraints are active, then constrain the step accordingly */ + + kin_mem->kin_stepl = pnorm; + kin_mem->kin_stepmul = ONE; + if (kin_mem->kin_constraintsSet) { + retval = KINConstraint(kin_mem); + if (retval == CONSTR_VIOLATED) { + /* Apply stepmul set in KINConstraint */ + ratio *= kin_mem->kin_stepmul; + N_VScale(kin_mem->kin_stepmul, kin_mem->kin_pp, kin_mem->kin_pp); + pnorm *= kin_mem->kin_stepmul; + kin_mem->kin_stepl = pnorm; + if (kin_mem->kin_printfl > 0) + KINPrintInfo(kin_mem, PRNT_PNORM, "KINSOL", "KINFullNewton", INFO_PNORM, pnorm); + if (pnorm <= kin_mem->kin_scsteptol) { + N_VLinearSum(ONE, kin_mem->kin_uu, ONE, kin_mem->kin_pp, kin_mem->kin_unew); + return(STEP_TOO_SMALL);} + } + } + + /* Attempt (at most MAX_RECVR times) to evaluate function at the new iterate */ + + fOK = SUNFALSE; + + for (ircvr = 1; ircvr <= MAX_RECVR; ircvr++) { + + /* compute the iterate unew = uu + pp */ + N_VLinearSum(ONE, kin_mem->kin_uu, ONE, kin_mem->kin_pp, kin_mem->kin_unew); + + /* evaluate func(unew) and its norm, and return */ + retval = kin_mem->kin_func(kin_mem->kin_unew, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; + + /* if func was successful, accept pp */ + if (retval == 0) {fOK = SUNTRUE; break;} + + /* if func failed unrecoverably, give up */ + else if (retval < 0) return(KIN_SYSFUNC_FAIL); + + /* func failed recoverably; cut step in half and try again */ + ratio *= HALF; + N_VScale(HALF, kin_mem->kin_pp, kin_mem->kin_pp); + pnorm *= HALF; + kin_mem->kin_stepl = pnorm; + } + + /* If func() failed recoverably MAX_RECVR times, give up */ + + if (!fOK) return(KIN_REPTD_SYSFUNC_ERR); + + /* Evaluate function norms */ + + *fnormp = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); + *f1normp = HALF * (*fnormp) * (*fnormp); + + /* scale sFdotJp and sJpnorm by ratio for later use in KINForcingTerm */ + + kin_mem->kin_sFdotJp *= ratio; + kin_mem->kin_sJpnorm *= ratio; + + if (kin_mem->kin_printfl > 1) + KINPrintInfo(kin_mem, PRNT_FNORM, "KINSOL", "KINFullNewton", INFO_FNORM, *fnormp); + + if (pnorm > (POINT99 * kin_mem->kin_mxnewtstep)) *maxStepTaken = SUNTRUE; + + return(KIN_SUCCESS); +} + +/* + * KINLineSearch + * + * The routine KINLineSearch implements the LineSearch algorithm. + * Its purpose is to find unew = uu + rl * pp in the direction pp + * from uu so that: + * t + * func(unew) <= func(uu) + alpha * g (unew - uu) (alpha = 1.e-4) + * + * and + * t + * func(unew) >= func(uu) + beta * g (unew - uu) (beta = 0.9) + * + * where 0 < rlmin <= rl <= rlmax. + * + * Note: + * mxnewtstep + * rlmax = ---------------- if uu+pp is feasible + * ||uscale*pp||_L2 + * + * rlmax = 1 otherwise + * + * and + * + * scsteptol + * rlmin = -------------------------- + * || pp || + * || -------------------- ||_L-infinity + * || (1/uscale + SUNRabs(uu)) || + * + * + * If the system function fails unrecoverably at any time, KINLineSearch + * returns KIN_SYSFUNC_FAIL which will halt the solver. + * + * We attempt to corect recoverable system function failures only before + * the alpha-condition loop; i.e. when the solution is updated with the + * full Newton step (possibly reduced due to constraint violations). + * Once we find a feasible pp, we assume that any update up to pp is + * feasible. + * + * If the step size is limited due to constraint violations and/or + * recoverable system function failures, we set rlmax=1 to ensure + * that the update remains feasible during the attempts to enforce + * the beta-condition (this is not an issue while enforcing the alpha + * condition, as rl can only decrease from 1 at that stage) + */ + +static int KINLineSearch(KINMem kin_mem, realtype *fnormp, realtype *f1normp, + booleantype *maxStepTaken) +{ + realtype pnorm, ratio, slpi, rlmin, rlength, rl, rlmax, rldiff; + realtype rltmp, rlprev, pt1trl, f1nprv, rllo, rlinc, alpha, beta; + realtype alpha_cond, beta_cond, rl_a, tmp1, rl_b, tmp2, disc; + int ircvr, nbktrk_l, retval; + booleantype firstBacktrack, fOK; + + /* Initializations */ + + nbktrk_l = 0; /* local backtracking counter */ + ratio = ONE; /* step change ratio */ + alpha = POINT0001; + beta = POINT9; + + firstBacktrack = SUNTRUE; + *maxStepTaken = SUNFALSE; + + rlprev = f1nprv = ZERO; + + /* Compute length of Newton step */ + + pnorm = N_VWL2Norm(kin_mem->kin_pp, kin_mem->kin_uscale); + rlmax = kin_mem->kin_mxnewtstep / pnorm; + kin_mem->kin_stepl = pnorm; + + /* If the full Newton step is too large, set it to the maximum allowable value */ + + if(pnorm > kin_mem->kin_mxnewtstep ) { + ratio = kin_mem->kin_mxnewtstep / pnorm; + N_VScale(ratio, kin_mem->kin_pp, kin_mem->kin_pp); + pnorm = kin_mem->kin_mxnewtstep; + rlmax = ONE; + kin_mem->kin_stepl = pnorm; + } + + /* If constraint checking is activated, check and correct violations */ + + kin_mem->kin_stepmul = ONE; + + if(kin_mem->kin_constraintsSet){ + retval = KINConstraint(kin_mem); + if(retval == CONSTR_VIOLATED){ + /* Apply stepmul set in KINConstraint */ + N_VScale(kin_mem->kin_stepmul, kin_mem->kin_pp, kin_mem->kin_pp); + ratio *= kin_mem->kin_stepmul; + pnorm *= kin_mem->kin_stepmul; + rlmax = ONE; + kin_mem->kin_stepl = pnorm; + if (kin_mem->kin_printfl > 0) KINPrintInfo(kin_mem, PRNT_PNORM1, "KINSOL", "KINLineSearch", INFO_PNORM1, pnorm); + if (pnorm <= kin_mem->kin_scsteptol) { + N_VLinearSum(ONE, kin_mem->kin_uu, ONE, kin_mem->kin_pp, kin_mem->kin_unew); + return(STEP_TOO_SMALL);} + } + } + + /* Attempt (at most MAX_RECVR times) to evaluate function at the new iterate */ + + fOK = SUNFALSE; + + for (ircvr = 1; ircvr <= MAX_RECVR; ircvr++) { + + /* compute the iterate unew = uu + pp */ + N_VLinearSum(ONE, kin_mem->kin_uu, ONE, kin_mem->kin_pp, kin_mem->kin_unew); + + /* evaluate func(unew) and its norm, and return */ + retval = kin_mem->kin_func(kin_mem->kin_unew, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; + + /* if func was successful, accept pp */ + if (retval == 0) {fOK = SUNTRUE; break;} + + /* if func failed unrecoverably, give up */ + else if (retval < 0) return(KIN_SYSFUNC_FAIL); + + /* func failed recoverably; cut step in half and try again */ + N_VScale(HALF, kin_mem->kin_pp, kin_mem->kin_pp); + ratio *= HALF; + pnorm *= HALF; + rlmax = ONE; + kin_mem->kin_stepl = pnorm; + + } + + /* If func() failed recoverably MAX_RECVR times, give up */ + + if (!fOK) return(KIN_REPTD_SYSFUNC_ERR); + + /* Evaluate function norms */ + + *fnormp = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); + *f1normp = HALF * (*fnormp) * (*fnormp) ; + + /* Estimate the line search value rl (lambda) to satisfy both ALPHA and BETA conditions */ + + slpi = kin_mem->kin_sFdotJp * ratio; + rlength = KINScSNorm(kin_mem, kin_mem->kin_pp, kin_mem->kin_uu); + rlmin = (kin_mem->kin_scsteptol) / rlength; + rl = ONE; + + if (kin_mem->kin_printfl > 2) + KINPrintInfo(kin_mem, PRNT_LAM, "KINSOL", "KINLineSearch", INFO_LAM, rlmin, kin_mem->kin_f1norm, pnorm); + + /* Loop until the ALPHA condition is satisfied. Terminate if rl becomes too small */ + + for(;;) { + + /* Evaluate test quantity */ + + alpha_cond = kin_mem->kin_f1norm + (alpha * slpi * rl); + + if (kin_mem->kin_printfl > 2) + KINPrintInfo(kin_mem, PRNT_ALPHA, "KINSOL", "KINLinesearch", + INFO_ALPHA, *fnormp, *f1normp, alpha_cond, rl); + + /* If ALPHA condition is satisfied, break out from loop */ + + if ((*f1normp) <= alpha_cond) break; + + /* Backtracking. Use quadratic fit the first time and cubic fit afterwards. */ + + if (firstBacktrack) { + + rltmp = -slpi / (TWO * ((*f1normp) - kin_mem->kin_f1norm - slpi)); + firstBacktrack = SUNFALSE; + + } else { + + tmp1 = (*f1normp) - kin_mem->kin_f1norm - (rl * slpi); + tmp2 = f1nprv - kin_mem->kin_f1norm - (rlprev * slpi); + rl_a = ((ONE / (rl * rl)) * tmp1) - ((ONE / (rlprev * rlprev)) * tmp2); + rl_b = ((-rlprev / (rl * rl)) * tmp1) + ((rl / (rlprev * rlprev)) * tmp2); + tmp1 = ONE / (rl - rlprev); + rl_a *= tmp1; + rl_b *= tmp1; + disc = (rl_b * rl_b) - (THREE * rl_a * slpi); + + if (SUNRabs(rl_a) < kin_mem->kin_uround) { /* cubic is actually just a quadratic (rl_a ~ 0) */ + rltmp = -slpi / (TWO * rl_b); + } else { /* real cubic */ + rltmp = (-rl_b + SUNRsqrt(disc)) / (THREE * rl_a); + } + } + if (rltmp > (HALF * rl)) rltmp = HALF * rl; + + /* Set new rl (do not allow a reduction by a factor larger than 10) */ + + rlprev = rl; + f1nprv = (*f1normp); + pt1trl = POINT1 * rl; + rl = SUNMAX(pt1trl, rltmp); + nbktrk_l++; + + /* Update unew and re-evaluate function */ + + N_VLinearSum(ONE, kin_mem->kin_uu, rl, kin_mem->kin_pp, kin_mem->kin_unew); + + retval = kin_mem->kin_func(kin_mem->kin_unew, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; + if (retval != 0) return(KIN_SYSFUNC_FAIL); + + *fnormp = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); + *f1normp = HALF * (*fnormp) * (*fnormp) ; + + /* Check if rl (lambda) is too small */ + + if (rl < rlmin) { + /* unew sufficiently distinct from uu cannot be found. + copy uu into unew (step remains unchanged) and + return STEP_TOO_SMALL */ + N_VScale(ONE, kin_mem->kin_uu, kin_mem->kin_unew); + return(STEP_TOO_SMALL); + } + + } /* end ALPHA condition loop */ + + + /* ALPHA condition is satisfied. Now check the BETA condition */ + + beta_cond = kin_mem->kin_f1norm + (beta * slpi * rl); + + if ((*f1normp) < beta_cond) { + + /* BETA condition not satisfied */ + + if ((rl == ONE) && (pnorm < kin_mem->kin_mxnewtstep)) { + + do { + + rlprev = rl; + f1nprv = *f1normp; + rl = SUNMIN((TWO * rl), rlmax); + nbktrk_l++; + + N_VLinearSum(ONE, kin_mem->kin_uu, rl, kin_mem->kin_pp, kin_mem->kin_unew); + retval = kin_mem->kin_func(kin_mem->kin_unew, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; + if (retval != 0) return(KIN_SYSFUNC_FAIL); + *fnormp = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); + *f1normp = HALF * (*fnormp) * (*fnormp); + + alpha_cond = kin_mem->kin_f1norm + (alpha * slpi * rl); + beta_cond = kin_mem->kin_f1norm + (beta * slpi * rl); + + if (kin_mem->kin_printfl > 2) + KINPrintInfo(kin_mem, PRNT_BETA, "KINSOL", "KINLineSearch", + INFO_BETA, *f1normp, beta_cond, rl); + + } while (((*f1normp) <= alpha_cond) && + ((*f1normp) < beta_cond) && (rl < rlmax)); + + } /* end if (rl == ONE) block */ + + if ((rl < ONE) || ((rl > ONE) && (*f1normp > alpha_cond))) { + + rllo = SUNMIN(rl, rlprev); + rldiff = SUNRabs(rlprev - rl); + + do { + + rlinc = HALF * rldiff; + rl = rllo + rlinc; + nbktrk_l++; + + N_VLinearSum(ONE, kin_mem->kin_uu, rl, kin_mem->kin_pp, kin_mem->kin_unew); + retval = kin_mem->kin_func(kin_mem->kin_unew, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; + if (retval != 0) return(KIN_SYSFUNC_FAIL); + *fnormp = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); + *f1normp = HALF * (*fnormp) * (*fnormp); + + alpha_cond = kin_mem->kin_f1norm + (alpha * slpi * rl); + beta_cond = kin_mem->kin_f1norm + (beta * slpi * rl); + + if (kin_mem->kin_printfl > 2) + KINPrintInfo(kin_mem, PRNT_ALPHABETA, "KINSOL", "KINLineSearch", + INFO_ALPHABETA, *f1normp, alpha_cond, beta_cond, rl); + + if ((*f1normp) > alpha_cond) rldiff = rlinc; + else if (*f1normp < beta_cond) { + rllo = rl; + rldiff = rldiff - rlinc; + } + + } while ((*f1normp > alpha_cond) || + ((*f1normp < beta_cond) && (rldiff >= rlmin))); + + if ( (*f1normp < beta_cond) || ((rldiff < rlmin) && (*f1normp > alpha_cond)) ) { + + /* beta condition could not be satisfied or rldiff too small + and alpha_cond not satisfied, so set unew to last u value + that satisfied the alpha condition and continue */ + + N_VLinearSum(ONE, kin_mem->kin_uu, rllo, kin_mem->kin_pp, kin_mem->kin_unew); + retval = kin_mem->kin_func(kin_mem->kin_unew, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; + if (retval != 0) return(KIN_SYSFUNC_FAIL); + *fnormp = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); + *f1normp = HALF * (*fnormp) * (*fnormp); + + /* increment beta-condition failures counter */ + + kin_mem->kin_nbcf++; + + } + + } /* end of if (rl < ONE) block */ + + } /* end of if (f1normp < beta_cond) block */ + + /* Update number of backtracking operations */ + + kin_mem->kin_nbktrk += nbktrk_l; + + if (kin_mem->kin_printfl > 1) + KINPrintInfo(kin_mem, PRNT_ADJ, "KINSOL", "KINLineSearch", INFO_ADJ, nbktrk_l); + + /* scale sFdotJp and sJpnorm by rl * ratio for later use in KINForcingTerm */ + + kin_mem->kin_sFdotJp = kin_mem->kin_sFdotJp * rl * ratio; + kin_mem->kin_sJpnorm = kin_mem->kin_sJpnorm * rl * ratio; + + if ((rl * pnorm) > (POINT99 * kin_mem->kin_mxnewtstep)) *maxStepTaken = SUNTRUE; + + return(KIN_SUCCESS); +} + +/* + * Function : KINConstraint + * + * This routine checks if the proposed solution vector uu + pp + * violates any constraints. If a constraint is violated, then the + * scalar stepmul is determined such that uu + stepmul * pp does + * not violate any constraints. + * + * Note: This routine is called by the functions + * KINLineSearch and KINFullNewton. + */ + +static int KINConstraint(KINMem kin_mem) +{ + N_VLinearSum(ONE, kin_mem->kin_uu, ONE, kin_mem->kin_pp, kin_mem->kin_vtemp1); + + /* if vtemp1[i] violates constraint[i] then vtemp2[i] = 1 + else vtemp2[i] = 0 (vtemp2 is the mask vector) */ + + if(N_VConstrMask(kin_mem->kin_constraints, kin_mem->kin_vtemp1, kin_mem->kin_vtemp2)) return(KIN_SUCCESS); + + /* vtemp1[i] = SUNRabs(pp[i]) */ + + N_VAbs(kin_mem->kin_pp, kin_mem->kin_vtemp1); + + /* consider vtemp1[i] only if vtemp2[i] = 1 (constraint violated) */ + + N_VProd(kin_mem->kin_vtemp2, kin_mem->kin_vtemp1, kin_mem->kin_vtemp1); + + N_VAbs(kin_mem->kin_uu, kin_mem->kin_vtemp2); + kin_mem->kin_stepmul = POINT9 * N_VMinQuotient(kin_mem->kin_vtemp2, kin_mem->kin_vtemp1); + + return(CONSTR_VIOLATED); +} + +/* + * ----------------------------------------------------------------- + * Stopping tests + * ----------------------------------------------------------------- + */ + +/* + * KINStop + * + * This routine checks the current iterate unew to see if the + * system func(unew) = 0 is satisfied by a variety of tests. + * + * strategy is one of KIN_NONE or KIN_LINESEARCH + * sflag is one of KIN_SUCCESS, STEP_TOO_SMALL + */ + +static int KINStop(KINMem kin_mem, booleantype maxStepTaken, int sflag) +{ + realtype fmax, rlength, omexp; + N_Vector delta; + + /* Check for too small a step */ + + if (sflag == STEP_TOO_SMALL) { + + if ((kin_mem->kin_lsetup != NULL) && !(kin_mem->kin_jacCurrent)) { + /* If the Jacobian is out of date, update it and retry */ + kin_mem->kin_sthrsh = TWO; + return(RETRY_ITERATION); + } else { + /* Give up */ + if (kin_mem->kin_globalstrategy == KIN_NONE) return(KIN_STEP_LT_STPTOL); + else return(KIN_LINESEARCH_NONCONV); + } + + } + + /* Check tolerance on scaled function norm at the current iterate */ + + fmax = KINScFNorm(kin_mem, kin_mem->kin_fval, kin_mem->kin_fscale); + + if (kin_mem->kin_printfl > 1) + KINPrintInfo(kin_mem, PRNT_FMAX, "KINSOL", "KINStop", INFO_FMAX, fmax); + + if (fmax <= kin_mem->kin_fnormtol) return(KIN_SUCCESS); + + /* Check if the scaled distance between the last two steps is too small */ + /* NOTE: pp used as work space to store this distance */ + + delta = kin_mem->kin_pp; + N_VLinearSum(ONE, kin_mem->kin_unew, -ONE, kin_mem->kin_uu, delta); + rlength = KINScSNorm(kin_mem, delta, kin_mem->kin_unew); + + if (rlength <= kin_mem->kin_scsteptol) { + + if ((kin_mem->kin_lsetup != NULL) && !(kin_mem->kin_jacCurrent)) { + /* If the Jacobian is out of date, update it and retry */ + kin_mem->kin_sthrsh = TWO; + return(CONTINUE_ITERATIONS); + } else { + /* give up */ + return(KIN_STEP_LT_STPTOL); + } + + } + + /* Check if the maximum number of iterations is reached */ + + if (kin_mem->kin_nni >= kin_mem->kin_mxiter) return(KIN_MAXITER_REACHED); + + /* Check for consecutive number of steps taken of size mxnewtstep + and if not maxStepTaken, then set ncscmx to 0 */ + + if (maxStepTaken) kin_mem->kin_ncscmx++; + else kin_mem->kin_ncscmx = 0; + + if (kin_mem->kin_ncscmx == 5) return(KIN_MXNEWT_5X_EXCEEDED); + + /* Proceed according to the type of linear solver used */ + + if (kin_mem->kin_inexact_ls) { + + /* We're doing inexact Newton. + Load threshold for reevaluating the Jacobian. */ + + kin_mem->kin_sthrsh = rlength; + + } else if (!(kin_mem->kin_noResMon)) { + + /* We're doing modified Newton and the user did not disable residual monitoring. + Check if it is time to monitor residual. */ + + if ((kin_mem->kin_nni - kin_mem->kin_nnilset_sub) >= kin_mem->kin_msbset_sub) { + + /* Residual monitoring needed */ + + kin_mem->kin_nnilset_sub = kin_mem->kin_nni; + + /* If indicated, estimate new OMEGA value */ + if (kin_mem->kin_eval_omega) { + omexp = SUNMAX(ZERO,((kin_mem->kin_fnorm)/(kin_mem->kin_fnormtol))-ONE); + kin_mem->kin_omega = (omexp > TWELVE)? kin_mem->kin_omega_max : SUNMIN(kin_mem->kin_omega_min * SUNRexp(omexp), kin_mem->kin_omega_max); + } + /* Check if making satisfactory progress */ + + if (kin_mem->kin_fnorm > kin_mem->kin_omega * kin_mem->kin_fnorm_sub) { + /* Insufficient progress */ + if ((kin_mem->kin_lsetup != NULL) && !(kin_mem->kin_jacCurrent)) { + /* If the Jacobian is out of date, update it and retry */ + kin_mem->kin_sthrsh = TWO; + return(CONTINUE_ITERATIONS); + } else { + /* Otherwise, we cannot do anything, so just return. */ + } + } else { + /* Sufficient progress */ + kin_mem->kin_fnorm_sub = kin_mem->kin_fnorm; + kin_mem->kin_sthrsh = ONE; + } + + } else { + + /* Residual monitoring not needed */ + + /* Reset sthrsh */ + if (kin_mem->kin_retry_nni || kin_mem->kin_update_fnorm_sub) kin_mem->kin_fnorm_sub = kin_mem->kin_fnorm; + if (kin_mem->kin_update_fnorm_sub) kin_mem->kin_update_fnorm_sub = SUNFALSE; + kin_mem->kin_sthrsh = ONE; + + } + + } + + /* if made it to here, then the iteration process is not finished + so return CONTINUE_ITERATIONS flag */ + + return(CONTINUE_ITERATIONS); +} + +/* + * KINForcingTerm + * + * This routine computes eta, the scaling factor in the linear + * convergence stopping tolerance eps when choice #1 or choice #2 + * forcing terms are used. Eta is computed here for all but the + * first iterative step, which is set to the default in routine + * KINSolInit. + * + * This routine was written by Homer Walker of Utah State + * University with subsequent modifications by Allan Taylor @ LLNL. + * + * It is based on the concepts of the paper 'Choosing the forcing + * terms in an inexact Newton method', SIAM J Sci Comput, 17 + * (1996), pp 16 - 32, or Utah State University Research Report + * 6/94/75 of the same title. + */ + +static void KINForcingTerm(KINMem kin_mem, realtype fnormp) +{ + realtype eta_max, eta_min, eta_safe, linmodel_norm; + + eta_max = POINT9; + eta_min = POINT0001; + eta_safe = HALF; + + /* choice #1 forcing term */ + + if (kin_mem->kin_etaflag == KIN_ETACHOICE1) { + + /* compute the norm of f + Jp , scaled L2 norm */ + + linmodel_norm = SUNRsqrt((kin_mem->kin_fnorm * kin_mem->kin_fnorm) + + (TWO * kin_mem->kin_sFdotJp) + + (kin_mem->kin_sJpnorm * kin_mem->kin_sJpnorm)); + + /* form the safeguarded for choice #1 */ + + eta_safe = SUNRpowerR(kin_mem->kin_eta, kin_mem->kin_eta_alpha); + kin_mem->kin_eta = SUNRabs(fnormp - linmodel_norm) / kin_mem->kin_fnorm; + } + + /* choice #2 forcing term */ + + if (kin_mem->kin_etaflag == KIN_ETACHOICE2) { + eta_safe = kin_mem->kin_eta_gamma * + SUNRpowerR(kin_mem->kin_eta, kin_mem->kin_eta_alpha); + + kin_mem->kin_eta = kin_mem->kin_eta_gamma * + SUNRpowerR((fnormp / kin_mem->kin_fnorm), kin_mem->kin_eta_alpha); + } + + /* apply safeguards */ + + if(eta_safe < POINT1) eta_safe = ZERO; + kin_mem->kin_eta = SUNMAX(kin_mem->kin_eta, eta_safe); + kin_mem->kin_eta = SUNMAX(kin_mem->kin_eta, eta_min); + kin_mem->kin_eta = SUNMIN(kin_mem->kin_eta, eta_max); + + return; +} + + +/* + * ----------------------------------------------------------------- + * Norm functions + * ----------------------------------------------------------------- + */ + +/* + * Function : KINScFNorm + * + * This routine computes the max norm for scaled vectors. The + * scaling vector is scale, and the vector of which the norm is to + * be determined is vv. The returned value, fnormval, is the + * resulting scaled vector norm. This routine uses N_Vector + * functions from the vector module. + */ + +static realtype KINScFNorm(KINMem kin_mem, N_Vector v, N_Vector scale) +{ + N_VProd(scale, v, kin_mem->kin_vtemp1); + return(N_VMaxNorm(kin_mem->kin_vtemp1)); +} + +/* + * Function : KINScSNorm + * + * This routine computes the max norm of the scaled steplength, ss. + * Here ucur is the current step and usc is the u scale factor. + */ + +static realtype KINScSNorm(KINMem kin_mem, N_Vector v, N_Vector u) +{ + realtype length; + + N_VInv(kin_mem->kin_uscale, kin_mem->kin_vtemp1); + N_VAbs(u, kin_mem->kin_vtemp2); + N_VLinearSum(ONE, kin_mem->kin_vtemp1, ONE, kin_mem->kin_vtemp2, kin_mem->kin_vtemp1); + N_VDiv(v, kin_mem->kin_vtemp1, kin_mem->kin_vtemp1); + + length = N_VMaxNorm(kin_mem->kin_vtemp1); + + return(length); +} + +/* + * ================================================================= + * KINSOL Verbose output functions + * ================================================================= + */ + +/* + * KINPrintInfo + * + * KINPrintInfo is a high level error handling function + * Based on the value info_code, it composes the info message and + * passes it to the info handler function. + */ + +void KINPrintInfo(KINMem kin_mem, + int info_code, const char *module, const char *fname, + const char *msgfmt, ...) +{ + va_list ap; + char msg[256], msg1[40]; + char retstr[30]; + int ret; + + /* Initialize argument processing + (msgfrmt is the last required argument) */ + + va_start(ap, msgfmt); + + if (info_code == PRNT_RETVAL) { + + /* If info_code = PRNT_RETVAL, decode the numeric value */ + + ret = va_arg(ap, int); + + switch(ret) { + case KIN_SUCCESS: + sprintf(retstr, "KIN_SUCCESS"); + break; + case KIN_SYSFUNC_FAIL: + sprintf(retstr, "KIN_SYSFUNC_FAIL"); + break; + case KIN_REPTD_SYSFUNC_ERR: + sprintf(retstr, "KIN_REPTD_SYSFUNC_ERR"); + break; + case KIN_STEP_LT_STPTOL: + sprintf(retstr, "KIN_STEP_LT_STPTOL"); + break; + case KIN_LINESEARCH_NONCONV: + sprintf(retstr, "KIN_LINESEARCH_NONCONV"); + break; + case KIN_LINESEARCH_BCFAIL: + sprintf(retstr, "KIN_LINESEARCH_BCFAIL"); + break; + case KIN_MAXITER_REACHED: + sprintf(retstr, "KIN_MAXITER_REACHED"); + break; + case KIN_MXNEWT_5X_EXCEEDED: + sprintf(retstr, "KIN_MXNEWT_5X_EXCEEDED"); + break; + case KIN_LINSOLV_NO_RECOVERY: + sprintf(retstr, "KIN_LINSOLV_NO_RECOVERY"); + break; + case KIN_LSETUP_FAIL: + sprintf(retstr, "KIN_PRECONDSET_FAILURE"); + break; + case KIN_LSOLVE_FAIL: + sprintf(retstr, "KIN_PRECONDSOLVE_FAILURE"); + break; + } + + /* Compose the message */ + + sprintf(msg1, msgfmt, ret); + sprintf(msg,"%s (%s)",msg1,retstr); + + + } else { + + /* Compose the message */ + + vsprintf(msg, msgfmt, ap); + + } + + /* call the info message handler */ + + kin_mem->kin_ihfun(module, fname, msg, kin_mem->kin_ih_data); + + /* finalize argument processing */ + + va_end(ap); + + return; +} + + +/* + * KINInfoHandler + * + * This is the default KINSOL info handling function. + * It sends the info message to the stream pointed to by kin_infofp + */ + +void KINInfoHandler(const char *module, const char *function, + char *msg, void *data) +{ + KINMem kin_mem; + + /* data points to kin_mem here */ + + kin_mem = (KINMem) data; + +#ifndef NO_FPRINTF_OUTPUT + if (kin_mem->kin_infofp != NULL) { + fprintf(kin_mem->kin_infofp,"\n[%s] %s\n",module, function); + fprintf(kin_mem->kin_infofp," %s\n",msg); + } +#endif + +} + +/* + * ================================================================= + * KINSOL Error Handling functions + * ================================================================= + */ + +/* + * KINProcessError + * + * KINProcessError is a high level error handling function. + * - If cv_mem==NULL it prints the error message to stderr. + * - Otherwise, it sets up and calls the error handling function + * pointed to by cv_ehfun. + */ + +void KINProcessError(KINMem kin_mem, + int error_code, const char *module, const char *fname, + const char *msgfmt, ...) +{ + va_list ap; + char msg[256]; + + /* Initialize the argument pointer variable + (msgfmt is the last required argument to KINProcessError) */ + + va_start(ap, msgfmt); + + /* Compose the message */ + + vsprintf(msg, msgfmt, ap); + + if (kin_mem == NULL) { /* We write to stderr */ +#ifndef NO_FPRINTF_OUTPUT + fprintf(stderr, "\n[%s ERROR] %s\n ", module, fname); + fprintf(stderr, "%s\n\n", msg); +#endif + + } else { /* We can call ehfun */ + kin_mem->kin_ehfun(error_code, module, fname, msg, kin_mem->kin_eh_data); + } + + /* Finalize argument processing */ + va_end(ap); + + return; +} + +/* + * KINErrHandler + * + * This is the default error handling function. + * It sends the error message to the stream pointed to by kin_errfp + */ + +void KINErrHandler(int error_code, const char *module, + const char *function, char *msg, void *data) +{ + KINMem kin_mem; + char err_type[10]; + + /* data points to kin_mem here */ + + kin_mem = (KINMem) data; + + if (error_code == KIN_WARNING) + sprintf(err_type,"WARNING"); + else + sprintf(err_type,"ERROR"); + +#ifndef NO_FPRINTF_OUTPUT + if (kin_mem->kin_errfp != NULL) { + fprintf(kin_mem->kin_errfp,"\n[%s %s] %s\n",module,err_type,function); + fprintf(kin_mem->kin_errfp," %s\n\n",msg); + } +#endif + + return; +} + + +/* + * ======================================================================= + * Picard and fixed point solvers + * ======================================================================= + */ + +/* + * KINPicardAA + * + * This routine is the main driver for the Picard iteration with + * acclerated fixed point. + */ + +static int KINPicardAA(KINMem kin_mem, long int *iterp, realtype *R, + realtype *gamma, realtype *fmaxptr) +{ + int retval, ret; + long int iter; + realtype fmax, epsmin, fnormp; + N_Vector delta, gval; + + delta = kin_mem->kin_vtemp1; + gval = kin_mem->kin_gval; + ret = CONTINUE_ITERATIONS; + fmax = kin_mem->kin_fnormtol + ONE; + iter = 0; + epsmin = ZERO; + fnormp = -ONE; + + N_VConst(ZERO, gval); + + /* if eps is to be bounded from below, set the bound */ + if (kin_mem->kin_inexact_ls && !(kin_mem->kin_noMinEps)) epsmin = POINT01 * kin_mem->kin_fnormtol; + + while (ret == CONTINUE_ITERATIONS) { + + iter++; + + /* Update the forcing term for the inexact linear solves */ + if (kin_mem->kin_inexact_ls) { + kin_mem->kin_eps = (kin_mem->kin_eta + kin_mem->kin_uround) * kin_mem->kin_fnorm; + if(!(kin_mem->kin_noMinEps)) kin_mem->kin_eps = SUNMAX(epsmin, kin_mem->kin_eps); + } + + /* evaluate g = uu - L^{-1}func(uu) and return if failed. + For Picard, assume that the fval vector has been filled + with an eval of the nonlinear residual prior to this call. */ + retval = KINPicardFcnEval(kin_mem, gval, kin_mem->kin_uu, kin_mem->kin_fval); + + if (retval < 0) { + ret = KIN_SYSFUNC_FAIL; + break; + } + + if (kin_mem->kin_m_aa == 0) { + N_VScale(ONE, gval, kin_mem->kin_unew); + } + else { /* use Anderson, if desired */ + N_VScale(ONE, kin_mem->kin_uu, kin_mem->kin_unew); + AndersonAcc(kin_mem, gval, delta, kin_mem->kin_unew, kin_mem->kin_uu, iter-1, R, gamma); + } + + /* Fill the Newton residual based on the new solution iterate */ + retval = kin_mem->kin_func(kin_mem->kin_unew, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; + + if (retval < 0) { + ret = KIN_SYSFUNC_FAIL; + break; + } + + /* Evaluate function norms */ + fnormp = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); + fmax = KINScFNorm(kin_mem, kin_mem->kin_fval, kin_mem->kin_fscale); /* measure || F(x) ||_max */ + kin_mem->kin_fnorm = fmax; + *fmaxptr = fmax; + + if (kin_mem->kin_printfl > 1) + KINPrintInfo(kin_mem, PRNT_FMAX, "KINSOL", "KINPicardAA", INFO_FMAX, fmax); + + /* print the current iter, fnorm, and nfe values if printfl > 0 */ + if (kin_mem->kin_printfl > 0) + KINPrintInfo(kin_mem, PRNT_NNI, "KINSOL", "KINPicardAA", INFO_NNI, iter, kin_mem->kin_nfe, kin_mem->kin_fnorm); + + /* Check if the maximum number of iterations is reached */ + if (iter >= kin_mem->kin_mxiter) { + ret = KIN_MAXITER_REACHED; + } + if (fmax <= kin_mem->kin_fnormtol) { + ret = KIN_SUCCESS; + } + + /* Update with new iterate. */ + N_VScale(ONE, kin_mem->kin_unew, kin_mem->kin_uu); + + if (ret == CONTINUE_ITERATIONS) { + /* evaluate eta by calling the forcing term routine */ + if (kin_mem->kin_callForcingTerm) KINForcingTerm(kin_mem, fnormp); + } + + fflush(kin_mem->kin_errfp); + + } /* end of loop; return */ + + *iterp = iter; + + if (kin_mem->kin_printfl > 0) + KINPrintInfo(kin_mem, PRNT_RETVAL, "KINSOL", "KINPicardAA", INFO_RETVAL, ret); + + return(ret); +} + +/* + * KINPicardFcnEval + * + * This routine evaluates the Picard fixed point function + * using the linear solver, gval = u - L^{-1}F(u). + * The function assumes the user has defined L either through + * a user-supplied matvec if using a SPILS solver or through + * a supplied matrix if using a dense solver. This assumption is + * tested by a check on the strategy and the requisite functionality + * within the linear solve routines. + * + * This routine fills gval = uu - L^{-1}F(uu) given uu and fval = F(uu). + */ + +static int KINPicardFcnEval(KINMem kin_mem, N_Vector gval, N_Vector uval, N_Vector fval1) +{ + int retval; + + if ((kin_mem->kin_nni - kin_mem->kin_nnilset) >= kin_mem->kin_msbset) { + kin_mem->kin_sthrsh = TWO; + kin_mem->kin_update_fnorm_sub = SUNTRUE; + } + + for(;;){ + + kin_mem->kin_jacCurrent = SUNFALSE; + + if ((kin_mem->kin_sthrsh > ONEPT5) && (kin_mem->kin_lsetup != NULL)) { + retval = kin_mem->kin_lsetup(kin_mem); + kin_mem->kin_jacCurrent = SUNTRUE; + kin_mem->kin_nnilset = kin_mem->kin_nni; + kin_mem->kin_nnilset_sub = kin_mem->kin_nni; + if (retval != 0) return(KIN_LSETUP_FAIL); + } + + /* call the generic 'lsolve' routine to solve the system Lx = -fval + Note that we are using gval to hold x. */ + N_VScale(-ONE, fval1, fval1); + retval = kin_mem->kin_lsolve(kin_mem, gval, fval1, &(kin_mem->kin_sJpnorm), + &(kin_mem->kin_sFdotJp)); + + if (retval == 0) { + /* Update gval = uval + gval since gval = -L^{-1}F(uu) */ + N_VLinearSum(ONE, uval, ONE, gval, gval); + return(KIN_SUCCESS); + } + else if (retval < 0) return(KIN_LSOLVE_FAIL); + else if ((kin_mem->kin_lsetup == NULL) || (kin_mem->kin_jacCurrent)) return(KIN_LINSOLV_NO_RECOVERY); + + /* loop back only if the linear solver setup is in use + and matrix information is not current */ + + kin_mem->kin_sthrsh = TWO; + } + +} + + +/* + * KINFP + * + * This routine is the main driver for the fixed point iteration with + * Anderson Acceleration. + */ + +static int KINFP(KINMem kin_mem) +{ + int retval; /* return value from user func */ + int ret; /* iteration status */ + realtype fmax; /* max norm of residual func */ + N_Vector delta; /* temporary workspace vector */ + + delta = kin_mem->kin_vtemp1; + ret = CONTINUE_ITERATIONS; + fmax = kin_mem->kin_fnormtol + ONE; + + /* initialize iteration count */ + kin_mem->kin_nni = 0; + + while (ret == CONTINUE_ITERATIONS) { + + /* update iteration count */ + kin_mem->kin_nni++; + + /* evaluate func(uu) and return if failed */ + retval = kin_mem->kin_func(kin_mem->kin_uu, kin_mem->kin_fval, + kin_mem->kin_user_data); + kin_mem->kin_nfe++; + + if (retval < 0) { + ret = KIN_SYSFUNC_FAIL; + break; + } + + /* compute new solution */ + if (kin_mem->kin_m_aa == 0) { + /* standard fixed point */ + N_VScale(ONE, kin_mem->kin_fval, kin_mem->kin_unew); + } else { + /* apply Anderson acceleration */ + AndersonAcc(kin_mem, kin_mem->kin_fval, delta, kin_mem->kin_unew, + kin_mem->kin_uu, kin_mem->kin_nni - 1, kin_mem->kin_R_aa, + kin_mem->kin_gamma_aa); + } + + /* compute change between iterations */ + N_VLinearSum(ONE, kin_mem->kin_unew, -ONE, kin_mem->kin_uu, delta); + + fmax = KINScFNorm(kin_mem, delta, kin_mem->kin_fscale); /* measure || g(x)-x || */ + + if (kin_mem->kin_printfl > 1) + KINPrintInfo(kin_mem, PRNT_FMAX, "KINSOL", "KINFP", INFO_FMAX, fmax); + + kin_mem->kin_fnorm = fmax; + + /* print the current iter, fnorm, and nfe values if printfl > 0 */ + if (kin_mem->kin_printfl > 0) + KINPrintInfo(kin_mem, PRNT_NNI, "KINSOL", "KINFP", INFO_NNI, + kin_mem->kin_nni, kin_mem->kin_nfe, kin_mem->kin_fnorm); + + /* Check if the maximum number of iterations is reached */ + if (kin_mem->kin_nni >= kin_mem->kin_mxiter) { + ret = KIN_MAXITER_REACHED; + } + if (fmax <= kin_mem->kin_fnormtol) { + ret = KIN_SUCCESS; + } + + if (ret == CONTINUE_ITERATIONS) { + /* Only update solution if taking a next iteration. */ + /* CSW Should put in a conditional to send back the newest iterate or + the one consistent with the fval */ + N_VScale(ONE, kin_mem->kin_unew, kin_mem->kin_uu); + } + + fflush(kin_mem->kin_errfp); + + } /* end of loop; return */ + + if (kin_mem->kin_printfl > 0) + KINPrintInfo(kin_mem, PRNT_RETVAL, "KINSOL", "KINFP", INFO_RETVAL, ret); + + return(ret); +} + + +/* ----------------------------------------------------------------- + * Stopping tests + * ----------------------------------------------------------------- + */ + + +/* + * ======================================================================== + * Anderson Acceleration + * ======================================================================== + */ + +static int AndersonAcc(KINMem kin_mem, N_Vector gval, N_Vector fv, + N_Vector x, N_Vector xold, + long int iter, realtype *R, realtype *gamma) +{ + int retval; + long int i_pt, i, j, lAA; + long int *ipt_map; + realtype alfa; + realtype onembeta; + realtype a, b, temp, c, s; + + /* local shortcuts for fused vector operation */ + int nvec=0; + realtype* cv=kin_mem->kin_cv; + N_Vector* Xv=kin_mem->kin_Xv; + + ipt_map = kin_mem->kin_ipt_map; + i_pt = iter-1 - ((iter-1) / kin_mem->kin_m_aa) * kin_mem->kin_m_aa; + N_VLinearSum(ONE, gval, -ONE, xold, fv); + if (iter > 0) { + /* compute dg_new = gval - gval_old */ + N_VLinearSum(ONE, gval, -ONE, kin_mem->kin_gold_aa, kin_mem->kin_dg_aa[i_pt]); + /* compute df_new = fval - fval_old */ + N_VLinearSum(ONE, fv, -ONE, kin_mem->kin_fold_aa, kin_mem->kin_df_aa[i_pt]); + } + + N_VScale(ONE, gval, kin_mem->kin_gold_aa); + N_VScale(ONE, fv, kin_mem->kin_fold_aa); + + /* on first iteration, just do basic fixed-point update */ + if (iter == 0) { + N_VScale(ONE, gval, x); + return(0); + } + + /* update data structures based on current iteration index */ + + if (iter == 1) { + + /* second iteration */ + R[0] = SUNRsqrt(N_VDotProd(kin_mem->kin_df_aa[i_pt], kin_mem->kin_df_aa[i_pt])); + alfa = ONE/R[0]; + N_VScale(alfa, kin_mem->kin_df_aa[i_pt], kin_mem->kin_q_aa[i_pt]); + ipt_map[0] = 0; + + } else if (iter <= kin_mem->kin_m_aa) { + + /* another iteration before we've reached maa */ + N_VScale(ONE, kin_mem->kin_df_aa[i_pt], kin_mem->kin_vtemp2); + for (j=0; j < (iter-1); j++) { + ipt_map[j] = j; + R[(iter-1)*kin_mem->kin_m_aa+j] = N_VDotProd(kin_mem->kin_q_aa[j], kin_mem->kin_vtemp2); + N_VLinearSum(ONE,kin_mem->kin_vtemp2, -R[(iter-1)*kin_mem->kin_m_aa+j], kin_mem->kin_q_aa[j], kin_mem->kin_vtemp2); + } + R[(iter-1)*kin_mem->kin_m_aa+iter-1] = SUNRsqrt(N_VDotProd(kin_mem->kin_vtemp2, kin_mem->kin_vtemp2)); + N_VScale((1/R[(iter-1)*kin_mem->kin_m_aa+iter-1]), kin_mem->kin_vtemp2, kin_mem->kin_q_aa[i_pt]); + ipt_map[iter-1] = iter-1; + + } else { + + /* we've filled the acceleration subspace, so start recycling */ + + /* Delete left-most column vector from QR factorization */ + for (i=0; i < kin_mem->kin_m_aa-1; i++) { + a = R[(i+1)*kin_mem->kin_m_aa + i]; + b = R[(i+1)*kin_mem->kin_m_aa + i+1]; + temp = SUNRsqrt(a*a + b*b); + c = a / temp; + s = b / temp; + R[(i+1)*kin_mem->kin_m_aa + i] = temp; + R[(i+1)*kin_mem->kin_m_aa + i+1] = ZERO; + /* OK to re-use temp */ + if (i < kin_mem->kin_m_aa-1) { + for (j = i+2; j < kin_mem->kin_m_aa; j++) { + a = R[j*kin_mem->kin_m_aa + i]; + b = R[j*kin_mem->kin_m_aa + i+1]; + temp = c * a + s * b; + R[j*kin_mem->kin_m_aa + i+1] = -s*a + c*b; + R[j*kin_mem->kin_m_aa + i] = temp; + } + } + N_VLinearSum(c, kin_mem->kin_q_aa[i], s, kin_mem->kin_q_aa[i+1], kin_mem->kin_vtemp2); + N_VLinearSum(-s, kin_mem->kin_q_aa[i], c, kin_mem->kin_q_aa[i+1], kin_mem->kin_q_aa[i+1]); + N_VScale(ONE, kin_mem->kin_vtemp2, kin_mem->kin_q_aa[i]); + } + + /* Shift R to the left by one. */ + for (i = 1; i < kin_mem->kin_m_aa; i++) { + for (j = 0; j < kin_mem->kin_m_aa-1; j++) { + R[(i-1)*kin_mem->kin_m_aa + j] = R[i*kin_mem->kin_m_aa + j]; + } + } + + /* Add the new df vector */ + N_VScale(ONE, kin_mem->kin_df_aa[i_pt], kin_mem->kin_vtemp2); + for (j=0; j < (kin_mem->kin_m_aa-1); j++) { + R[(kin_mem->kin_m_aa-1)*kin_mem->kin_m_aa+j] = N_VDotProd(kin_mem->kin_q_aa[j], kin_mem->kin_vtemp2); + N_VLinearSum(ONE, kin_mem->kin_vtemp2, -R[(kin_mem->kin_m_aa-1)*kin_mem->kin_m_aa+j], kin_mem->kin_q_aa[j],kin_mem->kin_vtemp2); + } + R[(kin_mem->kin_m_aa-1)*kin_mem->kin_m_aa+kin_mem->kin_m_aa-1] = SUNRsqrt(N_VDotProd(kin_mem->kin_vtemp2, kin_mem->kin_vtemp2)); + N_VScale((1/R[(kin_mem->kin_m_aa-1)*kin_mem->kin_m_aa+kin_mem->kin_m_aa-1]), kin_mem->kin_vtemp2, kin_mem->kin_q_aa[kin_mem->kin_m_aa-1]); + + /* Update the iteration map */ + j = 0; + for (i=i_pt+1; i < kin_mem->kin_m_aa; i++) + ipt_map[j++] = i; + for (i=0; i < (i_pt+1); i++) + ipt_map[j++] = i; + } + + /* Solve least squares problem and update solution */ + lAA = iter; + if (kin_mem->kin_m_aa < iter) lAA = kin_mem->kin_m_aa; + + retval = N_VDotProdMulti((int) lAA, fv, kin_mem->kin_q_aa, gamma); + if (retval != KIN_SUCCESS) return(KIN_VECTOROP_ERR); + + /* set arrays for fused vector operation */ + cv[0] = ONE; + Xv[0] = gval; + nvec = 1; + + for (i=lAA-1; i > -1; i--) { + for (j=i+1; j < lAA; j++) { + gamma[i] = gamma[i]-R[j*kin_mem->kin_m_aa+i]*gamma[j]; + } + gamma[i] = gamma[i]/R[i*kin_mem->kin_m_aa+i]; + + cv[nvec] = -gamma[i]; + Xv[nvec] = kin_mem->kin_dg_aa[ipt_map[i]]; + nvec += 1; + } + + /* if enabled, apply damping */ + if (kin_mem->kin_damping_aa) { + onembeta = (ONE - kin_mem->kin_beta_aa); + cv[nvec] = -onembeta; + Xv[nvec] = fv; + nvec += 1; + for (i = lAA - 1; i > -1; i--) { + cv[nvec] = onembeta * gamma[i]; + Xv[nvec] = kin_mem->kin_df_aa[ipt_map[i]]; + nvec += 1; + } + } + + /* update solution */ + retval = N_VLinearCombination(nvec, cv, Xv, x); + if (retval != KIN_SUCCESS) return(KIN_VECTOROP_ERR); + + return 0; +} diff --git a/bazaar/plugin/sundials/src/kinsol/kinsol_bbdpre.c b/bazaar/plugin/sundials/src/kinsol/kinsol_bbdpre.c new file mode 100644 index 000000000..a4683904c --- /dev/null +++ b/bazaar/plugin/sundials/src/kinsol/kinsol_bbdpre.c @@ -0,0 +1,582 @@ +/* ----------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * Allan Taylor, Alan Hindmarsh, Radu Serban, and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file contains implementations of routines for a + * band-block-diagonal preconditioner, i.e. a block-diagonal + * matrix with banded blocks, for use with KINSol and the + * KINLS linear solver interface. + * + * Note: With only one process, a banded matrix results + * rather than a b-b-d matrix with banded blocks. Diagonal + * blocking occurs at the process level. + * -----------------------------------------------------------------*/ + +#include +#include + +#include "kinsol_impl.h" +#include "kinsol_ls_impl.h" +#include "kinsol_bbdpre_impl.h" + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* Prototypes of functions KINBBDPrecSetup and KINBBDPrecSolve */ +static int KINBBDPrecSetup(N_Vector uu, N_Vector uscale, + N_Vector fval, N_Vector fscale, + void *pdata); + +static int KINBBDPrecSolve(N_Vector uu, N_Vector uscale, + N_Vector fval, N_Vector fscale, + N_Vector vv, void *pdata); + +/* Prototype for KINBBDPrecFree */ +static int KINBBDPrecFree(KINMem kin_mem); + +/* Prototype for difference quotient jacobian calculation routine */ +static int KBBDDQJac(KBBDPrecData pdata, + N_Vector uu, N_Vector uscale, + N_Vector gu, N_Vector gtemp, N_Vector utemp); + +/*------------------------------------------------------------------ + user-callable functions + ------------------------------------------------------------------*/ + +/*------------------------------------------------------------------ + KINBBDPrecInit + ------------------------------------------------------------------*/ +int KINBBDPrecInit(void *kinmem, sunindextype Nlocal, + sunindextype mudq, sunindextype mldq, + sunindextype mukeep, sunindextype mlkeep, + realtype dq_rel_uu, + KINBBDLocalFn gloc, KINBBDCommFn gcomm) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + KBBDPrecData pdata; + sunindextype muk, mlk, storage_mu, lrw1, liw1; + long int lrw, liw; + int flag; + + if (kinmem == NULL) { + KINProcessError(NULL, KINLS_MEM_NULL, "KINBBDPRE", + "KINBBDPrecInit", MSGBBD_MEM_NULL); + return(KINLS_MEM_NULL); + } + kin_mem = (KINMem) kinmem; + + /* Test if the LS linear solver interface has been created */ + if (kin_mem->kin_lmem == NULL) { + KINProcessError(kin_mem, KINLS_LMEM_NULL, "KINBBDPRE", + "KINBBDPrecInit", MSGBBD_LMEM_NULL); + return(KINLS_LMEM_NULL); + } + kinls_mem = (KINLsMem) kin_mem->kin_lmem; + + /* Test compatibility of NVECTOR package with the BBD preconditioner */ + /* Note: Do NOT need to check for N_VScale since has already been checked for in KINSOL */ + if (kin_mem->kin_vtemp1->ops->nvgetarraypointer == NULL) { + KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINBBDPRE", + "KINBBDPrecInit", MSGBBD_BAD_NVECTOR); + return(KINLS_ILL_INPUT); + } + + /* Allocate data memory */ + pdata = NULL; + pdata = (KBBDPrecData) malloc(sizeof *pdata); + if (pdata == NULL) { + KINProcessError(kin_mem, KINLS_MEM_FAIL, + "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL); + return(KINLS_MEM_FAIL); + } + + /* Set pointers to gloc and gcomm; load half-bandwidths */ + pdata->kin_mem = kinmem; + pdata->gloc = gloc; + pdata->gcomm = gcomm; + pdata->mudq = SUNMIN(Nlocal-1, SUNMAX(0, mudq)); + pdata->mldq = SUNMIN(Nlocal-1, SUNMAX(0, mldq)); + muk = SUNMIN(Nlocal-1, SUNMAX(0, mukeep)); + mlk = SUNMIN(Nlocal-1, SUNMAX(0, mlkeep)); + pdata->mukeep = muk; + pdata->mlkeep = mlk; + + /* Set extended upper half-bandwidth for PP (required for pivoting) */ + storage_mu = SUNMIN(Nlocal-1, muk+mlk); + + /* Allocate memory for preconditioner matrix */ + pdata->PP = NULL; + pdata->PP = SUNBandMatrixStorage(Nlocal, muk, mlk, storage_mu); + if (pdata->PP == NULL) { + free(pdata); pdata = NULL; + KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINBBDPRE", + "KINBBDPrecInit", MSGBBD_MEM_FAIL); + return(KINLS_MEM_FAIL); + } + + /* Allocate memory for temporary N_Vectors */ + pdata->zlocal = NULL; + pdata->zlocal = N_VNew_Serial(Nlocal); + if (pdata->zlocal == NULL) { + SUNMatDestroy(pdata->PP); + free(pdata); pdata = NULL; + KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINBBDPRE", + "KINBBDPrecInit", MSGBBD_MEM_FAIL); + return(KINLS_MEM_FAIL); + } + + pdata->rlocal = NULL; + pdata->rlocal = N_VNewEmpty_Serial(Nlocal); /* empty vector */ + if (pdata->rlocal == NULL) { + N_VDestroy(pdata->zlocal); + SUNMatDestroy(pdata->PP); + free(pdata); pdata = NULL; + KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINBBDPRE", + "KINBBDPrecInit", MSGBBD_MEM_FAIL); + return(KINLS_MEM_FAIL); + } + + pdata->tempv1 = NULL; + pdata->tempv1 = N_VClone(kin_mem->kin_vtemp1); + if (pdata->tempv1 == NULL) { + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->rlocal); + SUNMatDestroy(pdata->PP); + free(pdata); pdata = NULL; + KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINBBDPRE", + "KINBBDPrecInit", MSGBBD_MEM_FAIL); + return(KINLS_MEM_FAIL); + } + + pdata->tempv2 = NULL; + pdata->tempv2 = N_VClone(kin_mem->kin_vtemp1); + if (pdata->tempv2 == NULL) { + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->rlocal); + N_VDestroy(pdata->tempv1); + SUNMatDestroy(pdata->PP); + free(pdata); pdata = NULL; + KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINBBDPRE", + "KINBBDPrecInit", MSGBBD_MEM_FAIL); + return(KINLS_MEM_FAIL); + } + + pdata->tempv3 = NULL; + pdata->tempv3 = N_VClone(kin_mem->kin_vtemp1); + if (pdata->tempv3 == NULL) { + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->rlocal); + N_VDestroy(pdata->tempv1); + N_VDestroy(pdata->tempv2); + SUNMatDestroy(pdata->PP); + free(pdata); pdata = NULL; + KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINBBDPRE", + "KINBBDPrecInit", MSGBBD_MEM_FAIL); + return(KINLS_MEM_FAIL); + } + + /* Allocate memory for banded linear solver */ + pdata->LS = NULL; + pdata->LS = SUNLinSol_Band(pdata->zlocal, pdata->PP); + if (pdata->LS == NULL) { + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->rlocal); + N_VDestroy(pdata->tempv1); + N_VDestroy(pdata->tempv2); + N_VDestroy(pdata->tempv3); + SUNMatDestroy(pdata->PP); + free(pdata); pdata = NULL; + KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINBBDPRE", + "KINBBDPrecInit", MSGBBD_MEM_FAIL); + return(KINLS_MEM_FAIL); + } + + /* initialize band linear solver object */ + flag = SUNLinSolInitialize(pdata->LS); + if (flag != SUNLS_SUCCESS) { + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->rlocal); + N_VDestroy(pdata->tempv1); + N_VDestroy(pdata->tempv2); + N_VDestroy(pdata->tempv3); + SUNMatDestroy(pdata->PP); + SUNLinSolFree(pdata->LS); + free(pdata); pdata = NULL; + KINProcessError(kin_mem, KINLS_SUNLS_FAIL, "KINBBDPRE", + "KINBBDPrecInit", MSGBBD_SUNLS_FAIL); + return(KINLS_SUNLS_FAIL); + } + + /* Set rel_uu based on input value dq_rel_uu (0 implies default) */ + pdata->rel_uu = (dq_rel_uu > ZERO) ? dq_rel_uu : SUNRsqrt(kin_mem->kin_uround); + + /* Store Nlocal to be used in KINBBDPrecSetup */ + pdata->n_local = Nlocal; + + /* Set work space sizes and initialize nge */ + pdata->rpwsize = 0; + pdata->ipwsize = 0; + if (kin_mem->kin_vtemp1->ops->nvspace) { + N_VSpace(kin_mem->kin_vtemp1, &lrw1, &liw1); + pdata->rpwsize += 3*lrw1; + pdata->ipwsize += 3*liw1; + } + if (pdata->zlocal->ops->nvspace) { + N_VSpace(pdata->zlocal, &lrw1, &liw1); + pdata->rpwsize += lrw1; + pdata->ipwsize += liw1; + } + if (pdata->rlocal->ops->nvspace) { + N_VSpace(pdata->rlocal, &lrw1, &liw1); + pdata->rpwsize += lrw1; + pdata->ipwsize += liw1; + } + if (pdata->PP->ops->space) { + flag = SUNMatSpace(pdata->PP, &lrw, &liw); + pdata->rpwsize += lrw; + pdata->ipwsize += liw; + } + if (pdata->LS->ops->space) { + flag = SUNLinSolSpace(pdata->LS, &lrw, &liw); + pdata->rpwsize += lrw; + pdata->ipwsize += liw; + } + pdata->nge = 0; + + /* make sure pdata is free from any previous allocations */ + if (kinls_mem->pfree != NULL) + kinls_mem->pfree(kin_mem); + + /* Point to the new pdata field in the LS memory */ + kinls_mem->pdata = pdata; + + /* Attach the pfree function */ + kinls_mem->pfree = KINBBDPrecFree; + + /* Attach preconditioner solve and setup functions */ + flag = KINSetPreconditioner(kinmem, KINBBDPrecSetup, + KINBBDPrecSolve); + + return(flag); +} + + +/*------------------------------------------------------------------ + KINBBDPrecGetWorkSpace + ------------------------------------------------------------------*/ +int KINBBDPrecGetWorkSpace(void *kinmem, + long int *lenrwBBDP, + long int *leniwBBDP) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + KBBDPrecData pdata; + + if (kinmem == NULL) { + KINProcessError(NULL, KINLS_MEM_NULL, "KINBBDPRE", + "KINBBDPrecGetWorkSpace", MSGBBD_MEM_NULL); + return(KINLS_MEM_NULL); + } + kin_mem = (KINMem) kinmem; + + if (kin_mem->kin_lmem == NULL) { + KINProcessError(kin_mem, KINLS_LMEM_NULL, "KINBBDPRE", + "KINBBDPrecGetWorkSpace", MSGBBD_LMEM_NULL); + return(KINLS_LMEM_NULL); + } + kinls_mem = (KINLsMem) kin_mem->kin_lmem; + + if (kinls_mem->pdata == NULL) { + KINProcessError(kin_mem, KINLS_PMEM_NULL, "KINBBDPRE", + "KINBBDPrecGetWorkSpace", MSGBBD_PMEM_NULL); + return(KINLS_PMEM_NULL); + } + pdata = (KBBDPrecData) kinls_mem->pdata; + + *lenrwBBDP = pdata->rpwsize; + *leniwBBDP = pdata->ipwsize; + + return(KINLS_SUCCESS); +} + +/*------------------------------------------------------------------ + KINBBDPrecGetNumGfnEvals + -------------------------------------------------------------------*/ +int KINBBDPrecGetNumGfnEvals(void *kinmem, + long int *ngevalsBBDP) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + KBBDPrecData pdata; + + if (kinmem == NULL) { + KINProcessError(NULL, KINLS_MEM_NULL, "KINBBDPRE", + "KINBBDPrecGetNumGfnEvals", MSGBBD_MEM_NULL); + return(KINLS_MEM_NULL); + } + kin_mem = (KINMem) kinmem; + + if (kin_mem->kin_lmem == NULL) { + KINProcessError(kin_mem, KINLS_LMEM_NULL, "KINBBDPRE", + "KINBBDPrecGetNumGfnEvals", MSGBBD_LMEM_NULL); + return(KINLS_LMEM_NULL); + } + kinls_mem = (KINLsMem) kin_mem->kin_lmem; + + if (kinls_mem->pdata == NULL) { + KINProcessError(kin_mem, KINLS_PMEM_NULL, "KINBBDPRE", + "KINBBDPrecGetNumGfnEvals", MSGBBD_PMEM_NULL); + return(KINLS_PMEM_NULL); + } + pdata = (KBBDPrecData) kinls_mem->pdata; + + *ngevalsBBDP = pdata->nge; + + return(KINLS_SUCCESS); +} + + +/*------------------------------------------------------------------ + KINBBDPrecSetup + + KINBBDPrecSetup generates and factors a banded block of the + preconditioner matrix on each processor, via calls to the + user-supplied gloc and gcomm functions. It uses difference + quotient approximations to the Jacobian elements. + + KINBBDPrecSetup calculates a new Jacobian, stored in banded + matrix PP and does an LU factorization of P in place in PP. + + The parameters of KINBBDPrecSetup are as follows: + + uu is the current value of the dependent variable vector, + namely the solutin to func(uu)=0 + + uscale is the dependent variable scaling vector (i.e. uu) + + fval is the vector f(u) + + fscale is the function scaling vector + + bbd_data is the pointer to BBD data set by KINBBDInit. + + Note: The value to be returned by the KINBBDPrecSetup function + is a flag indicating whether it was successful. This value is: + 0 if successful, + > 0 for a recoverable error - step will be retried. + ------------------------------------------------------------------*/ +static int KINBBDPrecSetup(N_Vector uu, N_Vector uscale, + N_Vector fval, N_Vector fscale, + void *bbd_data) +{ + KBBDPrecData pdata; + KINMem kin_mem; + int retval; + + pdata = (KBBDPrecData) bbd_data; + + kin_mem = (KINMem) pdata->kin_mem; + + /* Call KBBDDQJac for a new Jacobian calculation and store in PP */ + retval = SUNMatZero(pdata->PP); + if (retval != 0) { + KINProcessError(kin_mem, -1, "KINBBDPRE", "KINBBDPrecSetup", + MSGBBD_SUNMAT_FAIL); + return(-1); + } + + retval = KBBDDQJac(pdata, uu, uscale, + pdata->tempv1, pdata->tempv2, pdata->tempv3); + if (retval != 0) { + KINProcessError(kin_mem, -1, "KINBBDPRE", "KINBBDPrecSetup", + MSGBBD_FUNC_FAILED); + return(-1); + } + + /* Do LU factorization of P and return error flag */ + retval = SUNLinSolSetup_Band(pdata->LS, pdata->PP); + return(retval); +} + +/*------------------------------------------------------------------ + INBBDPrecSolve + + KINBBDPrecSolve solves a linear system P z = r, with the + banded blocked preconditioner matrix P generated and factored + by KINBBDPrecSetup. Here, r comes in as vv and z is + returned in vv as well. + + The parameters for KINBBDPrecSolve are as follows: + + uu an N_Vector giving the current iterate for the system + + uscale an N_Vector giving the diagonal entries of the + uu scaling matrix + + fval an N_Vector giving the current function value + + fscale an N_Vector giving the diagonal entries of the + function scaling matrix + + vv vector initially set to the right-hand side vector r, but + which upon return contains a solution of the linear system + P*z = r + + bbd_data is the pointer to BBD data set by KINBBDInit. + + Note: The value returned by the KINBBDPrecSolve function is a + flag returned from the lienar solver object. + ------------------------------------------------------------------*/ + +static int KINBBDPrecSolve(N_Vector uu, N_Vector uscale, + N_Vector fval, N_Vector fscale, + N_Vector vv, void *bbd_data) +{ + KBBDPrecData pdata; + realtype *vd; + realtype *zd; + int i, retval; + + pdata = (KBBDPrecData) bbd_data; + + /* Get data pointers */ + vd = N_VGetArrayPointer(vv); + zd = N_VGetArrayPointer(pdata->zlocal); + + /* Attach local data array for vv to rlocal */ + N_VSetArrayPointer(vd, pdata->rlocal); + + /* Call banded solver object to do the work */ + retval = SUNLinSolSolve(pdata->LS, pdata->PP, pdata->zlocal, + pdata->rlocal, ZERO); + + /* Copy result into vv */ + for (i=0; in_local; i++) + vd[i] = zd[i]; + + return(retval); +} + + +/*------------------------------------------------------------------ + KINBBDPrecFree + ------------------------------------------------------------------*/ +static int KINBBDPrecFree(KINMem kin_mem) +{ + KINLsMem kinls_mem; + KBBDPrecData pdata; + + if (kin_mem->kin_lmem == NULL) return(0); + kinls_mem = (KINLsMem) kin_mem->kin_lmem; + + if (kinls_mem->pdata == NULL) return(0); + pdata = (KBBDPrecData) kinls_mem->pdata; + + SUNLinSolFree(pdata->LS); + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->rlocal); + N_VDestroy(pdata->tempv1); + N_VDestroy(pdata->tempv2); + N_VDestroy(pdata->tempv3); + SUNMatDestroy(pdata->PP); + + free(pdata); + pdata = NULL; + + return(0); +} + + +/*------------------------------------------------------------------ + KBBDDQJac + + This routine generates a banded difference quotient + approximation to the Jacobian of f(u). It assumes that a band + matrix of type SUNMatrix 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 gloc. By virtue of the band structure, the number of + these calls is bandwidth + 1, where bandwidth = ml + mu + 1. + This routine also assumes that the local elements of a vector + are stored contiguously. + ------------------------------------------------------------------*/ +static int KBBDDQJac(KBBDPrecData pdata, + N_Vector uu, N_Vector uscale, + N_Vector gu, N_Vector gtemp, N_Vector utemp) +{ + KINMem kin_mem; + realtype inc, inc_inv; + int retval; + sunindextype group, i, j, width, ngroups, i1, i2; + realtype *udata, *uscdata, *gudata, *gtempdata, *utempdata, *col_j; + + kin_mem = (KINMem) pdata->kin_mem; + + /* load utemp with uu = predicted solution vector */ + N_VScale(ONE, uu, utemp); + + /* set pointers to the data for all vectors */ + udata = N_VGetArrayPointer(uu); + uscdata = N_VGetArrayPointer(uscale); + gudata = N_VGetArrayPointer(gu); + gtempdata = N_VGetArrayPointer(gtemp); + utempdata = N_VGetArrayPointer(utemp); + + /* Call gcomm and gloc to get base value of g(uu) */ + if (pdata->gcomm != NULL) { + retval = pdata->gcomm(pdata->n_local, uu, kin_mem->kin_user_data); + if (retval != 0) return(retval); + } + + retval = pdata->gloc(pdata->n_local, uu, gu, kin_mem->kin_user_data); + pdata->nge++; + if (retval != 0) return(retval); + + /* Set bandwidth and number of column groups for band differencing */ + width = pdata->mldq + pdata->mudq + 1; + ngroups = SUNMIN(width, pdata->n_local); + + /* Loop over groups */ + for(group = 1; group <= ngroups; group++) { + + /* increment all u_j in group */ + for(j = group - 1; j < pdata->n_local; j += width) { + inc = pdata->rel_uu * SUNMAX(SUNRabs(udata[j]), (ONE / uscdata[j])); + utempdata[j] += inc; + } + + /* Evaluate g with incremented u */ + retval = pdata->gloc(pdata->n_local, utemp, gtemp, kin_mem->kin_user_data); + pdata->nge++; + if (retval != 0) return(retval); + + /* restore utemp, then form and load difference quotients */ + for (j = group - 1; j < pdata->n_local; j += width) { + utempdata[j] = udata[j]; + col_j = SUNBandMatrix_Column(pdata->PP,j); + inc = pdata->rel_uu * SUNMAX(SUNRabs(udata[j]) , (ONE / uscdata[j])); + inc_inv = ONE / inc; + i1 = SUNMAX(0, (j - pdata->mukeep)); + i2 = SUNMIN((j + pdata->mlkeep), (pdata->n_local - 1)); + for (i = i1; i <= i2; i++) + SM_COLUMN_ELEMENT_B(col_j, i, j) = inc_inv * (gtempdata[i] - gudata[i]); + } + } + + return(0); +} diff --git a/bazaar/plugin/sundials/src/kinsol/kinsol_bbdpre_impl.h b/bazaar/plugin/sundials/src/kinsol/kinsol_bbdpre_impl.h new file mode 100644 index 000000000..95f1e5804 --- /dev/null +++ b/bazaar/plugin/sundials/src/kinsol/kinsol_bbdpre_impl.h @@ -0,0 +1,82 @@ +/* ----------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * Allan Taylor, Alan Hindmarsh, Radu Serban, and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * KINBBDPRE module header file (private version) + * -----------------------------------------------------------------*/ + +#ifndef _KINBBDPRE_IMPL_H +#define _KINBBDPRE_IMPL_H + +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/*------------------------------------------------------------------ + Definition of KBBDData + ------------------------------------------------------------------*/ + +typedef struct KBBDPrecDataRec { + + /* passed by user to KINBBDPrecAlloc, used by pset/psolve functions */ + sunindextype mudq, mldq, mukeep, mlkeep; + realtype rel_uu; /* relative error for the Jacobian DQ routine */ + KINBBDLocalFn gloc; + KINBBDCommFn gcomm; + + /* set by KINBBDPrecSetup and used by KINBBDPrecSetup and + KINBBDPrecSolve functions */ + sunindextype n_local; + SUNMatrix PP; + SUNLinearSolver LS; + N_Vector rlocal; + N_Vector zlocal; + N_Vector tempv1; + N_Vector tempv2; + N_Vector tempv3; + + /* available for optional output */ + long int rpwsize; + long int ipwsize; + long int nge; + + /* pointer to KINSol memory */ + void *kin_mem; + +} *KBBDPrecData; + +/* + *----------------------------------------------------------------- + * KINBBDPRE error messages + *----------------------------------------------------------------- + */ + +#define MSGBBD_MEM_NULL "KINSOL Memory is NULL." +#define MSGBBD_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." +#define MSGBBD_MEM_FAIL "A memory request failed." +#define MSGBBD_BAD_NVECTOR "A required vector operation is not implemented." +#define MSGBBD_SUNMAT_FAIL "An error arose from a SUNBandMatrix routine." +#define MSGBBD_SUNLS_FAIL "An error arose from a SUNBandLinearSolver routine." +#define MSGBBD_PMEM_NULL "BBD peconditioner memory is NULL. IDABBDPrecInit must be called." +#define MSGBBD_FUNC_FAILED "The gloc or gcomm routine failed in an unrecoverable manner." + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/kinsol/kinsol_direct.c b/bazaar/plugin/sundials/src/kinsol/kinsol_direct.c new file mode 100644 index 000000000..8f6bc1d5f --- /dev/null +++ b/bazaar/plugin/sundials/src/kinsol/kinsol_direct.c @@ -0,0 +1,55 @@ +/*----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * Radu Serban @ LLNL + *----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *----------------------------------------------------------------- + * Implementation file for the deprecated direct linear solver interface in + * KINSOL; these routines now just wrap the updated KINSOL generic + * linear solver interface in kinsol_ls.h. + *-----------------------------------------------------------------*/ + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/*================================================================= + Exported Functions (wrappers for equivalent routines in kinsol_ls.h) + =================================================================*/ + +int KINDlsSetLinearSolver(void *kinmem, SUNLinearSolver LS, SUNMatrix A) +{ return(KINSetLinearSolver(kinmem, LS, A)); } + +int KINDlsSetJacFn(void *kinmem, KINDlsJacFn jac) +{ return(KINSetJacFn(kinmem, jac)); } + +int KINDlsGetWorkSpace(void *kinmem, long int *lenrw, long int *leniw) +{ return(KINGetLinWorkSpace(kinmem, lenrw, leniw)); } + +int KINDlsGetNumJacEvals(void *kinmem, long int *njevals) +{ return(KINGetNumJacEvals(kinmem, njevals)); } + +int KINDlsGetNumFuncEvals(void *kinmem, long int *nfevals) +{ return(KINGetNumLinFuncEvals(kinmem, nfevals)); } + +int KINDlsGetLastFlag(void *kinmem, long int *flag) +{ return(KINGetLastLinFlag(kinmem, flag)); } + +char *KINDlsGetReturnFlagName(long int flag) +{ return(KINGetLinReturnFlagName(flag)); } + +#ifdef __cplusplus +} +#endif + diff --git a/bazaar/plugin/sundials/src/kinsol/kinsol_impl.h b/bazaar/plugin/sundials/src/kinsol/kinsol_impl.h new file mode 100644 index 000000000..bfedf0cb7 --- /dev/null +++ b/bazaar/plugin/sundials/src/kinsol/kinsol_impl.h @@ -0,0 +1,489 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * KINSOL solver module header file (private version) + * ----------------------------------------------------------------- + */ + +#ifndef _KINSOL_IMPL_H +#define _KINSOL_IMPL_H + +#include + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ================================================================= + * M A I N S O L V E R M E M O R Y B L O C K + * ================================================================= + */ + +/* KINSOL default constants */ + +#define PRINTFL_DEFAULT 0 +#define MXITER_DEFAULT 200 +#define MXNBCF_DEFAULT 10 +#define MSBSET_DEFAULT 10 +#define MSBSET_SUB_DEFAULT 5 + +#define OMEGA_MIN RCONST(0.00001) +#define OMEGA_MAX RCONST(0.9) + +/* + * ----------------------------------------------------------------- + * Types : struct KINMemRec and struct *KINMem + * ----------------------------------------------------------------- + * A variable declaration of type struct *KINMem denotes a + * pointer to a data structure of type struct KINMemRec. The + * KINMemRec structure contains numerous fields that must be + * accessible by KINSOL solver module routines. + * ----------------------------------------------------------------- + */ + +typedef struct KINMemRec { + + realtype kin_uround; /* machine epsilon (or unit roundoff error) + (defined in sundials_types.h) */ + + /* problem specification data */ + + KINSysFn kin_func; /* nonlinear system function implementation */ + void *kin_user_data; /* work space available to func routine */ + realtype kin_fnormtol; /* stopping tolerance on L2-norm of function + value */ + realtype kin_scsteptol; /* scaled step length tolerance */ + int kin_globalstrategy; /* choices are KIN_NONE, KIN_LINESEARCH + KIN_PICARD and KIN_FP */ + int kin_printfl; /* level of verbosity of output */ + long int kin_mxiter; /* maximum number of nonlinear iterations */ + long int kin_msbset; /* maximum number of nonlinear iterations that + may be performed between calls to the + linear solver setup routine (lsetup) */ + long int kin_msbset_sub; /* subinterval length for residual monitoring */ + long int kin_mxnbcf; /* maximum number of beta condition failures */ + int kin_etaflag; /* choices are KIN_ETACONSTANT, KIN_ETACHOICE1 + and KIN_ETACHOICE2 */ + booleantype kin_noMinEps; /* flag controlling whether or not the value + of eps is bounded below */ + booleantype kin_constraintsSet; /* flag indicating if constraints are being + used */ + booleantype kin_jacCurrent; /* flag indicating if the Jacobian info. + used by the linear solver is current */ + booleantype kin_callForcingTerm; /* flag set if using either KIN_ETACHOICE1 + or KIN_ETACHOICE2 */ + booleantype kin_noResMon; /* flag indicating if the nonlinear + residual monitoring scheme should be + used */ + booleantype kin_retry_nni; /* flag indicating if nonlinear iteration + should be retried (set by residual + monitoring algorithm) */ + booleantype kin_update_fnorm_sub; /* flag indicating if the fnorm associated + with the subinterval needs to be + updated (set by residual monitoring + algorithm) */ + + realtype kin_mxnewtstep; /* maximum allowable scaled step length */ + realtype kin_mxnstepin; /* input (or preset) value for mxnewtstep */ + realtype kin_sqrt_relfunc; /* relative error bound for func(u) */ + realtype kin_stepl; /* scaled length of current step */ + realtype kin_stepmul; /* step scaling factor */ + realtype kin_eps; /* current value of eps */ + realtype kin_eta; /* current value of eta */ + realtype kin_eta_gamma; /* gamma value used in eta calculation + (choice #2) */ + realtype kin_eta_alpha; /* alpha value used in eta calculation + (choice #2) */ + booleantype kin_noInitSetup; /* flag controlling whether or not the KINSol + routine makes an initial call to the + linear solver setup routine (lsetup) */ + realtype kin_sthrsh; /* threshold value for calling the linear + solver setup routine */ + + /* counters */ + + long int kin_nni; /* number of nonlinear iterations */ + long int kin_nfe; /* number of calls made to func routine */ + long int kin_nnilset; /* value of nni counter when the linear solver + setup was last called */ + long int kin_nnilset_sub; /* value of nni counter when the linear solver + setup was last called (subinterval) */ + long int kin_nbcf; /* number of times the beta-condition could not + be met in KINLineSearch */ + long int kin_nbktrk; /* number of backtracks performed by + KINLineSearch */ + long int kin_ncscmx; /* number of consecutive steps of size + mxnewtstep taken */ + + /* vectors */ + + N_Vector kin_uu; /* solution vector/current iterate (initially + contains initial guess, but holds approximate + solution upon completion if no errors occurred) */ + N_Vector kin_unew; /* next iterate (unew = uu+pp) */ + N_Vector kin_fval; /* vector containing result of nonlinear system + function evaluated at a given iterate + (fval = func(uu)) */ + N_Vector kin_gval; /* vector containing result of the fixed point + function evaluated at a given iterate; + used in KIN_PICARD strategy only. + (gval = uu - L^{-1}fval(uu)) */ + N_Vector kin_uscale; /* iterate scaling vector */ + N_Vector kin_fscale; /* fval scaling vector */ + N_Vector kin_pp; /* incremental change vector (pp = unew-uu) */ + N_Vector kin_constraints; /* constraints vector */ + N_Vector kin_vtemp1; /* scratch vector #1 */ + N_Vector kin_vtemp2; /* scratch vector #2 */ + + /* space requirements for AA, Broyden and NLEN */ + N_Vector kin_fold_aa; /* vector needed for AA, Broyden, and NLEN */ + N_Vector kin_gold_aa; /* vector needed for AA, Broyden, and NLEN */ + N_Vector *kin_df_aa; /* vector array needed for AA, Broyden, and NLEN */ + N_Vector *kin_dg_aa; /* vector array needed for AA, Broyden and NLEN */ + N_Vector *kin_q_aa; /* vector array needed for AA */ + realtype kin_beta_aa; /* beta damping parameter for AA */ + realtype *kin_gamma_aa; /* array of size maa used in AA */ + realtype *kin_R_aa; /* array of size maa*maa used in AA */ + long int *kin_ipt_map; /* array of size maa used in AA */ + long int kin_m_aa; /* parameter for AA, Broyden or NLEN */ + booleantype kin_aamem_aa; /* sets additional memory needed for Anderson Acc */ + booleantype kin_setstop_aa; /* determines whether user will set stopping criterion */ + booleantype kin_damping_aa; /* flag to apply damping in AA */ + realtype *kin_cv; /* scalar array for fused vector operations */ + N_Vector *kin_Xv; /* vector array for fused vector operations */ + + /* space requirements for vector storage */ + + sunindextype kin_lrw1; /* number of realtype-sized memory blocks needed + for a single N_Vector */ + sunindextype kin_liw1; /* number of int-sized memory blocks needed for + a single N_Vecotr */ + long int kin_lrw; /* total number of realtype-sized memory blocks + needed for all KINSOL work vectors */ + long int kin_liw; /* total number of int-sized memory blocks needed + for all KINSOL work vectors */ + + /* linear solver data */ + + /* function prototypes (pointers) */ + + int (*kin_linit)(struct KINMemRec *kin_mem); + + int (*kin_lsetup)(struct KINMemRec *kin_mem); + + int (*kin_lsolve)(struct KINMemRec *kin_mem, N_Vector xx, N_Vector bb, + realtype *sJpnorm, realtype *sFdotJp); + + int (*kin_lfree)(struct KINMemRec *kin_mem); + + booleantype kin_inexact_ls; /* flag set by the linear solver module + (in linit) indicating whether this is an + iterative linear solver (SUNTRUE), or a direct + linear solver (SUNFALSE) */ + + void *kin_lmem; /* pointer to linear solver memory block */ + + realtype kin_fnorm; /* value of L2-norm of fscale*fval */ + realtype kin_f1norm; /* f1norm = 0.5*(fnorm)^2 */ + realtype kin_sFdotJp; /* value of scaled F(u) vector (fscale*fval) + dotted with scaled J(u)*pp vector (set by lsolve) */ + realtype kin_sJpnorm; /* value of L2-norm of fscale*(J(u)*pp) + (set by lsolve) */ + + realtype kin_fnorm_sub; /* value of L2-norm of fscale*fval (subinterval) */ + booleantype kin_eval_omega; /* flag indicating that omega must be evaluated. */ + realtype kin_omega; /* constant value for real scalar used in test to + determine if reduction of norm of nonlinear + residual is sufficient. Unless a valid constant + value is specified by the user, omega is estimated + from omega_min and omega_max at each iteration. */ + realtype kin_omega_min; /* lower bound on omega */ + realtype kin_omega_max; /* upper bound on omega */ + + /* + * ----------------------------------------------------------------- + * Note: The KINLineSearch subroutine scales the values of the + * variables sFdotJp and sJpnorm by a factor rl (lambda) that is + * chosen by the line search algorithm such that the sclaed Newton + * step satisfies the following conditions: + * + * F(u_k+1) <= F(u_k) + alpha*(F(u_k)^T * J(u_k))*p*rl + * + * F(u_k+1) >= F(u_k) + beta*(F(u_k)^T * J(u_k))*p*rl + * + * where alpha = 1.0e-4, beta = 0.9, u_k+1 = u_k + rl*p, + * 0 < rl <= 1, J denotes the system Jacobian, and F represents + * the nonliner system function. + * ----------------------------------------------------------------- + */ + + booleantype kin_MallocDone; /* flag indicating if KINMalloc has been + called yet */ + + /* message files */ + /*------------------------------------------- + Error handler function and error ouput file + -------------------------------------------*/ + + KINErrHandlerFn kin_ehfun; /* Error messages are handled by ehfun */ + void *kin_eh_data; /* dats pointer passed to ehfun */ + FILE *kin_errfp; /* KINSOL error messages are sent to errfp */ + + KINInfoHandlerFn kin_ihfun; /* Info messages are handled by ihfun */ + void *kin_ih_data; /* dats pointer passed to ihfun */ + FILE *kin_infofp; /* where KINSol info messages are sent */ + +} *KINMem; + +/* + * ================================================================= + * I N T E R F A C E T O L I N E A R S O L V E R + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Function : int (*kin_linit)(KINMem kin_mem) + * ----------------------------------------------------------------- + * kin_linit initializes solver-specific data structures (including + * variables used as counters or for storing statistical information), + * but system memory allocation should be done by the subroutine + * that actually initializes the environment for liner solver + * package. If the linear system is to be preconditioned, then the + * variable setupNonNull (type booleantype) should be set to SUNTRUE + * (predefined constant) and the kin_lsetup routine should be + * appropriately defined. + * + * kinmem pointer to an internal memory block allocated during + * prior calls to KINCreate and KINMalloc + * + * If the necessary variables have been successfully initialized, + * then the kin_linit function should return 0 (zero). Otherwise, + * the subroutine should indicate a failure has occurred by + * returning a non-zero integer value. + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function : int (*kin_lsetup)(KINMem kin_mem) + * ----------------------------------------------------------------- + * kin_lsetup interfaces with the user-supplied pset subroutine (the + * preconditioner setup routine), and updates relevant variable + * values (see KINSpgmrSetup/KINSpbcgSetup). Simply stated, the + * kin_lsetup routine prepares the linear solver for a subsequent + * call to the user-supplied kin_lsolve function. + * + * kinmem pointer to an internal memory block allocated during + * prior calls to KINCreate and KINMalloc + * + * If successful, the kin_lsetup routine should return 0 (zero). + * Otherwise it should return a non-zero value. + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function : int (*kin_lsolve)(KINMem kin_mem, N_Vector xx, + * N_Vector bb, realtype *sJpnorm, realtype *sFdotJp) + * ----------------------------------------------------------------- + * kin_lsolve interfaces with the subroutine implementing the + * numerical method to be used to solve the linear system J*xx = bb, + * and must increment the relevant counter variable values in + * addition to computing certain values used by the global strategy + * and forcing term routines (see KINInexactNewton, KINLineSearch, + * KINForcingTerm, and KINSpgmrSolve/KINSpbcgSolve). + * + * kinmem pointer to an internal memory block allocated during + * prior calls to KINCreate and KINMalloc + * + * xx vector (type N_Vector) set to initial guess by kin_lsolve + * routine prior to calling the linear solver, but which upon + * return contains an approximate solution of the linear + * system J*xx = bb, where J denotes the system Jacobian + * + * bb vector (type N_Vector) set to -func(u) (negative of the + * value of the system function evaluated at the current + * iterate) by KINLinSolDrv before kin_lsolve is called + * + * sJpnorm holds the value of the L2-norm (Euclidean norm) of + * fscale*(J(u)*pp) upon return + * + * sFdotJp holds the value of the scaled F(u) (fscale*F) dotted + * with the scaled J(u)*pp vector upon return + * + * If successful, the kin_lsolve routine should return 0 (zero). + * Otherwise it should return a positive value if a re-evaluation + * of the lsetup function could recover, or a negative value if + * no such recovery is possible. + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function : int (*kin_lfree)(KINMem kin_mem) + * ----------------------------------------------------------------- + * kin_lfree is called by KINFree and should free (deallocate) all + * system memory resources allocated for the linear solver module + * (see KINSpgmrFree/KINSpbcgFree). It should return 0 upon + * success, nonzero on failure. + * + * kinmem pointer to an internal memory block allocated during + * prior calls to KINCreate and KINMalloc + * ----------------------------------------------------------------- + */ + +/* + * ================================================================= + * K I N S O L I N T E R N A L F U N C T I O N S + * ================================================================= + */ + + +/* High level error handler */ + +void KINProcessError(KINMem kin_mem, + int error_code, const char *module, const char *fname, + const char *msgfmt, ...); + +/* Prototype of internal errHandler function */ + +void KINErrHandler(int error_code, const char *module, const char *function, + char *msg, void *user_data); + + +/* High level info handler */ + +void KINPrintInfo(KINMem kin_mem, + int info_code, const char *module, const char *fname, + const char *msgfmt, ...); + +/* Prototype of internal infoHandler function */ + +void KINInfoHandler(const char *module, const char *function, + char *msg, void *user_data); + +/* + * ================================================================= + * K I N S O L E R R O R M E S S A G E S + * ================================================================= + */ + +#define MSG_MEM_FAIL "A memory request failed." +#define MSG_NO_MEM "kinsol_mem = NULL illegal." +#define MSG_BAD_NVECTOR "A required vector operation is not implemented." +#define MSG_FUNC_NULL "func = NULL illegal." +#define MSG_NO_MALLOC "Attempt to call before KINMalloc illegal." + +#define MSG_BAD_PRINTFL "Illegal value for printfl." +#define MSG_BAD_MXITER "Illegal value for mxiter." +#define MSG_BAD_MSBSET "Illegal msbset < 0." +#define MSG_BAD_MSBSETSUB "Illegal msbsetsub < 0." +#define MSG_BAD_ETACHOICE "Illegal value for etachoice." +#define MSG_BAD_ETACONST "eta out of range." +#define MSG_BAD_GAMMA "gamma out of range." +#define MSG_BAD_ALPHA "alpha out of range." +#define MSG_BAD_MXNEWTSTEP "Illegal mxnewtstep < 0." +#define MSG_BAD_RELFUNC "relfunc < 0 illegal." +#define MSG_BAD_FNORMTOL "fnormtol < 0 illegal." +#define MSG_BAD_SCSTEPTOL "scsteptol < 0 illegal." +#define MSG_BAD_MXNBCF "mxbcf < 0 illegal." +#define MSG_BAD_CONSTRAINTS "Illegal values in constraints vector." +#define MSG_BAD_OMEGA "scalars < 0 illegal." +#define MSG_BAD_MAA "maa < 0 illegal." +#define MSG_ZERO_MAA "maa = 0 illegal." + +#define MSG_LSOLV_NO_MEM "The linear solver memory pointer is NULL." +#define MSG_UU_NULL "uu = NULL illegal." +#define MSG_BAD_GLSTRAT "Illegal value for global strategy." +#define MSG_BAD_USCALE "uscale = NULL illegal." +#define MSG_USCALE_NONPOSITIVE "uscale has nonpositive elements." +#define MSG_BAD_FSCALE "fscale = NULL illegal." +#define MSG_FSCALE_NONPOSITIVE "fscale has nonpositive elements." +#define MSG_CONSTRAINTS_NOTOK "Constraints not allowed with fixed point or Picard iterations" +#define MSG_INITIAL_CNSTRNT "Initial guess does NOT meet constraints." +#define MSG_LINIT_FAIL "The linear solver's init routine failed." + +#define MSG_SYSFUNC_FAILED "The system function failed in an unrecoverable manner." +#define MSG_SYSFUNC_FIRST "The system function failed at the first call." +#define MSG_LSETUP_FAILED "The linear solver's setup function failed in an unrecoverable manner." +#define MSG_LSOLVE_FAILED "The linear solver's solve function failed in an unrecoverable manner." +#define MSG_LINSOLV_NO_RECOVERY "The linear solver's solve function failed recoverably, but the Jacobian data is already current." +#define MSG_LINESEARCH_NONCONV "The line search algorithm was unable to find an iterate sufficiently distinct from the current iterate." +#define MSG_LINESEARCH_BCFAIL "The line search algorithm was unable to satisfy the beta-condition for nbcfails iterations." +#define MSG_MAXITER_REACHED "The maximum number of iterations was reached before convergence." +#define MSG_MXNEWT_5X_EXCEEDED "Five consecutive steps have been taken that satisfy a scaled step length test." +#define MSG_SYSFUNC_REPTD "Unable to correct repeated recoverable system function errors." +#define MSG_NOL_FAIL "Unable to find user's Linear Jacobian, which is required for the KIN_PICARD Strategy" + +/* + * ================================================================= + * K I N S O L I N F O M E S S A G E S + * ================================================================= + */ + +#define INFO_RETVAL "Return value: %d" +#define INFO_ADJ "no. of lambda adjustments = %ld" + +#if defined(SUNDIALS_EXTENDED_PRECISION) + +#define INFO_NNI "nni = %4ld nfe = %6ld fnorm = %26.16Lg" +#define INFO_TOL "scsteptol = %12.3Lg fnormtol = %12.3Lg" +#define INFO_FMAX "scaled f norm (for stopping) = %12.3Lg" +#define INFO_PNORM "pnorm = %12.4Le" +#define INFO_PNORM1 "(ivio=1) pnorm = %12.4Le" +#define INFO_FNORM "fnorm(L2) = %20.8Le" +#define INFO_LAM "min_lam = %11.4Le f1norm = %11.4Le pnorm = %11.4Le" +#define INFO_ALPHA "fnorm = %15.8Le f1norm = %15.8Le alpha_cond = %15.8Le lam = %15.8Le" +#define INFO_BETA "f1norm = %15.8Le beta_cond = %15.8Le lam = %15.8Le" +#define INFO_ALPHABETA "f1norm = %15.8Le alpha_cond = %15.8Le beta_cond = %15.8Le lam = %15.8Le" + +#elif defined(SUNDIALS_DOUBLE_PRECISION) + +#define INFO_NNI "nni = %4ld nfe = %6ld fnorm = %26.16lg" +#define INFO_TOL "scsteptol = %12.3lg fnormtol = %12.3lg" +#define INFO_FMAX "scaled f norm (for stopping) = %12.3lg" +#define INFO_PNORM "pnorm = %12.4le" +#define INFO_PNORM1 "(ivio=1) pnorm = %12.4le" +#define INFO_FNORM "fnorm(L2) = %20.8le" +#define INFO_LAM "min_lam = %11.4le f1norm = %11.4le pnorm = %11.4le" +#define INFO_ALPHA "fnorm = %15.8le f1norm = %15.8le alpha_cond = %15.8le lam = %15.8le" +#define INFO_BETA "f1norm = %15.8le beta_cond = %15.8le lam = %15.8le" +#define INFO_ALPHABETA "f1norm = %15.8le alpha_cond = %15.8le beta_cond = %15.8le lam = %15.8le" + +#else + +#define INFO_NNI "nni = %4ld nfe = %6ld fnorm = %26.16g" +#define INFO_TOL "scsteptol = %12.3g fnormtol = %12.3g" +#define INFO_FMAX "scaled f norm (for stopping) = %12.3g" +#define INFO_PNORM "pnorm = %12.4e" +#define INFO_PNORM1 "(ivio=1) pnorm = %12.4e" +#define INFO_FNORM "fnorm(L2) = %20.8e" +#define INFO_LAM "min_lam = %11.4e f1norm = %11.4e pnorm = %11.4e" +#define INFO_ALPHA "fnorm = %15.8e f1norm = %15.8e alpha_cond = %15.8e lam = %15.8e" +#define INFO_BETA "f1norm = %15.8e beta_cond = %15.8e lam = %15.8e" +#define INFO_ALPHABETA "f1norm = %15.8e alpha_cond = %15.8e beta_cond = %15.8e lam = %15.8e" + +#endif + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/kinsol/kinsol_io.c b/bazaar/plugin/sundials/src/kinsol/kinsol_io.c new file mode 100644 index 000000000..143aa2869 --- /dev/null +++ b/bazaar/plugin/sundials/src/kinsol/kinsol_io.c @@ -0,0 +1,1073 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for the optional input and output + * functions for the KINSOL solver. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "kinsol_impl.h" +#include +#include + +#define ZERO RCONST(0.0) +#define POINT1 RCONST(0.1) +#define ONETHIRD RCONST(0.3333333333333333) +#define HALF RCONST(0.5) +#define TWOTHIRDS RCONST(0.6666666666666667) +#define POINT9 RCONST(0.9) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) +#define TWOPT5 RCONST(2.5) + +/* + * ================================================================= + * KINSOL optional input functions + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * KINSetErrHandlerFn + * ----------------------------------------------------------------- + */ + +int KINSetErrHandlerFn(void *kinmem, KINErrHandlerFn ehfun, void *eh_data) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetErrHandlerFn", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + kin_mem->kin_ehfun = ehfun; + kin_mem->kin_eh_data = eh_data; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetErrFile + * ----------------------------------------------------------------- + */ + +int KINSetErrFile(void *kinmem, FILE *errfp) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetErrFile", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + kin_mem->kin_errfp = errfp; + + return(KIN_SUCCESS); +} + +#define errfp (kin_mem->kin_errfp) + +/* + * ----------------------------------------------------------------- + * Function : KINSetPrintLevel + * ----------------------------------------------------------------- + */ + +int KINSetPrintLevel(void *kinmem, int printfl) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetPrintLevel", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + if ((printfl < 0) || (printfl > 3)) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetPrintLevel", MSG_BAD_PRINTFL); + return(KIN_ILL_INPUT); + } + + kin_mem->kin_printfl = printfl; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * KINSetInfoHandlerFn + * ----------------------------------------------------------------- + */ + +int KINSetInfoHandlerFn(void *kinmem, KINInfoHandlerFn ihfun, void *ih_data) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetInfoHandlerFn", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + kin_mem->kin_ihfun = ihfun; + kin_mem->kin_ih_data = ih_data; + + return(KIN_SUCCESS); +} + + +/* + * ----------------------------------------------------------------- + * Function : KINSetInfoFile + * ----------------------------------------------------------------- + */ + +int KINSetInfoFile(void *kinmem, FILE *infofp) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetInfoFile", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + kin_mem->kin_infofp = infofp; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetUserData + * ----------------------------------------------------------------- + */ + +int KINSetUserData(void *kinmem, void *user_data) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetUserData", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + kin_mem->kin_user_data = user_data; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetMAA + * ----------------------------------------------------------------- + */ + +int KINSetMAA(void *kinmem, long int maa) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMAA", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + if (maa < 0) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMAA", MSG_BAD_MAA); + return(KIN_ILL_INPUT); + } + + if (maa > kin_mem->kin_mxiter) maa = kin_mem->kin_mxiter; + + kin_mem->kin_m_aa = maa; + kin_mem->kin_aamem_aa = (maa == 0) ? SUNFALSE : SUNTRUE; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetDampingAA + * ----------------------------------------------------------------- + */ + +int KINSetDampingAA(void *kinmem, realtype beta) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMAA", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + /* check for illegal input value */ + if (beta <= ZERO) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetDampingAA", + "beta <= 0 illegal"); + return(KIN_ILL_INPUT); + } + + if (beta < ONE) { + /* enable damping */ + kin_mem->kin_beta_aa = beta; + kin_mem->kin_damping_aa = SUNTRUE; + } else { + /* disable damping */ + kin_mem->kin_beta_aa = ONE; + kin_mem->kin_damping_aa = SUNFALSE; + } + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetAAStopCrit + * ----------------------------------------------------------------- + */ + +/* CSW: This function is currently not supported. + +int KINSetAAStopCrit(void *kinmem, booleantype setstop) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetAAStopCrit", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + kin_mem->kin_setstop_aa = setstop; + + return(KIN_SUCCESS); +} +*/ + +/* + * ----------------------------------------------------------------- + * Function : KINSetNumMaxIters + * ----------------------------------------------------------------- + */ + +int KINSetNumMaxIters(void *kinmem, long int mxiter) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetNumMaxIters", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + if (mxiter < 0) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetNumMaxIters", MSG_BAD_MXITER); + return(KIN_ILL_INPUT); + } + + if (mxiter == 0) + kin_mem->kin_mxiter = MXITER_DEFAULT; + else + kin_mem->kin_mxiter = mxiter; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetNoInitSetup + * ----------------------------------------------------------------- + */ + +int KINSetNoInitSetup(void *kinmem, booleantype noInitSetup) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetNoInitSetup", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + kin_mem->kin_noInitSetup = noInitSetup; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetNoResMon + * ----------------------------------------------------------------- + */ + +int KINSetNoResMon(void *kinmem, booleantype noResMon) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetNoResMon", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + kin_mem->kin_noResMon = noResMon; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetMaxSetupCalls + * ----------------------------------------------------------------- + */ + +int KINSetMaxSetupCalls(void *kinmem, long int msbset) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMaxSetupCalls", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + if (msbset < 0) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMaxSetupCalls", MSG_BAD_MSBSET); + return(KIN_ILL_INPUT); + } + + if (msbset == 0) + kin_mem->kin_msbset = MSBSET_DEFAULT; + else + kin_mem->kin_msbset = msbset; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetMaxSubSetupCalls + * ----------------------------------------------------------------- + */ + +int KINSetMaxSubSetupCalls(void *kinmem, long int msbsetsub) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMaxSubSetupCalls", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + if (msbsetsub < 0) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMaxSubSetupCalls", MSG_BAD_MSBSETSUB); + return(KIN_ILL_INPUT); + } + + if (msbsetsub == 0) + kin_mem->kin_msbset_sub = MSBSET_SUB_DEFAULT; + else + kin_mem->kin_msbset_sub = msbsetsub; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetEtaForm + * ----------------------------------------------------------------- + */ + +int KINSetEtaForm(void *kinmem, int etachoice) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetEtaForm", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + if ((etachoice != KIN_ETACONSTANT) && + (etachoice != KIN_ETACHOICE1) && + (etachoice != KIN_ETACHOICE2)) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetEtaForm", MSG_BAD_ETACHOICE); + return(KIN_ILL_INPUT); + } + + kin_mem->kin_etaflag = etachoice; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetEtaConstValue + * ----------------------------------------------------------------- + */ + +int KINSetEtaConstValue(void *kinmem, realtype eta) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetEtaConstValue", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + if ((eta < ZERO) || (eta > ONE)) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetEtaConstValue", MSG_BAD_ETACONST); + return(KIN_ILL_INPUT); + } + + if (eta == ZERO) + kin_mem->kin_eta = POINT1; + else + kin_mem->kin_eta = eta; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetEtaParams + * ----------------------------------------------------------------- + */ + +int KINSetEtaParams(void *kinmem, realtype egamma, realtype ealpha) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetEtaParams", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + if ((ealpha <= ONE) || (ealpha > TWO)) + if (ealpha != ZERO) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetEtaParams", MSG_BAD_ALPHA); + return(KIN_ILL_INPUT); + } + + if (ealpha == ZERO) + kin_mem->kin_eta_alpha = TWO; + else + kin_mem->kin_eta_alpha = ealpha; + + if ((egamma <= ZERO) || (egamma > ONE)) + if (egamma != ZERO) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetEtaParams", MSG_BAD_GAMMA); + return(KIN_ILL_INPUT); + } + + if (egamma == ZERO) + kin_mem->kin_eta_gamma = POINT9; + else + kin_mem->kin_eta_gamma = egamma; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetResMonParams + * ----------------------------------------------------------------- + */ + +int KINSetResMonParams(void *kinmem, realtype omegamin, realtype omegamax) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetResMonParams", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + /* check omegamin */ + + if (omegamin < ZERO) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonParams", MSG_BAD_OMEGA); + return(KIN_ILL_INPUT); + } + + if (omegamin == ZERO) + kin_mem->kin_omega_min = OMEGA_MIN; + else + kin_mem->kin_omega_min = omegamin; + + /* check omegamax */ + + if (omegamax < ZERO) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonParams", MSG_BAD_OMEGA); + return(KIN_ILL_INPUT); + } + + if (omegamax == ZERO) { + + if (kin_mem->kin_omega_min > OMEGA_MAX) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonParams", MSG_BAD_OMEGA); + return(KIN_ILL_INPUT); + } + else kin_mem->kin_omega_max = OMEGA_MAX; + + } else { + + if (kin_mem->kin_omega_min > omegamax) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonParams", MSG_BAD_OMEGA); + return(KIN_ILL_INPUT); + } + else kin_mem->kin_omega_max = omegamax; + + } + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetResMonConstValue + * ----------------------------------------------------------------- + */ + +int KINSetResMonConstValue(void *kinmem, realtype omegaconst) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetResMonConstValue", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + /* check omegaconst */ + + if (omegaconst < ZERO) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonConstValue", MSG_BAD_OMEGA); + return(KIN_ILL_INPUT); + } + + /* Load omega value. A value of 0 will force using omega_min and omega_max */ + kin_mem->kin_omega = omegaconst; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetNoMinEps + * ----------------------------------------------------------------- + */ + +int KINSetNoMinEps(void *kinmem, booleantype noMinEps) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetNoMinEps", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + kin_mem->kin_noMinEps = noMinEps; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetMaxNewtonStep + * ----------------------------------------------------------------- + */ + +int KINSetMaxNewtonStep(void *kinmem, realtype mxnewtstep) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMaxNewtonStep", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + if (mxnewtstep < ZERO) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMaxNewtonStep", MSG_BAD_MXNEWTSTEP); + return(KIN_ILL_INPUT); + } + + /* Note: passing a value of 0.0 will use the default + value (computed in KINSolInit) */ + + kin_mem->kin_mxnstepin = mxnewtstep; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetMaxBetaFails + * ----------------------------------------------------------------- + */ + +int KINSetMaxBetaFails(void *kinmem, long int mxnbcf) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMaxBetaFails", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + if (mxnbcf < 0) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMaxBetaFails", MSG_BAD_MXNBCF); + return(KIN_ILL_INPUT); + } + + if (mxnbcf == 0) + kin_mem->kin_mxnbcf = MXNBCF_DEFAULT; + else + kin_mem->kin_mxnbcf = mxnbcf; + + return(KIN_SUCCESS); + +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetRelErrFunc + * ----------------------------------------------------------------- + */ + +int KINSetRelErrFunc(void *kinmem, realtype relfunc) +{ + KINMem kin_mem; + realtype uround; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetRelErrFunc", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + if (relfunc < ZERO) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetRelErrFunc", MSG_BAD_RELFUNC); + return(KIN_ILL_INPUT); + } + + if (relfunc == ZERO) { + uround = kin_mem->kin_uround; + kin_mem->kin_sqrt_relfunc = SUNRsqrt(uround); + } else { + kin_mem->kin_sqrt_relfunc = SUNRsqrt(relfunc); + } + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetFuncNormTol + * ----------------------------------------------------------------- + */ + +int KINSetFuncNormTol(void *kinmem, realtype fnormtol) +{ + KINMem kin_mem; + realtype uround; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetFuncNormTol", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + if (fnormtol < ZERO) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetFuncNormTol", MSG_BAD_FNORMTOL); + return(KIN_ILL_INPUT); + } + + if (fnormtol == ZERO) { + uround = kin_mem->kin_uround; + kin_mem->kin_fnormtol = SUNRpowerR(uround,ONETHIRD); + } else { + kin_mem->kin_fnormtol = fnormtol; + } + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetScaledStepTol + * ----------------------------------------------------------------- + */ + +int KINSetScaledStepTol(void *kinmem, realtype scsteptol) +{ + KINMem kin_mem; + realtype uround; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetScaledStepTol", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + if (scsteptol < ZERO) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetScaledStepTol", MSG_BAD_SCSTEPTOL); + return(KIN_ILL_INPUT); + } + + if (scsteptol == ZERO) { + uround = kin_mem->kin_uround; + kin_mem->kin_scsteptol = SUNRpowerR(uround,TWOTHIRDS); + } else { + kin_mem->kin_scsteptol = scsteptol; + } + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetConstraints + * ----------------------------------------------------------------- + */ + +int KINSetConstraints(void *kinmem, N_Vector constraints) +{ + KINMem kin_mem; + realtype temptest; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetConstraints", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + if (constraints == NULL) { + if (kin_mem->kin_constraintsSet) { + N_VDestroy(kin_mem->kin_constraints); + kin_mem->kin_lrw -= kin_mem->kin_lrw1; + kin_mem->kin_liw -= kin_mem->kin_liw1; + } + kin_mem->kin_constraintsSet = SUNFALSE; + return(KIN_SUCCESS); + } + + /* Check the constraints vector */ + + temptest = N_VMaxNorm(constraints); + if (temptest > TWOPT5){ + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetConstraints", MSG_BAD_CONSTRAINTS); + return(KIN_ILL_INPUT); + } + + if (!kin_mem->kin_constraintsSet) { + kin_mem->kin_constraints = N_VClone(constraints); + kin_mem->kin_lrw += kin_mem->kin_lrw1; + kin_mem->kin_liw += kin_mem->kin_liw1; + kin_mem->kin_constraintsSet = SUNTRUE; + } + + /* Load the constraint vector */ + + N_VScale(ONE, constraints, kin_mem->kin_constraints); + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINSetSysFunc + * ----------------------------------------------------------------- + */ + +int KINSetSysFunc(void *kinmem, KINSysFn func) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetSysFunc", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + if (func == NULL) { + KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetSysFunc", MSG_FUNC_NULL); + return(KIN_ILL_INPUT); + } + + kin_mem->kin_func = func; + + return(KIN_SUCCESS); +} + + +/* + * ================================================================= + * KINSOL optional output functions + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Function : KINGetWorkSpace + * ----------------------------------------------------------------- + */ + +int KINGetWorkSpace(void *kinmem, long int *lenrw, long int *leniw) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetWorkSpace", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + + *lenrw = kin_mem->kin_lrw; + *leniw = kin_mem->kin_liw; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINGetNumNonlinSolvIters + * ----------------------------------------------------------------- + */ + +int KINGetNumNonlinSolvIters(void *kinmem, long int *nniters) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetNumNonlinSolvIters", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + *nniters = kin_mem->kin_nni; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINGetNumFuncEvals + * ----------------------------------------------------------------- + */ + +int KINGetNumFuncEvals(void *kinmem, long int *nfevals) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetNumFuncEvals", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + *nfevals = kin_mem->kin_nfe; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINGetNumBetaCondFails + * ----------------------------------------------------------------- + */ + +int KINGetNumBetaCondFails(void *kinmem, long int *nbcfails) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetNumBetaCondFails", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + *nbcfails = kin_mem->kin_nbcf; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINGetNumBacktrackOps + * ----------------------------------------------------------------- + */ + +int KINGetNumBacktrackOps(void *kinmem, long int *nbacktr) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetNumBacktrackOps", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + *nbacktr = kin_mem->kin_nbktrk; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINGetFuncNorm + * ----------------------------------------------------------------- + */ + +int KINGetFuncNorm(void *kinmem, realtype *funcnorm) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetFuncNorm", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + *funcnorm = kin_mem->kin_fnorm; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINGetStepLength + * ----------------------------------------------------------------- + */ + +int KINGetStepLength(void *kinmem, realtype *steplength) +{ + KINMem kin_mem; + + if (kinmem == NULL) { + KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetStepLength", MSG_NO_MEM); + return(KIN_MEM_NULL); + } + + kin_mem = (KINMem) kinmem; + *steplength = kin_mem->kin_stepl; + + return(KIN_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : KINGetReturnFlagName + * ----------------------------------------------------------------- + */ + +char *KINGetReturnFlagName(long int flag) +{ + char *name; + + name = (char *)malloc(24*sizeof(char)); + + switch(flag) { + case KIN_SUCCESS: + sprintf(name, "KIN_SUCCESS"); + break; + case KIN_INITIAL_GUESS_OK: + sprintf(name, "KIN_INITIAL_GUESS_OK"); + break; + case KIN_STEP_LT_STPTOL: + sprintf(name, "KIN_STEP_LT_STPTOL"); + break; + case KIN_WARNING: + sprintf(name, "KIN_WARNING"); + break; + case KIN_MEM_NULL: + sprintf(name, "KIN_MEM_NULL"); + break; + case KIN_ILL_INPUT: + sprintf(name, "KIN_ILL_INPUT"); + break; + case KIN_NO_MALLOC: + sprintf(name, "KIN_NO_MALLOC"); + break; + case KIN_MEM_FAIL: + sprintf(name, "KIN_MEM_FAIL"); + break; + case KIN_LINESEARCH_NONCONV: + sprintf(name, "KIN_LINESEARCH_NONCONV"); + break; + case KIN_MAXITER_REACHED: + sprintf(name, "KIN_MAXITER_REACHED"); + break; + case KIN_MXNEWT_5X_EXCEEDED: + sprintf(name, "KIN_MXNEWT_5X_EXCEEDED"); + break; + case KIN_LINESEARCH_BCFAIL: + sprintf(name, "KIN_LINESEARCH_BCFAIL"); + break; + case KIN_LINSOLV_NO_RECOVERY: + sprintf(name, "KIN_LINSOLV_NO_RECOVERY"); + break; + case KIN_LINIT_FAIL: + sprintf(name, "KIN_LINIT_FAIL"); + break; + case KIN_LSETUP_FAIL: + sprintf(name, "KIN_LSETUP_FAIL"); + break; + case KIN_LSOLVE_FAIL: + sprintf(name, "KIN_LSOLVE_FAIL"); + break; + default: + sprintf(name, "NONE"); + } + + return(name); +} diff --git a/bazaar/plugin/sundials/src/kinsol/kinsol_ls.c b/bazaar/plugin/sundials/src/kinsol/kinsol_ls.c new file mode 100644 index 000000000..cd8bd2b5f --- /dev/null +++ b/bazaar/plugin/sundials/src/kinsol/kinsol_ls.c @@ -0,0 +1,1332 @@ +/*----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * David J. Gardner, Radu Serban and Aaron Collier @ LLNL + *----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *----------------------------------------------------------------- + * Implementation file for KINSOL's linear solver interface. + *-----------------------------------------------------------------*/ + +#include +#include +#include +#include + +#include "kinsol_impl.h" +#include "kinsol_ls_impl.h" + +#include +#include +#include +#include + +/* constants */ +#define MIN_INC_MULT RCONST(1000.0) +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) + + +/*================================================================== + KINLS Exported functions -- Required + ==================================================================*/ + +/*--------------------------------------------------------------- + KINSetLinearSolver specifies the linear solver + ---------------------------------------------------------------*/ +int KINSetLinearSolver(void *kinmem, SUNLinearSolver LS, SUNMatrix A) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + int retval, LSType; + booleantype iterative; /* is the solver iterative? */ + booleantype matrixbased; /* is a matrix structure used? */ + + /* Return immediately if either kinmem or LS inputs are NULL */ + if (kinmem == NULL) { + KINProcessError(NULL, KINLS_MEM_NULL, "KINLS", + "KINSetLinearSolver", MSG_LS_KINMEM_NULL); + return(KINLS_MEM_NULL); + } + if (LS == NULL) { + KINProcessError(NULL, KINLS_ILL_INPUT, "KINLS", + "KINSetLinearSolver", + "LS must be non-NULL"); + return(KINLS_ILL_INPUT); + } + kin_mem = (KINMem) kinmem; + + /* Test if solver is compatible with LS interface */ + if ( (LS->ops->gettype == NULL) || (LS->ops->solve == NULL) ) { + KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", + "KINSetLinearSolver", + "LS object is missing a required operation"); + return(KINLS_ILL_INPUT); + } + + /* Retrieve the LS type */ + LSType = SUNLinSolGetType(LS); + + /* Set flags based on LS type */ + iterative = (LSType != SUNLINEARSOLVER_DIRECT); + matrixbased = (LSType != SUNLINEARSOLVER_ITERATIVE); + + /* check for required vector operations for KINLS interface */ + if ( (kin_mem->kin_vtemp1->ops->nvconst == NULL) || + (kin_mem->kin_vtemp1->ops->nvdotprod == NULL) ) { + KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", + "KINSetLinearSolver", MSG_LS_BAD_NVECTOR); + return(KINLS_ILL_INPUT); + } + + /* Check for compatible LS type, matrix and "atimes" support */ + if (iterative) { + + if ((LS->ops->setscalingvectors == NULL) && + (kin_mem->kin_vtemp1->ops->nvgetlength == NULL)) { + KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", + "KINSetLinearSolver", MSG_LS_BAD_NVECTOR); + return(KINLS_ILL_INPUT); + } + + if (!matrixbased && (LS->ops->setatimes == NULL)) { + KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "KINSetLinearSolver", + "Incompatible inputs: iterative LS must support ATimes routine"); + return(KINLS_ILL_INPUT); + } + + if (matrixbased && A == NULL) { + KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "KINSetLinearSolver", + "Incompatible inputs: matrix-iterative LS requires non-NULL matrix"); + return(KINLS_ILL_INPUT); + } + + } else if (A == NULL) { + + KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "KINSetLinearSolver", + "Incompatible inputs: direct LS requires non-NULL matrix"); + return(KINLS_ILL_INPUT); + } + + /* free any existing system solver attached to KIN */ + if (kin_mem->kin_lfree) kin_mem->kin_lfree(kin_mem); + + /* Determine if this is an iterative linear solver */ + kin_mem->kin_inexact_ls = iterative; + + /* Set four main system linear solver function fields in kin_mem */ + kin_mem->kin_linit = kinLsInitialize; + kin_mem->kin_lsetup = kinLsSetup; + kin_mem->kin_lsolve = kinLsSolve; + kin_mem->kin_lfree = kinLsFree; + + /* Get memory for KINLsMemRec */ + kinls_mem = NULL; + kinls_mem = (KINLsMem) malloc(sizeof(struct KINLsMemRec)); + if (kinls_mem == NULL) { + KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINLS", + "KINSetLinearSolver", MSG_LS_MEM_FAIL); + return(KINLS_MEM_FAIL); + } + memset(kinls_mem, 0, sizeof(struct KINLsMemRec)); + + /* set SUNLinearSolver pointer */ + kinls_mem->LS = LS; + + /* Set defaults for Jacobian-related fields */ + if (A != NULL) { + kinls_mem->jacDQ = SUNTRUE; + kinls_mem->jac = kinLsDQJac; + kinls_mem->J_data = kin_mem; + } else { + kinls_mem->jacDQ = SUNFALSE; + kinls_mem->jac = NULL; + kinls_mem->J_data = NULL; + } + kinls_mem->jtimesDQ = SUNTRUE; + kinls_mem->jtimes = kinLsDQJtimes; + kinls_mem->jt_data = kin_mem; + + /* Set defaults for preconditioner-related fields */ + kinls_mem->pset = NULL; + kinls_mem->psolve = NULL; + kinls_mem->pfree = NULL; + kinls_mem->pdata = kin_mem->kin_user_data; + + /* Initialize counters */ + kinLsInitializeCounters(kinls_mem); + + /* Set default values for the rest of the LS parameters */ + kinls_mem->last_flag = KINLS_SUCCESS; + + /* If LS supports ATimes, attach KINLs routine */ + if (LS->ops->setatimes) { + retval = SUNLinSolSetATimes(LS, kin_mem, kinLsATimes); + if (retval != SUNLS_SUCCESS) { + KINProcessError(kin_mem, KINLS_SUNLS_FAIL, "KINLS", + "KINSetLinearSolver", + "Error in calling SUNLinSolSetATimes"); + free(kinls_mem); kinls_mem = NULL; + return(KINLS_SUNLS_FAIL); + } + } + + /* If LS supports preconditioning, initialize pset/psol to NULL */ + if (LS->ops->setpreconditioner) { + retval = SUNLinSolSetPreconditioner(LS, kin_mem, NULL, NULL); + if (retval != SUNLS_SUCCESS) { + KINProcessError(kin_mem, KINLS_SUNLS_FAIL, "KINLS", + "KINSetLinearSolver", + "Error in calling SUNLinSolSetPreconditioner"); + free(kinls_mem); kinls_mem = NULL; + return(KINLS_SUNLS_FAIL); + } + } + + /* initialize tolerance scaling factor */ + kinls_mem->tol_fac = -ONE; + + /* set SUNMatrix pointer (can be NULL) */ + kinls_mem->J = A; + + /* Attach linear solver memory to integrator memory */ + kin_mem->kin_lmem = kinls_mem; + + return(KINLS_SUCCESS); +} + + +/*================================================================== + Optional input/output routines + ==================================================================*/ + +/*------------------------------------------------------------------ + KINSetJacFn specifies the Jacobian function + ------------------------------------------------------------------*/ +int KINSetJacFn(void *kinmem, KINLsJacFn jac) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + int retval; + + /* access KINLsMem structure */ + retval = kinLs_AccessLMem(kinmem, "KINSetJacFn", + &kin_mem, &kinls_mem); + if (retval != KIN_SUCCESS) return(retval); + + /* return with failure if jac cannot be used */ + if ((jac != NULL) && (kinls_mem->J == NULL)) { + KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "KINSetJacFn", + "Jacobian routine cannot be supplied for NULL SUNMatrix"); + return(KINLS_ILL_INPUT); + } + + if (jac != NULL) { + kinls_mem->jacDQ = SUNFALSE; + kinls_mem->jac = jac; + kinls_mem->J_data = kin_mem->kin_user_data; + } else { + kinls_mem->jacDQ = SUNTRUE; + kinls_mem->jac = kinLsDQJac; + kinls_mem->J_data = kin_mem; + } + + return(KINLS_SUCCESS); +} + + +/*------------------------------------------------------------------ + KINSetPreconditioner sets the preconditioner setup and solve + functions + ------------------------------------------------------------------*/ +int KINSetPreconditioner(void *kinmem, + KINLsPrecSetupFn psetup, + KINLsPrecSolveFn psolve) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + PSetupFn kinls_psetup; + PSolveFn kinls_psolve; + int retval; + + /* access KINLsMem structure */ + retval = kinLs_AccessLMem(kinmem, "KINSetPreconditioner", + &kin_mem, &kinls_mem); + if (retval != KIN_SUCCESS) return(retval); + + /* store function pointers for user-supplied routines in KINLS interface */ + kinls_mem->pset = psetup; + kinls_mem->psolve = psolve; + + /* issue error if LS object does not support user-supplied preconditioning */ + if (kinls_mem->LS->ops->setpreconditioner == NULL) { + KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "KINSetPreconditioner", + "SUNLinearSolver object does not support user-supplied preconditioning"); + return(KINLS_ILL_INPUT); + } + + /* notify iterative linear solver to call KINLs interface routines */ + kinls_psetup = (psetup == NULL) ? NULL : kinLsPSetup; + kinls_psolve = (psolve == NULL) ? NULL : kinLsPSolve; + retval = SUNLinSolSetPreconditioner(kinls_mem->LS, kin_mem, + kinls_psetup, kinls_psolve); + if (retval != SUNLS_SUCCESS) { + KINProcessError(kin_mem, KINLS_SUNLS_FAIL, "KINLS", "KINSetPreconditioner", + "Error in calling SUNLinSolSetPreconditioner"); + return(KINLS_SUNLS_FAIL); + } + + return(KINLS_SUCCESS); +} + +/*------------------------------------------------------------------ + KINSetJacTimesVecFn sets the matrix-vector product function + ------------------------------------------------------------------*/ +int KINSetJacTimesVecFn(void *kinmem, KINLsJacTimesVecFn jtv) +{ + int retval; + KINMem kin_mem; + KINLsMem kinls_mem; + + /* access KINLsMem structure */ + retval = kinLs_AccessLMem(kinmem, "KINSetJacTimesVecFn", + &kin_mem, &kinls_mem); + if (retval != KIN_SUCCESS) return(retval); + + /* issue error if LS object does not support user-supplied ATimes */ + if (kinls_mem->LS->ops->setatimes == NULL) { + KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "KINSetJacTimesVecFn", + "SUNLinearSolver object does not support user-supplied ATimes routine"); + return(KINLS_ILL_INPUT); + } + + /* store function pointers for user-supplied routine in KINLs + interface (NULL jtimes implies use of DQ default) */ + if (jtv != NULL) { + kinls_mem->jtimesDQ = SUNFALSE; + kinls_mem->jtimes = jtv; + kinls_mem->jt_data = kin_mem->kin_user_data; + } else { + kinls_mem->jtimesDQ = SUNTRUE; + kinls_mem->jtimes = kinLsDQJtimes; + kinls_mem->jt_data = kin_mem; + } + + return(KINLS_SUCCESS); +} + +/*------------------------------------------------------------------ + KINGetLinWorkSpace returns the integer and real workspace size + ------------------------------------------------------------------*/ +int KINGetLinWorkSpace(void *kinmem, long int *lenrwLS, long int *leniwLS) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + sunindextype lrw1, liw1; + long int lrw, liw; + int retval; + + /* access KINLsMem structure */ + retval = kinLs_AccessLMem(kinmem, "KINGetLinWorkSpace", + &kin_mem, &kinls_mem); + if (retval != KIN_SUCCESS) return(retval); + + /* start with fixed sizes plus vector/matrix pointers */ + *lenrwLS = 1; + *leniwLS = 21; + + /* add N_Vector sizes */ + if (kin_mem->kin_vtemp1->ops->nvspace) { + N_VSpace(kin_mem->kin_vtemp1, &lrw1, &liw1); + *lenrwLS += lrw1; + *leniwLS += liw1; + } + + /* add LS sizes */ + if (kinls_mem->LS->ops->space) { + retval = SUNLinSolSpace(kinls_mem->LS, &lrw, &liw); + if (retval == 0) { + *lenrwLS += lrw; + *leniwLS += liw; + } + } + + return(KINLS_SUCCESS); +} + +/*------------------------------------------------------------------ + KINGetNumJacEvals returns the number of Jacobian evaluations + ------------------------------------------------------------------*/ +int KINGetNumJacEvals(void *kinmem, long int *njevals) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + int retval; + + /* access KINLsMem structure; set output value and return */ + retval = kinLs_AccessLMem(kinmem, "KINGetNumJacEvals", + &kin_mem, &kinls_mem); + if (retval != KIN_SUCCESS) return(retval); + *njevals = kinls_mem->nje; + return(KINLS_SUCCESS); +} + +/*------------------------------------------------------------------ + KINGetNumPrecEvals returns the total number of preconditioner + evaluations + ------------------------------------------------------------------*/ +int KINGetNumPrecEvals(void *kinmem, long int *npevals) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + int retval; + + /* access KINLsMem structure; set output value and return */ + retval = kinLs_AccessLMem(kinmem, "KINGetNumPrecEvals", + &kin_mem, &kinls_mem); + if (retval != KIN_SUCCESS) return(retval); + *npevals = kinls_mem->npe; + return(KINLS_SUCCESS); +} + +/*------------------------------------------------------------------ + KINGetNumPrecSolves returns the total number of times the + preconditioner was applied + ------------------------------------------------------------------*/ +int KINGetNumPrecSolves(void *kinmem, long int *npsolves) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + int retval; + + /* access KINLsMem structure; set output value and return */ + retval = kinLs_AccessLMem(kinmem, "KINGetNumPrecSolves", + &kin_mem, &kinls_mem); + if (retval != KIN_SUCCESS) return(retval); + *npsolves = kinls_mem->nps; + return(KINLS_SUCCESS); +} + +/*------------------------------------------------------------------ + KINGetNumLinIters returns the total number of linear + iterations + ------------------------------------------------------------------*/ +int KINGetNumLinIters(void *kinmem, long int *nliters) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + int retval; + + /* access KINLsMem structure; set output value and return */ + retval = kinLs_AccessLMem(kinmem, "KINGetNumLinIters", + &kin_mem, &kinls_mem); + if (retval != KIN_SUCCESS) return(retval); + *nliters = kinls_mem->nli; + return(KINLS_SUCCESS); +} + +/*------------------------------------------------------------------ + KINGetNumLinConvFails returns the total numbe of convergence + failures + ------------------------------------------------------------------*/ +int KINGetNumLinConvFails(void *kinmem, long int *nlcfails) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + int retval; + + /* access KINLsMem structure; set output value and return */ + retval = kinLs_AccessLMem(kinmem, "KINGetNumLinConvFails", + &kin_mem, &kinls_mem); + if (retval != KIN_SUCCESS) return(retval); + *nlcfails = kinls_mem->ncfl; + return(KINLS_SUCCESS); +} + +/*------------------------------------------------------------------ + KINGetNumJtimesEvals returns the number of times the matrix + vector product was computed + ------------------------------------------------------------------*/ +int KINGetNumJtimesEvals(void *kinmem, long int *njvevals) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + int retval; + + /* access KINLsMem structure; set output value and return */ + retval = kinLs_AccessLMem(kinmem, "KINGetNumJtimesEvals", + &kin_mem, &kinls_mem); + if (retval != KIN_SUCCESS) return(retval); + *njvevals = kinls_mem->njtimes; + return(KINLS_SUCCESS); +} + +/*------------------------------------------------------------------ + KINGetNumLinFuncEvals returns the number of calls to the user's + F routine by the linear solver module + ------------------------------------------------------------------*/ +int KINGetNumLinFuncEvals(void *kinmem, long int *nfevals) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + int retval; + + /* access KINLsMem structure; set output value and return */ + retval = kinLs_AccessLMem(kinmem, "KINGetNumLinFuncEvals", + &kin_mem, &kinls_mem); + if (retval != KIN_SUCCESS) return(retval); + *nfevals = kinls_mem->nfeDQ; + return(KINLS_SUCCESS); +} + +/*------------------------------------------------------------------ + KINGetLastLinFlag returns the last flag set in the KINLS + function + ------------------------------------------------------------------*/ +int KINGetLastLinFlag(void *kinmem, long int *flag) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + int retval; + + /* access KINLsMem structure; set output value and return */ + retval = kinLs_AccessLMem(kinmem, "KINGetLastLinFlag", + &kin_mem, &kinls_mem); + if (retval != KIN_SUCCESS) return(retval); + *flag = kinls_mem->last_flag; + return(KINLS_SUCCESS); +} + +/*------------------------------------------------------------------ + KINGetLinReturnFlagName + ------------------------------------------------------------------*/ +char *KINGetLinReturnFlagName(long int flag) +{ + char *name; + + name = (char *)malloc(30*sizeof(char)); + + switch(flag) { + case KINLS_SUCCESS: + sprintf(name, "KINLS_SUCCESS"); + break; + case KINLS_MEM_NULL: + sprintf(name, "KINLS_MEM_NULL"); + break; + case KINLS_LMEM_NULL: + sprintf(name, "KINLS_LMEM_NULL"); + break; + case KINLS_ILL_INPUT: + sprintf(name, "KINLS_ILL_INPUT"); + break; + case KINLS_MEM_FAIL: + sprintf(name, "KINLS_MEM_FAIL"); + break; + case KINLS_PMEM_NULL: + sprintf(name, "KINLS_PMEM_NULL"); + break; + case KINLS_JACFUNC_ERR: + sprintf(name,"KINLS_JACFUNC_ERR"); + break; + case KINLS_SUNMAT_FAIL: + sprintf(name,"KINLS_SUNMAT_FAIL"); + break; + case KINLS_SUNLS_FAIL: + sprintf(name,"KINLS_SUNLS_FAIL"); + break; + default: + sprintf(name, "NONE"); + } + + return(name); +} + + +/*================================================================== + KINLS Private functions + ==================================================================*/ + +/*------------------------------------------------------------------ + kinLsATimes + + This routine coordinates the generation of the matrix-vector + product z = J*v by calling either kinLsDQJtimes, which uses + a difference quotient approximation for J*v, or by calling the + user-supplied routine KINLsJacTimesVecFn if it is non-null. + ------------------------------------------------------------------*/ +int kinLsATimes(void *kinmem, N_Vector v, N_Vector z) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + int retval; + + /* access KINLsMem structure */ + retval = kinLs_AccessLMem(kinmem, "kinLsATimes", + &kin_mem, &kinls_mem); + if (retval != KIN_SUCCESS) return(retval); + + /* call Jacobian-times-vector product routine + (either user-supplied or internal DQ) */ + retval = kinls_mem->jtimes(v, z, kin_mem->kin_uu, + &(kinls_mem->new_uu), + kinls_mem->jt_data); + kinls_mem->njtimes++; + return(retval); +} + + +/*--------------------------------------------------------------- + kinLsPSetup: + + This routine interfaces between the generic iterative linear + solvers and the user's psetup routine. It passes to psetup all + required state information from kin_mem. Its return value + is the same as that returned by psetup. Note that the generic + iterative linear solvers guarantee that kinLsPSetup will only + be called in the case that the user's psetup routine is non-NULL. + ---------------------------------------------------------------*/ +int kinLsPSetup(void *kinmem) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + int retval; + + /* access KINLsMem structure */ + retval = kinLs_AccessLMem(kinmem, "kinLsPSetup", + &kin_mem, &kinls_mem); + if (retval != KIN_SUCCESS) return(retval); + + /* Call user pset routine to update preconditioner */ + retval = kinls_mem->pset(kin_mem->kin_uu, kin_mem->kin_uscale, + kin_mem->kin_fval, kin_mem->kin_fscale, + kinls_mem->pdata); + kinls_mem->npe++; + return(retval); +} + + +/*------------------------------------------------------------------ + kinLsPSolve + + This routine interfaces between the generic iterative linear + solvers and the user's psolve routine. It passes to psolve all + required state information from kinsol_mem. Its return value is + the same as that returned by psolve. Note that the generic + SUNLinSol solver guarantees that kinLsPSolve 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. + ------------------------------------------------------------------*/ +int kinLsPSolve(void *kinmem, N_Vector r, N_Vector z, realtype tol, int lr) +{ + KINMem kin_mem; + KINLsMem kinls_mem; + int retval; + + /* access KINLsMem structure */ + retval = kinLs_AccessLMem(kinmem, "kinLsPSolve", + &kin_mem, &kinls_mem); + if (retval != KIN_SUCCESS) return(retval); + + /* copy the rhs into z before the psolve call */ + /* Note: z returns with the solution */ + N_VScale(ONE, r, z); + + /* note: user-supplied preconditioning with KINSOL does not + support either the 'tol' or 'lr' inputs */ + retval = kinls_mem->psolve(kin_mem->kin_uu, kin_mem->kin_uscale, + kin_mem->kin_fval, kin_mem->kin_fscale, + z, kinls_mem->pdata); + kinls_mem->nps++; + return(retval); +} + + +/*------------------------------------------------------------------ + kinLsDQJac + + This routine is a wrapper for the Dense and Band implementations + of the difference quotient Jacobian approximation routines. + ------------------------------------------------------------------*/ +int kinLsDQJac(N_Vector u, N_Vector fu, SUNMatrix Jac, + void *kinmem, N_Vector tmp1, N_Vector tmp2) +{ + KINMem kin_mem; + int retval; + + /* access KINMem structure */ + if (kinmem == NULL) { + KINProcessError(NULL, KINLS_MEM_NULL, "KINLS", + "kinLsDQJac", MSG_LS_KINMEM_NULL); + return(KINLS_MEM_NULL); + } + kin_mem = (KINMem) kinmem; + + /* verify that Jac is non-NULL */ + if (Jac == NULL) { + KINProcessError(kin_mem, KINLS_LMEM_NULL, "KINLS", + "kinLsDQJac", MSG_LS_LMEM_NULL); + return(KINLS_LMEM_NULL); + } + + /* Call the matrix-structure-specific DQ approximation routine */ + if (SUNMatGetID(Jac) == SUNMATRIX_DENSE) { + retval = kinLsDenseDQJac(u, fu, Jac, kin_mem, tmp1, tmp2); + } else if (SUNMatGetID(Jac) == SUNMATRIX_BAND) { + retval = kinLsBandDQJac(u, fu, Jac, kin_mem, tmp1, tmp2); + } else { + KINProcessError(kin_mem, KIN_ILL_INPUT, "KINLS", "kinLsDQJac", + "unrecognized matrix type for kinLsDQJac"); + retval = KIN_ILL_INPUT; + } + return(retval); +} + + +/*------------------------------------------------------------------ + kinLsDenseDQJac + + This routine generates a dense difference quotient approximation + to the Jacobian of F(u). It assumes a dense SUNMatrix input + stored column-wise, and that elements within each column are + contiguous. The address of the jth column of J is obtained via + the function SUNDenseMatrix_Column() and this pointer is + associated with an N_Vector using the N_VGetArrayPointer and + N_VSetArrayPointer functions. Finally, the actual computation of + the jth column of the Jacobian is done with a call to N_VLinearSum. + + The increment used in the finite-difference approximation + J_ij = ( F_i(u+sigma_j * e_j) - F_i(u) ) / sigma_j + is + sigma_j = max{|u_j|, |1/uscale_j|} * sqrt(uround) + + Note: uscale_j = 1/typ(u_j) + + NOTE: Any type of failure of the system function here leads to an + unrecoverable failure of the Jacobian function and thus of + the linear solver setup function, stopping KINSOL. + ------------------------------------------------------------------*/ +int kinLsDenseDQJac(N_Vector u, N_Vector fu, SUNMatrix Jac, + KINMem kin_mem, N_Vector tmp1, N_Vector tmp2) +{ + realtype inc, inc_inv, ujsaved, ujscale, sign; + realtype *tmp2_data, *u_data, *uscale_data; + N_Vector ftemp, jthCol; + sunindextype j, N; + KINLsMem kinls_mem; + int retval = 0; + + /* access LsMem interface structure */ + kinls_mem = (KINLsMem) kin_mem->kin_lmem; + + /* access matrix dimension */ + N = SUNDenseMatrix_Rows(Jac); + + /* 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 u and uscale */ + u_data = N_VGetArrayPointer(u); + uscale_data = N_VGetArrayPointer(kin_mem->kin_uscale); + + /* This is the only for loop for 0..N-1 in KINSOL */ + + for (j = 0; j < N; j++) { + + /* Generate the jth col of J(u) */ + + /* Set data address of jthCol, and save u_j values and scaling */ + N_VSetArrayPointer(SUNDenseMatrix_Column(Jac,j), jthCol); + ujsaved = u_data[j]; + ujscale = ONE/uscale_data[j]; + + /* Compute increment */ + sign = (ujsaved >= ZERO) ? ONE : -ONE; + inc = kin_mem->kin_sqrt_relfunc*SUNMAX(SUNRabs(ujsaved), ujscale)*sign; + + /* Increment u_j, call F(u), and return if error occurs */ + u_data[j] += inc; + + retval = kin_mem->kin_func(u, ftemp, kin_mem->kin_user_data); + kinls_mem->nfeDQ++; + if (retval != 0) break; + + /* reset u_j */ + u_data[j] = ujsaved; + + /* Construct difference quotient in jthCol */ + inc_inv = ONE/inc; + N_VLinearSum(inc_inv, ftemp, -inc_inv, fu, jthCol); + } + + /* Restore original array pointer in tmp2 */ + N_VSetArrayPointer(tmp2_data, tmp2); + + return(retval); +} + + +/*------------------------------------------------------------------ + kinLsBandDQJac + + This routine generates a banded difference quotient approximation + to the Jacobian of F(u). It assumes a SUNBandMatrix input 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 + function SUNBandMatrix_Column() and to write a simple for loop to + set each of the elements of a column in succession. + + NOTE: Any type of failure of the system function her leads to an + unrecoverable failure of the Jacobian function and thus of + the linear solver setup function, stopping KINSOL. + ------------------------------------------------------------------*/ +int kinLsBandDQJac(N_Vector u, N_Vector fu, SUNMatrix Jac, + KINMem kin_mem, N_Vector tmp1, N_Vector tmp2) +{ + realtype inc, inc_inv; + N_Vector futemp, utemp; + sunindextype group, i, j, width, ngroups, i1, i2; + sunindextype N, mupper, mlower; + realtype *col_j, *fu_data, *futemp_data, *u_data, *utemp_data, *uscale_data; + KINLsMem kinls_mem; + int retval = 0; + + /* access LsMem interface structure */ + kinls_mem = (KINLsMem) kin_mem->kin_lmem; + + /* access matrix dimensions */ + N = SUNBandMatrix_Columns(Jac); + mupper = SUNBandMatrix_UpperBandwidth(Jac); + mlower = SUNBandMatrix_LowerBandwidth(Jac); + + /* Rename work vectors for use as temporary values of u and fu */ + futemp = tmp1; + utemp = tmp2; + + /* Obtain pointers to the data for ewt, fy, futemp, y, ytemp */ + fu_data = N_VGetArrayPointer(fu); + futemp_data = N_VGetArrayPointer(futemp); + u_data = N_VGetArrayPointer(u); + uscale_data = N_VGetArrayPointer(kin_mem->kin_uscale); + utemp_data = N_VGetArrayPointer(utemp); + + /* Load utemp with u */ + N_VScale(ONE, u, utemp); + + /* Set bandwidth and number of column groups for band differencing */ + width = mlower + mupper + 1; + ngroups = SUNMIN(width, N); + + for (group=1; group <= ngroups; group++) { + + /* Increment all utemp components in group */ + for(j=group-1; j < N; j+=width) { + inc = kin_mem->kin_sqrt_relfunc*SUNMAX(SUNRabs(u_data[j]), + ONE/SUNRabs(uscale_data[j])); + utemp_data[j] += inc; + } + + /* Evaluate f with incremented u */ + retval = kin_mem->kin_func(utemp, futemp, kin_mem->kin_user_data); + if (retval != 0) return(retval); + + /* Restore utemp components, then form and load difference quotients */ + for (j=group-1; j < N; j+=width) { + utemp_data[j] = u_data[j]; + col_j = SUNBandMatrix_Column(Jac, j); + inc = kin_mem->kin_sqrt_relfunc*SUNMAX(SUNRabs(u_data[j]), + ONE/SUNRabs(uscale_data[j])); + inc_inv = ONE/inc; + i1 = SUNMAX(0, j-mupper); + i2 = SUNMIN(j+mlower, N-1); + for (i=i1; i <= i2; i++) + SM_COLUMN_ELEMENT_B(col_j,i,j) = inc_inv * (futemp_data[i] - fu_data[i]); + } + } + + /* Increment counter nfeDQ */ + kinls_mem->nfeDQ += ngroups; + + return(0); +} + + +/*------------------------------------------------------------------ + kinLsDQJtimes + + This routine generates the matrix-vector product z = J*v using a + difference quotient approximation. The approximation is + J*v = [func(uu + sigma*v) - func(uu)]/sigma. Here sigma is based + on the dot products (uscale*uu, uscale*v) and + (uscale*v, uscale*v), the L1Norm(uscale*v), and on sqrt_relfunc + (the square root of the relative error in the function). Note + that v in the argument list has already been both preconditioned + and unscaled. + + NOTE: Unlike the DQ Jacobian functions for direct linear solvers + (which are called from within the lsetup function), this + function is called from within the lsolve function and thus + a recovery may still be possible even if the system function + fails (recoverably). + ------------------------------------------------------------------*/ +int kinLsDQJtimes(N_Vector v, N_Vector Jv, N_Vector u, + booleantype *new_u, void *kinmem) +{ + realtype sigma, sigma_inv, sutsv, sq1norm, sign, vtv; + KINMem kin_mem; + KINLsMem kinls_mem; + int retval; + + /* access KINLsMem structure */ + retval = kinLs_AccessLMem(kinmem, "kinLsDQJtimes", + &kin_mem, &kinls_mem); + if (retval != KIN_SUCCESS) return(retval); + + /* ensure that NVector supplies requisite routines */ + if ( (v->ops->nvprod == NULL) || (v->ops->nvdotprod == NULL) || + (v->ops->nvl1norm == NULL) || (v->ops->nvlinearsum == NULL) ){ + KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", + "kinLsDQJtimes", MSG_LS_BAD_NVECTOR); + return(KINLS_ILL_INPUT); + } + + /* scale the vector v and put Du*v into vtemp1 */ + N_VProd(v, kin_mem->kin_uscale, kin_mem->kin_vtemp1); + + /* scale u and put into Jv (used as a temporary storage) */ + N_VProd(u, kin_mem->kin_uscale, Jv); + + /* compute dot product (Du*u).(Du*v) */ + sutsv = N_VDotProd(Jv, kin_mem->kin_vtemp1); + + /* compute dot product (Du*v).(Du*v) */ + vtv = N_VDotProd(kin_mem->kin_vtemp1, kin_mem->kin_vtemp1); + + /* compute differencing factor -- this is from p. 469, Brown and Saad paper */ + sq1norm = N_VL1Norm(kin_mem->kin_vtemp1); + sign = (sutsv >= ZERO) ? ONE : -ONE ; + sigma = sign*(kin_mem->kin_sqrt_relfunc)*SUNMAX(SUNRabs(sutsv),sq1norm)/vtv; + sigma_inv = ONE/sigma; + + /* compute the u-prime at which to evaluate the function func */ + N_VLinearSum(ONE, u, sigma, v, kin_mem->kin_vtemp1); + + /* call the system function to calculate func(u+sigma*v) */ + retval = kin_mem->kin_func(kin_mem->kin_vtemp1, kin_mem->kin_vtemp2, + kin_mem->kin_user_data); + kinls_mem->nfeDQ++; + if (retval != 0) return(retval); + + /* finish the computation of the difference quotient */ + N_VLinearSum(sigma_inv, kin_mem->kin_vtemp2, -sigma_inv, kin_mem->kin_fval, Jv); + + return(0); +} + + +/*------------------------------------------------------------------ + kinLsInitialize performs remaining initializations specific + to the iterative linear solver interface (and solver itself) + ------------------------------------------------------------------*/ +int kinLsInitialize(KINMem kin_mem) +{ + KINLsMem kinls_mem; + int retval; + + /* Access KINLsMem structure */ + if (kin_mem->kin_lmem == NULL) { + KINProcessError(kin_mem, KINLS_LMEM_NULL, "KINLS", + "kinLsInitialize", MSG_LS_LMEM_NULL); + return(KINLS_LMEM_NULL); + } + kinls_mem = (KINLsMem) kin_mem->kin_lmem; + + /* Test for valid combinations of matrix & Jacobian routines: */ + if (kinls_mem->J == NULL) { + + /* If SUNMatrix A is NULL: ensure 'jac' function pointer is NULL */ + kinls_mem->jacDQ = SUNFALSE; + kinls_mem->jac = NULL; + kinls_mem->J_data = NULL; + + } else if (kinls_mem->jacDQ) { + + /* If J is non-NULL, and 'jac' is not user-supplied: + - if A is dense or band, ensure that our DQ approx. is used + - otherwise => error */ + retval = 0; + if (kinls_mem->J->ops->getid) { + + if ( (SUNMatGetID(kinls_mem->J) == SUNMATRIX_DENSE) || + (SUNMatGetID(kinls_mem->J) == SUNMATRIX_BAND) ) { + kinls_mem->jac = kinLsDQJac; + kinls_mem->J_data = kin_mem; + } else { + retval++; + } + + } else { + retval++; + } + if (retval) { + KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "kinLsInitialize", + "No Jacobian constructor available for SUNMatrix type"); + kinls_mem->last_flag = KINLS_ILL_INPUT; + return(KINLS_ILL_INPUT); + } + + /* check for required vector operations for kinLsDQJac routine */ + if ( (kin_mem->kin_vtemp1->ops->nvlinearsum == NULL) || + (kin_mem->kin_vtemp1->ops->nvscale == NULL) || + (kin_mem->kin_vtemp1->ops->nvgetarraypointer == NULL) || + (kin_mem->kin_vtemp1->ops->nvsetarraypointer == NULL) ) { + KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", + "kinLsInitialize", MSG_LS_BAD_NVECTOR); + return(KINLS_ILL_INPUT); + } + + } else { + + /* If J is non-NULL, and 'jac' is user-supplied, + reset J_data pointer (just in case) */ + kinls_mem->J_data = kin_mem->kin_user_data; + } + + /* Prohibit Picard iteration with DQ Jacobian approximation or difference-quotient J*v */ + if ( (kin_mem->kin_globalstrategy == KIN_PICARD) && + kinls_mem->jacDQ && kinls_mem->jtimesDQ ) { + KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", + "kinLsInitialize", MSG_NOL_FAIL); + return(KINLS_ILL_INPUT); + } + + + /** error-checking is complete, begin initializtions **/ + + /* Initialize counters */ + kinLsInitializeCounters(kinls_mem); + + /* Set Jacobian-related fields, based on jtimesDQ */ + if (kinls_mem->jtimesDQ) { + kinls_mem->jtimes = kinLsDQJtimes; + kinls_mem->jt_data = kin_mem; + } else { + kinls_mem->jt_data = kin_mem->kin_user_data; + } + + /* if J is NULL and: NOT preconditioning or do NOT need to setup the + preconditioner, then set the lsetup function to NULL */ + if (kinls_mem->J == NULL) + if ((kinls_mem->psolve == NULL) || (kinls_mem->pset == NULL)) + kin_mem->kin_lsetup = NULL; + + /* Set scaling vectors assuming RIGHT preconditioning */ + /* NOTE: retval is non-zero only if LS == NULL */ + if (kinls_mem->LS->ops->setscalingvectors) { + retval = SUNLinSolSetScalingVectors(kinls_mem->LS, + kin_mem->kin_fscale, + kin_mem->kin_fscale); + if (retval != SUNLS_SUCCESS) { + KINProcessError(kin_mem, KINLS_SUNLS_FAIL, "KINLS", "kinLsInitialize", + "Error in calling SUNLinSolSetScalingVectors"); + return(KINLS_SUNLS_FAIL); + } + } + + /* If the linear solver is iterative or matrix-iterative, and if left/right + scaling are not supported, we must update linear solver tolerances in an + attempt to account for the fscale vector. We make the following assumptions: + 1. fscale_i = fs_mean, for i=0,...,n-1 (i.e. the weights are homogeneous) + 2. the linear solver uses a basic 2-norm to measure convergence + Hence (using the notation from sunlinsol_spgmr.h, with S = diag(fscale)), + || bbar - Abar xbar ||_2 < tol + <=> || S b - S A x ||_2 < tol + <=> || S (b - A x) ||_2 < tol + <=> \sum_{i=0}^{n-1} (fscale_i (b - A x)_i)^2 < tol^2 + <=> fs_mean^2 \sum_{i=0}^{n-1} (b - A x_i)^2 < tol^2 + <=> \sum_{i=0}^{n-1} (b - A x_i)^2 < tol^2 / fs_mean^2 + <=> || b - A x ||_2 < tol / fs_mean + <=> || b - A x ||_2 < tol * tol_fac + So we compute tol_fac = sqrt(N) / ||fscale||_L2 for scaling desired tolerances */ + if (kinls_mem->iterative && kinls_mem->LS->ops->setscalingvectors == NULL) { + N_VConst(ONE, kin_mem->kin_vtemp1); + kinls_mem->tol_fac = SUNRsqrt(N_VGetLength(kin_mem->kin_vtemp1)) + / N_VWL2Norm(kin_mem->kin_fscale, kin_mem->kin_vtemp1); + } else { + kinls_mem->tol_fac = ONE; + } + + /* Call LS initialize routine, and return result */ + kinls_mem->last_flag = SUNLinSolInitialize(kinls_mem->LS); + return(kinls_mem->last_flag); +} + + +/*------------------------------------------------------------------ + kinLsSetup call the LS setup routine + ------------------------------------------------------------------*/ +int kinLsSetup(KINMem kin_mem) +{ + KINLsMem kinls_mem; + int retval; + + /* Access KINLsMem structure */ + if (kin_mem->kin_lmem == NULL) { + KINProcessError(kin_mem, KINLS_LMEM_NULL, "KINLS", + "kinLsSetup", MSG_LS_LMEM_NULL); + return(KINLS_LMEM_NULL); + } + kinls_mem = (KINLsMem) kin_mem->kin_lmem; + + /* recompute if J if it is non-NULL */ + if (kinls_mem->J) { + + /* Increment nje counter. */ + kinls_mem->nje++; + + /* Clear the linear system matrix if necessary */ + if (SUNLinSolGetType(kinls_mem->LS) == SUNLINEARSOLVER_DIRECT) { + retval = SUNMatZero(kinls_mem->J); + if (retval != 0) { + KINProcessError(kin_mem, KINLS_SUNMAT_FAIL, "KINLS", + "kinLsSetup", MSG_LS_MATZERO_FAILED); + kinls_mem->last_flag = KINLS_SUNMAT_FAIL; + return(kinls_mem->last_flag); + } + } + + /* Call Jacobian routine */ + retval = kinls_mem->jac(kin_mem->kin_uu, kin_mem->kin_fval, + kinls_mem->J, kinls_mem->J_data, + kin_mem->kin_vtemp1, kin_mem->kin_vtemp2); + if (retval != 0) { + KINProcessError(kin_mem, KINLS_JACFUNC_ERR, "KINLS", + "kinLsSetup", MSG_LS_JACFUNC_FAILED); + kinls_mem->last_flag = KINLS_JACFUNC_ERR; + return(kinls_mem->last_flag); + } + + } + + /* Call LS setup routine -- the LS will call kinLsPSetup (if applicable) */ + kinls_mem->last_flag = SUNLinSolSetup(kinls_mem->LS, kinls_mem->J); + + /* save nni value from most recent lsetup call */ + kin_mem->kin_nnilset = kin_mem->kin_nni; + + return(kinls_mem->last_flag); +} + + +/*------------------------------------------------------------------ + kinLsSolve interfaces between KINSOL and the generic + SUNLinearSolver object + ------------------------------------------------------------------*/ +int kinLsSolve(KINMem kin_mem, N_Vector xx, N_Vector bb, + realtype *sJpnorm, realtype *sFdotJp) +{ + KINLsMem kinls_mem; + int nli_inc, retval; + realtype res_norm, tol; + + /* Access KINLsMem structure */ + if (kin_mem->kin_lmem == NULL) { + KINProcessError(kin_mem, KINLS_LMEM_NULL, "KINLS", + "kinLsSolve", MSG_LS_LMEM_NULL); + return(KINLS_LMEM_NULL); + } + kinls_mem = (KINLsMem) kin_mem->kin_lmem; + + /* Set linear solver tolerance as input value times scaling factor + (to account for possible lack of support for left/right scaling + vectors in SUNLinSol object) */ + tol = kin_mem->kin_eps * kinls_mem->tol_fac; + + /* Set initial guess x = 0 to LS */ + N_VConst(ZERO, xx); + + /* set flag required for user-supplied J*v routine */ + kinls_mem->new_uu = SUNTRUE; + + /* Call solver */ + retval = SUNLinSolSolve(kinls_mem->LS, kinls_mem->J, xx, bb, tol); + + /* Retrieve solver statistics */ + res_norm = ZERO; + if (kinls_mem->LS->ops->resnorm) + res_norm = SUNLinSolResNorm(kinls_mem->LS); + nli_inc = 0; + if (kinls_mem->LS->ops->numiters) + nli_inc = SUNLinSolNumIters(kinls_mem->LS); + + if (kinls_mem->iterative && kin_mem->kin_printfl > 2) + KINPrintInfo(kin_mem, PRNT_NLI, "KINLS", "kinLsSolve", + INFO_NLI, nli_inc); + + /* Increment counters nli and ncfl */ + kinls_mem->nli += nli_inc; + if (retval != SUNLS_SUCCESS) kinls_mem->ncfl++; + + /* Interpret solver return value */ + kinls_mem->last_flag = retval; + + if ( (retval != 0) && (retval != SUNLS_RES_REDUCED) ) { + + switch(retval) { + case SUNLS_ATIMES_FAIL_REC: + case SUNLS_PSOLVE_FAIL_REC: + return(1); + break; + case SUNLS_MEM_NULL: + case SUNLS_ILL_INPUT: + case SUNLS_MEM_FAIL: + case SUNLS_GS_FAIL: + case SUNLS_CONV_FAIL: + case SUNLS_QRFACT_FAIL: + case SUNLS_LUFACT_FAIL: + case SUNLS_QRSOL_FAIL: + break; + case SUNLS_PACKAGE_FAIL_REC: + KINProcessError(kin_mem, SUNLS_PACKAGE_FAIL_REC, "KINLS", + "kinLsSolve", + "Failure in SUNLinSol external package"); + break; + case SUNLS_PACKAGE_FAIL_UNREC: + KINProcessError(kin_mem, SUNLS_PACKAGE_FAIL_UNREC, "KINLS", + "kinLsSolve", + "Failure in SUNLinSol external package"); + break; + case SUNLS_ATIMES_FAIL_UNREC: + KINProcessError(kin_mem, SUNLS_ATIMES_FAIL_UNREC, "KINLS", + "kinLsSolve", MSG_LS_JTIMES_FAILED); + break; + case SUNLS_PSOLVE_FAIL_UNREC: + KINProcessError(kin_mem, SUNLS_PSOLVE_FAIL_UNREC, "KINLS", + "kinLsSolve", MSG_LS_PSOLVE_FAILED); + break; + } + return(retval); + } + + /* SUNLinSolSolve returned SUNLS_SUCCESS or SUNLS_RES_REDUCED */ + + /* Compute auxiliary values for use in the linesearch and in KINForcingTerm. + These will be subsequently corrected if the step is reduced by constraints + or the linesearch. */ + if (kin_mem->kin_globalstrategy != KIN_FP) { + + /* sJpnorm is the norm of the scaled product (scaled by fscale) of the + current Jacobian matrix J and the step vector p (= solution vector xx) */ + if (kin_mem->kin_inexact_ls && kin_mem->kin_etaflag == KIN_ETACHOICE1) { + retval = kinLsATimes(kin_mem, xx, bb); + if (retval > 0) { + kinls_mem->last_flag = SUNLS_ATIMES_FAIL_REC; + return(1); + } + else if (retval < 0) { + kinls_mem->last_flag = SUNLS_ATIMES_FAIL_UNREC; + return(-1); + } + *sJpnorm = N_VWL2Norm(bb, kin_mem->kin_fscale); + } + + /* sFdotJp is the dot product of the scaled f vector and the scaled + vector J*p, where the scaling uses fscale */ + if ((kin_mem->kin_inexact_ls && kin_mem->kin_etaflag == KIN_ETACHOICE1) || + kin_mem->kin_globalstrategy == KIN_LINESEARCH) { + N_VProd(bb, kin_mem->kin_fscale, bb); + N_VProd(bb, kin_mem->kin_fscale, bb); + *sFdotJp = N_VDotProd(kin_mem->kin_fval, bb); + } + } + + if (kin_mem->kin_inexact_ls && kin_mem->kin_printfl > 2) + KINPrintInfo(kin_mem, PRNT_EPS, "KINLS", "kinLsSolve", + INFO_EPS, res_norm, kin_mem->kin_eps); + + return(0); +} + + +/*------------------------------------------------------------------ + kinLsFree frees memory associated with the KINLs system + solver interface + ------------------------------------------------------------------*/ +int kinLsFree(KINMem kin_mem) +{ + KINLsMem kinls_mem; + + /* Return immediately if kin_mem or kin_mem->kin_lmem are NULL */ + if (kin_mem == NULL) return (KINLS_SUCCESS); + if (kin_mem->kin_lmem == NULL) return(KINLS_SUCCESS); + kinls_mem = (KINLsMem) kin_mem->kin_lmem; + + /* Nullify SUNMatrix pointer */ + kinls_mem->J = NULL; + + /* Free preconditioner memory (if applicable) */ + if (kinls_mem->pfree) kinls_mem->pfree(kin_mem); + + /* free KINLs interface structure */ + free(kin_mem->kin_lmem); + + return(KINLS_SUCCESS); +} + + +/*------------------------------------------------------------------ + kinLsInitializeCounters resets counters for the LS interface + ------------------------------------------------------------------*/ +int kinLsInitializeCounters(KINLsMem kinls_mem) +{ + kinls_mem->nje = 0; + kinls_mem->nfeDQ = 0; + kinls_mem->npe = 0; + kinls_mem->nli = 0; + kinls_mem->nps = 0; + kinls_mem->ncfl = 0; + kinls_mem->njtimes = 0; + return(0); +} + + +/*--------------------------------------------------------------- + kinLs_AccessLMem + + This routine unpacks the kin_mem and ls_mem structures from + void* pointer. If either is missing it returns KINLS_MEM_NULL + or KINLS_LMEM_NULL. + ---------------------------------------------------------------*/ +int kinLs_AccessLMem(void* kinmem, const char *fname, + KINMem *kin_mem, KINLsMem *kinls_mem) +{ + if (kinmem==NULL) { + KINProcessError(NULL, KINLS_MEM_NULL, "KINLS", + fname, MSG_LS_KINMEM_NULL); + return(KINLS_MEM_NULL); + } + *kin_mem = (KINMem) kinmem; + if ((*kin_mem)->kin_lmem==NULL) { + KINProcessError(*kin_mem, KINLS_LMEM_NULL, "KINLS", + fname, MSG_LS_LMEM_NULL); + return(KINLS_LMEM_NULL); + } + *kinls_mem = (KINLsMem) (*kin_mem)->kin_lmem; + return(KINLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + EOF + ---------------------------------------------------------------*/ diff --git a/bazaar/plugin/sundials/src/kinsol/kinsol_ls_impl.h b/bazaar/plugin/sundials/src/kinsol/kinsol_ls_impl.h new file mode 100644 index 000000000..ffcf35ff1 --- /dev/null +++ b/bazaar/plugin/sundials/src/kinsol/kinsol_ls_impl.h @@ -0,0 +1,184 @@ +/*----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * David J. Gardner, Radu Serban and Aaron Collier @ LLNL + *----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *----------------------------------------------------------------- + * Implementation header file for KINSOL's linear solver interface. + *-----------------------------------------------------------------*/ + +#ifndef _KINLS_IMPL_H +#define _KINLS_IMPL_H + +#include +#include "kinsol_impl.h" + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/*------------------------------------------------------------------ + keys for KINPrintInfo (do not use 1 -> conflict with PRNT_RETVAL) + ------------------------------------------------------------------*/ +#define PRNT_NLI 101 +#define PRNT_EPS 102 + + +/*------------------------------------------------------------------ + Types : struct KINLsMemRec, struct *KINLsMem + + The type KINLsMem is a pointer to a KINLsMemRec, which is a + structure containing fields that must be accessible by LS module + routines. + ------------------------------------------------------------------*/ +typedef struct KINLsMemRec { + + /* Linear solver type information */ + booleantype iterative; /* is the solver iterative? */ + booleantype matrixbased; /* is a matrix structure used? */ + + /* Jacobian construction & storage */ + booleantype jacDQ; /* SUNTRUE if using internal DQ Jacobian approx. */ + KINLsJacFn jac; /* Jacobian routine to be called */ + void *J_data; /* J_data is passed to jac */ + + /* Linear solver, matrix and vector objects/pointers */ + SUNLinearSolver LS; /* generic iterative linear solver object */ + SUNMatrix J; /* problem Jacobian */ + + /* Solver tolerance adjustment factor (if needed, see kinLsSolve) */ + realtype tol_fac; + + /* Statistics and associated parameters */ + long int nje; /* no. of calls to jac */ + long int nfeDQ; /* no. of calls to F due to DQ Jacobian or J*v + approximations */ + long int npe; /* npe = total number of precond calls */ + long int nli; /* nli = total number of linear iterations */ + long int nps; /* nps = total number of psolve calls */ + long int ncfl; /* ncfl = total number of convergence failures */ + long int njtimes; /* njtimes = total number of calls to jtimes */ + + booleantype new_uu; /* flag indicating if the iterate has been + updated - the Jacobian must be updated or + reevaluated (meant to be used by a + user-supplied jtimes function */ + + int last_flag; /* last error return flag */ + + /* Preconditioner computation + (a) user-provided: + - pdata == user_data + - pfree == NULL (the user dealocates memory) + (b) internal preconditioner module + - pdata == kin_mem + - pfree == set by the prec. module and called in kinLsFree */ + KINLsPrecSetupFn pset; + KINLsPrecSolveFn psolve; + int (*pfree)(KINMem kin_mem); + void *pdata; + + /* Jacobian times vector compuation + (a) jtimes function provided by the user: + - jt_data == user_data + - jtimesDQ == SUNFALSE + (b) internal jtimes + - jt_data == kin_mem + - jtimesDQ == SUNTRUE */ + booleantype jtimesDQ; + KINLsJacTimesVecFn jtimes; + void *jt_data; + +} *KINLsMem; + + +/*------------------------------------------------------------------ + Prototypes of internal functions + ------------------------------------------------------------------*/ + +/* Interface routines called by system SUNLinearSolvers */ +int kinLsATimes(void *kinmem, N_Vector v, N_Vector z); +int kinLsPSetup(void *kinmem); +int kinLsPSolve(void *kinmem, N_Vector r, N_Vector z, + realtype tol, int lr); + +/* Difference quotient approximation for Jacobian times vector */ +int kinLsDQJtimes(N_Vector v, N_Vector Jv, N_Vector u, + booleantype *new_u, void *data); + +/* Difference-quotient Jacobian approximation routines */ +int kinLsDQJac(N_Vector u, N_Vector fu, SUNMatrix Jac, + void *data, N_Vector tmp1, N_Vector tmp2); + +int kinLsDenseDQJac(N_Vector u, N_Vector fu, SUNMatrix Jac, + KINMem kin_mem, N_Vector tmp1, N_Vector tmp2); + +int kinLsBandDQJac(N_Vector u, N_Vector fu, SUNMatrix Jac, + KINMem kin_mem, N_Vector tmp1, N_Vector tmp2); + +/* Generic linit/lsetup/lsolve/lfree interface routines for KINSOL to call */ +int kinLsInitialize(KINMem kin_mem); +int kinLsSetup(KINMem kin_mem); +int kinLsSolve(KINMem kin_mem, N_Vector x, N_Vector b, + realtype *sJpnorm, realtype *sFdotJp); +int kinLsFree(KINMem kin_mem); + +/* Auxilliary functions */ +int kinLsInitializeCounters(KINLsMem kinls_mem); +int kinLs_AccessLMem(void* kinmem, const char *fname, + KINMem* kin_mem, KINLsMem *kinls_mem); + + +/*------------------------------------------------------------------ + Error messages + ------------------------------------------------------------------*/ + +#define MSG_LS_KINMEM_NULL "KINSOL memory is NULL." +#define MSG_LS_MEM_FAIL "A memory request failed." +#define MSG_LS_BAD_NVECTOR "A required vector operation is not implemented." +#define MSG_LS_LMEM_NULL "Linear solver memory is NULL." +#define MSG_LS_NEG_MAXRS "maxrs < 0 illegal." +#define MSG_LS_BAD_SIZES "Illegal bandwidth parameter(s). Must have 0 <= ml, mu <= N-1." + +#define MSG_LS_JACFUNC_FAILED "The Jacobian routine failed in an unrecoverable manner." +#define MSG_LS_PSET_FAILED "The preconditioner setup routine failed in an unrecoverable manner." +#define MSG_LS_PSOLVE_FAILED "The preconditioner solve routine failed in an unrecoverable manner." +#define MSG_LS_JTIMES_FAILED "The Jacobian x vector routine failed in an unrecoverable manner." +#define MSG_LS_MATZERO_FAILED "The SUNMatZero routine failed in an unrecoverable manner." + + +/*------------------------------------------------------------------ + Info messages + ------------------------------------------------------------------*/ + +#define INFO_NLI "nli_inc = %d" + +#if defined(SUNDIALS_EXTENDED_PRECISION) + +#define INFO_EPS "residual norm = %12.3Lg eps = %12.3Lg" + +#elif defined(SUNDIALS_DOUBLE_PRECISION) + +#define INFO_EPS "residual norm = %12.3lg eps = %12.3lg" + +#else + +#define INFO_EPS "residual norm = %12.3g eps = %12.3g" + +#endif + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/kinsol/kinsol_spils.c b/bazaar/plugin/sundials/src/kinsol/kinsol_spils.c new file mode 100644 index 000000000..0ab96bce0 --- /dev/null +++ b/bazaar/plugin/sundials/src/kinsol/kinsol_spils.c @@ -0,0 +1,73 @@ +/*----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * Scott Cohen, Alan Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + *----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *----------------------------------------------------------------- + * Header file for the deprecated Scaled Preconditioned Iterative + * Linear Solver interface in KINSOL; these routines now just wrap + * the updated KINSOL generic linear solver interface in kinsol_ls.h. + *-----------------------------------------------------------------*/ + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/*================================================================= + Exported Functions (wrappers for equivalent routines in kinsol_ls.h) + =================================================================*/ + +int KINSpilsSetLinearSolver(void *kinmem, SUNLinearSolver LS) +{ return(KINSetLinearSolver(kinmem, LS, NULL)); } + +int KINSpilsSetPreconditioner(void *kinmem, KINSpilsPrecSetupFn psetup, + KINSpilsPrecSolveFn psolve) +{ return(KINSetPreconditioner(kinmem, psetup, psolve)); } + +int KINSpilsSetJacTimesVecFn(void *kinmem, KINSpilsJacTimesVecFn jtv) +{ return(KINSetJacTimesVecFn(kinmem, jtv)); } + +int KINSpilsGetWorkSpace(void *kinmem, long int *lenrwLS, long int *leniwLS) +{ return(KINGetLinWorkSpace(kinmem, lenrwLS, leniwLS)); } + +int KINSpilsGetNumPrecEvals(void *kinmem, long int *npevals) +{ return(KINGetNumPrecEvals(kinmem, npevals)); } + +int KINSpilsGetNumPrecSolves(void *kinmem, long int *npsolves) +{ return(KINGetNumPrecSolves(kinmem, npsolves)); } + +int KINSpilsGetNumLinIters(void *kinmem, long int *nliters) +{ return(KINGetNumLinIters(kinmem, nliters)); } + +int KINSpilsGetNumConvFails(void *kinmem, long int *nlcfails) +{ return(KINGetNumLinConvFails(kinmem, nlcfails)); } + +int KINSpilsGetNumJtimesEvals(void *kinmem, long int *njvevals) +{ return(KINGetNumJtimesEvals(kinmem, njvevals)); } + +int KINSpilsGetNumFuncEvals(void *kinmem, long int *nfevals) +{ return(KINGetNumLinFuncEvals(kinmem, nfevals)); } + +int KINSpilsGetLastFlag(void *kinmem, long int *flag) +{ return(KINGetLastLinFlag(kinmem, flag)); } + +char *KINSpilsGetReturnFlagName(long int flag) +{ return(KINGetLinReturnFlagName(flag)); } + + +#ifdef __cplusplus +} +#endif + diff --git a/bazaar/plugin/sundials/src/nvector/manyvector/fmod/fnvector_manyvector_mod.c b/bazaar/plugin/sundials/src/nvector/manyvector/fmod/fnvector_manyvector_mod.c new file mode 100644 index 000000000..717eae85a --- /dev/null +++ b/bazaar/plugin/sundials/src/nvector/manyvector/fmod/fnvector_manyvector_mod.c @@ -0,0 +1,899 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ + +/* --------------------------------------------------------------- + * Programmer(s): Auto-generated by swig. + * --------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * -------------------------------------------------------------*/ + +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_nvector.h" + + +#include "nvector/nvector_manyvector.h" + +SWIGEXPORT N_Vector _wrap_FN_VNew_ManyVector(int64_t const *farg1, void *farg2) { + N_Vector fresult ; + sunindextype arg1 ; + N_Vector *arg2 = (N_Vector *) 0 ; + N_Vector result; + + arg1 = (sunindextype)(*farg1); + arg2 = (N_Vector *)(farg2); + result = (N_Vector)N_VNew_ManyVector(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT N_Vector _wrap_FN_VGetSubvector_ManyVector(N_Vector farg1, int64_t const *farg2) { + N_Vector fresult ; + N_Vector arg1 = (N_Vector) 0 ; + sunindextype arg2 ; + N_Vector result; + + arg1 = (N_Vector)(farg1); + arg2 = (sunindextype)(*farg2); + result = (N_Vector)N_VGetSubvector_ManyVector(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT double * _wrap_FN_VGetSubvectorArrayPointer_ManyVector(N_Vector farg1, int64_t const *farg2) { + double * fresult ; + N_Vector arg1 = (N_Vector) 0 ; + sunindextype arg2 ; + realtype *result = 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (sunindextype)(*farg2); + result = (realtype *)N_VGetSubvectorArrayPointer_ManyVector(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VSetSubvectorArrayPointer_ManyVector(double *farg1, N_Vector farg2, int64_t const *farg3) { + int fresult ; + realtype *arg1 = (realtype *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + sunindextype arg3 ; + int result; + + arg1 = (realtype *)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (sunindextype)(*farg3); + result = (int)N_VSetSubvectorArrayPointer_ManyVector(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FN_VGetNumSubvectors_ManyVector(N_Vector farg1) { + int64_t fresult ; + N_Vector arg1 = (N_Vector) 0 ; + sunindextype result; + + arg1 = (N_Vector)(farg1); + result = N_VGetNumSubvectors_ManyVector(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VGetVectorID_ManyVector(N_Vector farg1) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector_ID result; + + arg1 = (N_Vector)(farg1); + result = (N_Vector_ID)N_VGetVectorID_ManyVector(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT N_Vector _wrap_FN_VCloneEmpty_ManyVector(N_Vector farg1) { + N_Vector fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector result; + + arg1 = (N_Vector)(farg1); + result = (N_Vector)N_VCloneEmpty_ManyVector(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT N_Vector _wrap_FN_VClone_ManyVector(N_Vector farg1) { + N_Vector fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector result; + + arg1 = (N_Vector)(farg1); + result = (N_Vector)N_VClone_ManyVector(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FN_VDestroy_ManyVector(N_Vector farg1) { + N_Vector arg1 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + N_VDestroy_ManyVector(arg1); +} + + +SWIGEXPORT void _wrap_FN_VSpace_ManyVector(N_Vector farg1, int64_t *farg2, int64_t *farg3) { + N_Vector arg1 = (N_Vector) 0 ; + sunindextype *arg2 = (sunindextype *) 0 ; + sunindextype *arg3 = (sunindextype *) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (sunindextype *)(farg2); + arg3 = (sunindextype *)(farg3); + N_VSpace_ManyVector(arg1,arg2,arg3); +} + + +SWIGEXPORT int64_t _wrap_FN_VGetLength_ManyVector(N_Vector farg1) { + int64_t fresult ; + N_Vector arg1 = (N_Vector) 0 ; + sunindextype result; + + arg1 = (N_Vector)(farg1); + result = N_VGetLength_ManyVector(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_FN_VLinearSum_ManyVector(double const *farg1, N_Vector farg2, double const *farg3, N_Vector farg4, N_Vector farg5) { + realtype arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype arg3 ; + N_Vector arg4 = (N_Vector) 0 ; + N_Vector arg5 = (N_Vector) 0 ; + + arg1 = (realtype)(*farg1); + arg2 = (N_Vector)(farg2); + arg3 = (realtype)(*farg3); + arg4 = (N_Vector)(farg4); + arg5 = (N_Vector)(farg5); + N_VLinearSum_ManyVector(arg1,arg2,arg3,arg4,arg5); +} + + +SWIGEXPORT void _wrap_FN_VConst_ManyVector(double const *farg1, N_Vector farg2) { + realtype arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + + arg1 = (realtype)(*farg1); + arg2 = (N_Vector)(farg2); + N_VConst_ManyVector(arg1,arg2); +} + + +SWIGEXPORT void _wrap_FN_VProd_ManyVector(N_Vector farg1, N_Vector farg2, N_Vector farg3) { + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + N_VProd_ManyVector(arg1,arg2,arg3); +} + + +SWIGEXPORT void _wrap_FN_VDiv_ManyVector(N_Vector farg1, N_Vector farg2, N_Vector farg3) { + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + N_VDiv_ManyVector(arg1,arg2,arg3); +} + + +SWIGEXPORT void _wrap_FN_VScale_ManyVector(double const *farg1, N_Vector farg2, N_Vector farg3) { + realtype arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + + arg1 = (realtype)(*farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + N_VScale_ManyVector(arg1,arg2,arg3); +} + + +SWIGEXPORT void _wrap_FN_VAbs_ManyVector(N_Vector farg1, N_Vector farg2) { + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + N_VAbs_ManyVector(arg1,arg2); +} + + +SWIGEXPORT void _wrap_FN_VInv_ManyVector(N_Vector farg1, N_Vector farg2) { + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + N_VInv_ManyVector(arg1,arg2); +} + + +SWIGEXPORT void _wrap_FN_VAddConst_ManyVector(N_Vector farg1, double const *farg2, N_Vector farg3) { + N_Vector arg1 = (N_Vector) 0 ; + realtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector)(farg3); + N_VAddConst_ManyVector(arg1,arg2,arg3); +} + + +SWIGEXPORT double _wrap_FN_VWrmsNorm_ManyVector(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VWrmsNorm_ManyVector(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VWrmsNormMask_ManyVector(N_Vector farg1, N_Vector farg2, N_Vector farg3) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (realtype)N_VWrmsNormMask_ManyVector(arg1,arg2,arg3); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VWL2Norm_ManyVector(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VWL2Norm_ManyVector(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_FN_VCompare_ManyVector(double const *farg1, N_Vector farg2, N_Vector farg3) { + realtype arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + + arg1 = (realtype)(*farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + N_VCompare_ManyVector(arg1,arg2,arg3); +} + + +SWIGEXPORT int _wrap_FN_VLinearCombination_ManyVector(int const *farg1, double *farg2, void *farg3, N_Vector farg4) { + int fresult ; + int arg1 ; + realtype *arg2 = (realtype *) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype *)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (N_Vector)(farg4); + result = (int)N_VLinearCombination_ManyVector(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VScaleAddMulti_ManyVector(int const *farg1, double *farg2, N_Vector farg3, void *farg4, void *farg5) { + int fresult ; + int arg1 ; + realtype *arg2 = (realtype *) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + N_Vector *arg4 = (N_Vector *) 0 ; + N_Vector *arg5 = (N_Vector *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype *)(farg2); + arg3 = (N_Vector)(farg3); + arg4 = (N_Vector *)(farg4); + arg5 = (N_Vector *)(farg5); + result = (int)N_VScaleAddMulti_ManyVector(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VDotProdMulti_ManyVector(int const *farg1, N_Vector farg2, void *farg3, double *farg4) { + int fresult ; + int arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + realtype *arg4 = (realtype *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (realtype *)(farg4); + result = (int)N_VDotProdMulti_ManyVector(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VLinearSumVectorArray_ManyVector(int const *farg1, double const *farg2, void *farg3, double const *farg4, void *farg5, void *farg6) { + int fresult ; + int arg1 ; + realtype arg2 ; + N_Vector *arg3 = (N_Vector *) 0 ; + realtype arg4 ; + N_Vector *arg5 = (N_Vector *) 0 ; + N_Vector *arg6 = (N_Vector *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (realtype)(*farg4); + arg5 = (N_Vector *)(farg5); + arg6 = (N_Vector *)(farg6); + result = (int)N_VLinearSumVectorArray_ManyVector(arg1,arg2,arg3,arg4,arg5,arg6); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VScaleVectorArray_ManyVector(int const *farg1, double *farg2, void *farg3, void *farg4) { + int fresult ; + int arg1 ; + realtype *arg2 = (realtype *) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + N_Vector *arg4 = (N_Vector *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype *)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (N_Vector *)(farg4); + result = (int)N_VScaleVectorArray_ManyVector(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VConstVectorArray_ManyVector(int const *farg1, double const *farg2, void *farg3) { + int fresult ; + int arg1 ; + realtype arg2 ; + N_Vector *arg3 = (N_Vector *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector *)(farg3); + result = (int)N_VConstVectorArray_ManyVector(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VWrmsNormVectorArray_ManyVector(int const *farg1, void *farg2, void *farg3, double *farg4) { + int fresult ; + int arg1 ; + N_Vector *arg2 = (N_Vector *) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + realtype *arg4 = (realtype *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (N_Vector *)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (realtype *)(farg4); + result = (int)N_VWrmsNormVectorArray_ManyVector(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VWrmsNormMaskVectorArray_ManyVector(int const *farg1, void *farg2, void *farg3, N_Vector farg4, double *farg5) { + int fresult ; + int arg1 ; + N_Vector *arg2 = (N_Vector *) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + realtype *arg5 = (realtype *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (N_Vector *)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (N_Vector)(farg4); + arg5 = (realtype *)(farg5); + result = (int)N_VWrmsNormMaskVectorArray_ManyVector(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VDotProdLocal_ManyVector(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VDotProdLocal_ManyVector(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VMaxNormLocal_ManyVector(N_Vector farg1) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + result = (realtype)N_VMaxNormLocal_ManyVector(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VMinLocal_ManyVector(N_Vector farg1) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + result = (realtype)N_VMinLocal_ManyVector(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VL1NormLocal_ManyVector(N_Vector farg1) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + result = (realtype)N_VL1NormLocal_ManyVector(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VWSqrSumLocal_ManyVector(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VWSqrSumLocal_ManyVector(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VWSqrSumMaskLocal_ManyVector(N_Vector farg1, N_Vector farg2, N_Vector farg3) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (realtype)N_VWSqrSumMaskLocal_ManyVector(arg1,arg2,arg3); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VInvTestLocal_ManyVector(N_Vector farg1, N_Vector farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (int)N_VInvTestLocal_ManyVector(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VConstrMaskLocal_ManyVector(N_Vector farg1, N_Vector farg2, N_Vector farg3) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)N_VConstrMaskLocal_ManyVector(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VMinQuotientLocal_ManyVector(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VMinQuotientLocal_ManyVector(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableFusedOps_ManyVector(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableFusedOps_ManyVector(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableLinearCombination_ManyVector(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableLinearCombination_ManyVector(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableScaleAddMulti_ManyVector(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableScaleAddMulti_ManyVector(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableDotProdMulti_ManyVector(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableDotProdMulti_ManyVector(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableLinearSumVectorArray_ManyVector(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableLinearSumVectorArray_ManyVector(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableScaleVectorArray_ManyVector(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableScaleVectorArray_ManyVector(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableConstVectorArray_ManyVector(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableConstVectorArray_ManyVector(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableWrmsNormVectorArray_ManyVector(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableWrmsNormVectorArray_ManyVector(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableWrmsNormMaskVectorArray_ManyVector(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableWrmsNormMaskVectorArray_ManyVector(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/nvector/manyvector/nvector_manyvector.c b/bazaar/plugin/sundials/src/nvector/manyvector/nvector_manyvector.c new file mode 100644 index 000000000..9c72fa7b9 --- /dev/null +++ b/bazaar/plugin/sundials/src/nvector/manyvector/nvector_manyvector.c @@ -0,0 +1,1837 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for the ManyVector implementation + * of the NVECTOR package. + * -----------------------------------------------------------------*/ + +#include +#include +#include +#if SUNDIALS_MPI_ENABLED +#include +#else +#include +#endif + +/* Macro to handle separate MPI-aware/unaware installations */ +#if SUNDIALS_MPI_ENABLED +#define MVAPPEND(fun) fun##_MPIManyVector +#else +#define MVAPPEND(fun) fun##_ManyVector +#endif + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* ----------------------------------------------------------------- + ManyVector content accessor macros + -----------------------------------------------------------------*/ +#if SUNDIALS_MPI_ENABLED +#define MANYVECTOR_CONTENT(v) ( (N_VectorContent_MPIManyVector)(v->content) ) +#define MANYVECTOR_COMM(v) ( MANYVECTOR_CONTENT(v)->comm ) +#else +#define MANYVECTOR_CONTENT(v) ( (N_VectorContent_ManyVector)(v->content) ) +#endif +#define MANYVECTOR_NUM_SUBVECS(v) ( MANYVECTOR_CONTENT(v)->num_subvectors ) +#define MANYVECTOR_GLOBLENGTH(v) ( MANYVECTOR_CONTENT(v)->global_length ) +#define MANYVECTOR_SUBVECS(v) ( MANYVECTOR_CONTENT(v)->subvec_array ) +#define MANYVECTOR_SUBVEC(v,i) ( MANYVECTOR_SUBVECS(v)[i] ) +#define MANYVECTOR_OWN_DATA(v) ( MANYVECTOR_CONTENT(v)->own_data ) + +/* ----------------------------------------------------------------- + Prototypes of utility routines + -----------------------------------------------------------------*/ +static N_Vector ManyVectorClone(N_Vector w, booleantype cloneempty); +#if SUNDIALS_MPI_ENABLED +static int SubvectorMPIRank(N_Vector w); +#endif + +/* ----------------------------------------------------------------- + ManyVector API routines + -----------------------------------------------------------------*/ + +#if SUNDIALS_MPI_ENABLED + +/* This function creates an MPIManyVector from a set of existing + N_Vector objects, along with a user-created MPI (inter/intra)communicator + that couples all subvectors together. */ +N_Vector N_VMake_MPIManyVector(MPI_Comm comm, sunindextype num_subvectors, + N_Vector *vec_array) +{ + N_Vector v; + N_VectorContent_MPIManyVector content; + sunindextype i, local_length; + int rank, retval; + + /* Check that input N_Vectors are non-NULL */ + if (vec_array == NULL) return(NULL); + for (i=0; iops->nvgetvectorid = N_VGetVectorID_MPIManyVector; + v->ops->nvcloneempty = N_VCloneEmpty_MPIManyVector; + v->ops->nvclone = N_VClone_MPIManyVector; + v->ops->nvdestroy = N_VDestroy_MPIManyVector; + v->ops->nvspace = N_VSpace_MPIManyVector; + v->ops->nvgetcommunicator = N_VGetCommunicator_MPIManyVector; + v->ops->nvgetlength = N_VGetLength_MPIManyVector; + + /* standard vector operations */ + v->ops->nvlinearsum = N_VLinearSum_MPIManyVector; + v->ops->nvconst = N_VConst_MPIManyVector; + v->ops->nvprod = N_VProd_MPIManyVector; + v->ops->nvdiv = N_VDiv_MPIManyVector; + v->ops->nvscale = N_VScale_MPIManyVector; + v->ops->nvabs = N_VAbs_MPIManyVector; + v->ops->nvinv = N_VInv_MPIManyVector; + v->ops->nvaddconst = N_VAddConst_MPIManyVector; + v->ops->nvdotprod = N_VDotProd_MPIManyVector; + v->ops->nvmaxnorm = N_VMaxNorm_MPIManyVector; + v->ops->nvwrmsnorm = N_VWrmsNorm_MPIManyVector; + v->ops->nvwrmsnormmask = N_VWrmsNormMask_MPIManyVector; + v->ops->nvmin = N_VMin_MPIManyVector; + v->ops->nvwl2norm = N_VWL2Norm_MPIManyVector; + v->ops->nvl1norm = N_VL1Norm_MPIManyVector; + v->ops->nvcompare = N_VCompare_MPIManyVector; + v->ops->nvinvtest = N_VInvTest_MPIManyVector; + v->ops->nvconstrmask = N_VConstrMask_MPIManyVector; + v->ops->nvminquotient = N_VMinQuotient_MPIManyVector; + + /* fused vector operations */ + v->ops->nvlinearcombination = N_VLinearCombination_MPIManyVector; + v->ops->nvscaleaddmulti = N_VScaleAddMulti_MPIManyVector; + v->ops->nvdotprodmulti = N_VDotProdMulti_MPIManyVector; + + /* vector array operations */ + v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_MPIManyVector; + v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_MPIManyVector; + + /* local reduction operations */ + v->ops->nvdotprodlocal = N_VDotProdLocal_MPIManyVector; + v->ops->nvmaxnormlocal = N_VMaxNormLocal_MPIManyVector; + v->ops->nvminlocal = N_VMinLocal_MPIManyVector; + v->ops->nvl1normlocal = N_VL1NormLocal_MPIManyVector; + v->ops->nvinvtestlocal = N_VInvTestLocal_MPIManyVector; + v->ops->nvconstrmasklocal = N_VConstrMaskLocal_MPIManyVector; + v->ops->nvminquotientlocal = N_VMinQuotientLocal_MPIManyVector; + v->ops->nvwsqrsumlocal = N_VWSqrSumLocal_MPIManyVector; + v->ops->nvwsqrsummasklocal = N_VWSqrSumMaskLocal_MPIManyVector; + + /* Create content */ + content = NULL; + content = (N_VectorContent_MPIManyVector) malloc(sizeof *content); + if (content == NULL) { N_VDestroy(v); return(NULL); } + + /* Attach content */ + v->content = content; + + /* Attach content components */ + + /* set scalar content entries, and allocate/set subvector array */ + content->comm = MPI_COMM_NULL; + content->num_subvectors = num_subvectors; + content->own_data = SUNFALSE; + content->subvec_array = NULL; + content->subvec_array = (N_Vector *) malloc(num_subvectors * sizeof(N_Vector)); + if (content->subvec_array == NULL) { N_VDestroy(v); return(NULL); } + for (i=0; isubvec_array[i] = vec_array[i]; + + /* duplicate input communicator (if non-NULL) */ + if (comm != MPI_COMM_NULL) { + retval = MPI_Comm_dup(comm, &(content->comm)); + if (retval != MPI_SUCCESS) { N_VDestroy(v); return(NULL); } + } + + /* Determine overall MPIManyVector length: sum contributions from all + subvectors where this rank is the root, then perform reduction */ + local_length = 0; + for (i=0; iops->nvgetlength) { + if (rank == 0) local_length += N_VGetLength(vec_array[i]); + } else { + N_VDestroy(v); + return(NULL); + } + } + if (content->comm != MPI_COMM_NULL) { + retval = MPI_Allreduce(&local_length, &(content->global_length), 1, + MPI_SUNINDEXTYPE, MPI_SUM, content->comm); + if (retval != MPI_SUCCESS) { N_VDestroy(v); return(NULL); } + } else { + content->global_length = local_length; + } + + return(v); +} +#endif + + +#if SUNDIALS_MPI_ENABLED +/* This function creates an MPIManyVector from a set of existing + N_Vector objects, under the requirement that all MPI-aware + sub-vectors use the same MPI communicator (this is verified + internally). If no sub-vector is MPI-aware, then this may be + used to describe data partitioning within a single node, and + a NULL communicator will be created. */ +N_Vector N_VNew_MPIManyVector(sunindextype num_subvectors, + N_Vector *vec_array) +{ + sunindextype i; + booleantype nocommfound; + void* tmpcomm; + MPI_Comm comm, *vcomm; + int retval, comparison; + N_Vector v; + + /* Check that all subvectors have identical MPI communicators (if present) */ + nocommfound = SUNTRUE; + comm = MPI_COMM_NULL; + for (i=0; iops->nvgetvectorid = N_VGetVectorID_ManyVector; + v->ops->nvcloneempty = N_VCloneEmpty_ManyVector; + v->ops->nvclone = N_VClone_ManyVector; + v->ops->nvdestroy = N_VDestroy_ManyVector; + v->ops->nvspace = N_VSpace_ManyVector; + v->ops->nvgetlength = N_VGetLength_ManyVector; + + /* standard vector operations */ + v->ops->nvlinearsum = N_VLinearSum_ManyVector; + v->ops->nvconst = N_VConst_ManyVector; + v->ops->nvprod = N_VProd_ManyVector; + v->ops->nvdiv = N_VDiv_ManyVector; + v->ops->nvscale = N_VScale_ManyVector; + v->ops->nvabs = N_VAbs_ManyVector; + v->ops->nvinv = N_VInv_ManyVector; + v->ops->nvaddconst = N_VAddConst_ManyVector; + v->ops->nvdotprod = N_VDotProdLocal_ManyVector; + v->ops->nvmaxnorm = N_VMaxNormLocal_ManyVector; + v->ops->nvwrmsnorm = N_VWrmsNorm_ManyVector; + v->ops->nvwrmsnormmask = N_VWrmsNormMask_ManyVector; + v->ops->nvmin = N_VMinLocal_ManyVector; + v->ops->nvwl2norm = N_VWL2Norm_ManyVector; + v->ops->nvl1norm = N_VL1NormLocal_ManyVector; + v->ops->nvcompare = N_VCompare_ManyVector; + v->ops->nvinvtest = N_VInvTestLocal_ManyVector; + v->ops->nvconstrmask = N_VConstrMaskLocal_ManyVector; + v->ops->nvminquotient = N_VMinQuotientLocal_ManyVector; + + /* fused vector operations */ + v->ops->nvlinearcombination = N_VLinearCombination_ManyVector; + v->ops->nvscaleaddmulti = N_VScaleAddMulti_ManyVector; + v->ops->nvdotprodmulti = N_VDotProdMulti_ManyVector; + + /* vector array operations */ + v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_ManyVector; + v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_ManyVector; + + /* local reduction operations */ + v->ops->nvdotprodlocal = N_VDotProdLocal_ManyVector; + v->ops->nvmaxnormlocal = N_VMaxNormLocal_ManyVector; + v->ops->nvminlocal = N_VMinLocal_ManyVector; + v->ops->nvl1normlocal = N_VL1NormLocal_ManyVector; + v->ops->nvinvtestlocal = N_VInvTestLocal_ManyVector; + v->ops->nvconstrmasklocal = N_VConstrMaskLocal_ManyVector; + v->ops->nvminquotientlocal = N_VMinQuotientLocal_ManyVector; + v->ops->nvwsqrsumlocal = N_VWSqrSumLocal_ManyVector; + v->ops->nvwsqrsummasklocal = N_VWSqrSumMaskLocal_ManyVector; + + /* Create content */ + content = NULL; + content = (N_VectorContent_ManyVector) malloc(sizeof *content); + if (content == NULL) { N_VDestroy(v); return(NULL); } + + /* Attach content */ + v->content = content; + + /* Attach content components */ + + /* allocate and set subvector array */ + content->num_subvectors = num_subvectors; + content->own_data = SUNFALSE; + + content->subvec_array = NULL; + content->subvec_array = (N_Vector *) malloc(num_subvectors * sizeof(N_Vector)); + if (content->subvec_array == NULL) { N_VDestroy(v); return(NULL); } + + for (i=0; isubvec_array[i] = vec_array[i]; + + /* Determine overall ManyVector length: sum contributions from all subvectors */ + content->global_length = 0; + for (i=0; iops->nvgetlength) { + content->global_length += N_VGetLength(vec_array[i]); + } else { + N_VDestroy(v); + return(NULL); + } + } + + return(v); +} +#endif + + +/* This function returns the vec_num sub-N_Vector from the N_Vector + array. If vec_num is outside of applicable bounds, NULL is returned. */ +N_Vector MVAPPEND(N_VGetSubvector)(N_Vector v, sunindextype vec_num) +{ + if ( (vec_num < 0) || (vec_num > MANYVECTOR_NUM_SUBVECS(v)) ) + return(NULL); + return(MANYVECTOR_SUBVEC(v,vec_num)); +} + + +/* This function returns data pointer for the vec_num sub-N_Vector from + the N_Vector array. If vec_num is outside of applicable bounds, or if + the subvector does not support the N_VGetArrayPointer routine, then + NULL is returned. */ +realtype *MVAPPEND(N_VGetSubvectorArrayPointer)(N_Vector v, sunindextype vec_num) +{ + if ( (vec_num < 0) || (vec_num > MANYVECTOR_NUM_SUBVECS(v)) ) + return(NULL); + if ( MANYVECTOR_SUBVEC(v,vec_num)->ops->nvgetarraypointer == NULL ) + return(NULL); + return(N_VGetArrayPointer(MANYVECTOR_SUBVEC(v,vec_num))); +} + + +/* This function sets the data pointer for the vec_num sub-N_Vector from + the N_Vector array. If vec_num is outside of applicable bounds, or if + the subvector does not support the N_VSetArrayPointer routine, then + -1 is returned; otherwise this routine returns 0. */ +int MVAPPEND(N_VSetSubvectorArrayPointer)(realtype *v_data, N_Vector v, sunindextype vec_num) +{ + if ( (vec_num < 0) || (vec_num > MANYVECTOR_NUM_SUBVECS(v)) ) + return(-1); + if ( MANYVECTOR_SUBVEC(v,vec_num)->ops->nvsetarraypointer == NULL ) + return(-1); + N_VSetArrayPointer(v_data, MANYVECTOR_SUBVEC(v,vec_num)); + return(0); +} + + +/* This function returns the overall number of sub-vectors. + It returns a locally stored integer, and is therefore a local call. */ +sunindextype MVAPPEND(N_VGetNumSubvectors)(N_Vector v) +{ + return(MANYVECTOR_NUM_SUBVECS(v)); +} + + +/* ----------------------------------------------------------------- + ManyVector implementations of generic NVector routines + -----------------------------------------------------------------*/ + +/* Returns vector type ID. Used to identify vector implementation + from abstract N_Vector interface. */ +N_Vector_ID MVAPPEND(N_VGetVectorID)(N_Vector v) +{ +#if SUNDIALS_MPI_ENABLED + return(SUNDIALS_NVEC_MPIMANYVECTOR); +#else + return(SUNDIALS_NVEC_MANYVECTOR); +#endif +} + + +/* Clones a ManyVector, calling CloneEmpty on subvectors. */ +N_Vector MVAPPEND(N_VCloneEmpty)(N_Vector w) +{ + return(ManyVectorClone(w, SUNTRUE)); +} + + +/* Clones a ManyVector, calling Clone on subvectors. */ +N_Vector MVAPPEND(N_VClone)(N_Vector w) +{ + return(ManyVectorClone(w, SUNFALSE)); +} + + +/* Destroys a ManyVector */ +void MVAPPEND(N_VDestroy)(N_Vector v) +{ + sunindextype i; + + if (v == NULL) return; + + /* free content */ + if (v->content != NULL) { + /* if subvectors are owned by v, then Destroy those */ + if ((MANYVECTOR_OWN_DATA(v) == SUNTRUE) && (MANYVECTOR_SUBVECS(v) != NULL)) { + for (i=0; icontent); + v->content = NULL; + } + + /* free ops and vector */ + if (v->ops != NULL) { free(v->ops); v->ops = NULL; } + free(v); v = NULL; + + return; +} + + +/* Returns the space requirements for the ManyVector, by accumulating this + information from all subvectors. */ +void MVAPPEND(N_VSpace)(N_Vector v, sunindextype *lrw, sunindextype *liw) +{ + sunindextype i, lrw1, liw1; + *lrw = 0; + *liw = 0; + for (i=0; iops->nvspace != NULL) { + N_VSpace(MANYVECTOR_SUBVEC(v,i), &lrw1, &liw1); + *lrw += lrw1; + *liw += liw1; + } + } + return; +} + + +#if SUNDIALS_MPI_ENABLED +/* This function retrieves the MPI Communicator from an MPIManyVector object. */ +void *N_VGetCommunicator_MPIManyVector(N_Vector v) +{ + if (MANYVECTOR_COMM(v) == MPI_COMM_NULL) + return NULL; + else + return((void *) &MANYVECTOR_COMM(v)); +} +#else +/* This function retrieves the MPI Communicator from a ManyVector object. */ +void *N_VGetCommunicator_ManyVector(N_Vector v) +{ + return NULL; +} +#endif + + +/* This function retrieves the global length of a ManyVector object. */ +sunindextype MVAPPEND(N_VGetLength)(N_Vector v) +{ + return(MANYVECTOR_GLOBLENGTH(v)); +} + + +/* Performs the linear sum z = a*x + b*y by calling N_VLinearSum on all subvectors; + this routine does not check that x, y and z are ManyVectors, if they have the + same number of subvectors, or if these subvectors are compatible. */ +void MVAPPEND(N_VLinearSum)(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) +{ + sunindextype i; + for (i=0; iops->nvdotprodlocal) { + + sum += N_VDotProdLocal(MANYVECTOR_SUBVEC(x,i), MANYVECTOR_SUBVEC(y,i)); + + /* otherwise, call nvdotprod and root tasks accumulate to overall sum */ + } else { + + contrib = N_VDotProd(MANYVECTOR_SUBVEC(x,i), MANYVECTOR_SUBVEC(y,i)); + + /* get this task's rank in subvector communicator (note: serial + subvectors will result in rank==0) */ + rank = SubvectorMPIRank(MANYVECTOR_SUBVEC(x,i)); + if (rank < 0) return(ZERO); + if (rank == 0) sum += contrib; + + } + +#else + + /* add subvector contribution */ + sum += N_VDotProd(MANYVECTOR_SUBVEC(x,i), MANYVECTOR_SUBVEC(y,i)); + +#endif + + } + + return(sum); +} + + +#if SUNDIALS_MPI_ENABLED +/* Performs the dot product of two ManyVectors by calling N_VDotProdLocal and + combining the results. This routine does not check that x and y are + ManyVectors, if they have the same number of subvectors, or if these + subvectors are compatible. */ +realtype N_VDotProd_MPIManyVector(N_Vector x, N_Vector y) +{ + realtype lsum, gsum; + lsum = gsum = N_VDotProdLocal_MPIManyVector(x,y); + if (MANYVECTOR_COMM(x) != MPI_COMM_NULL) + MPI_Allreduce(&lsum, &gsum, 1, MPI_SUNREALTYPE, MPI_SUM, MANYVECTOR_COMM(x)); + return(gsum); +} +#endif + + +/* Performs the MPI task-local maximum norm of a ManyVector by calling + N_VMaxNormLocal on all subvectors. + + If any subvector does not implement the N_VMaxNormLocal routine (NULL + function pointer), then this routine will call N_VMaxNorm instead. */ +realtype MVAPPEND(N_VMaxNormLocal)(N_Vector x) +{ + sunindextype i; + realtype max, lmax; + + /* initialize output*/ + max = ZERO; + + for (i=0; iops->nvmaxnormlocal) { + + lmax = N_VMaxNormLocal(MANYVECTOR_SUBVEC(x,i)); + max = (max > lmax) ? max : lmax; + + /* otherwise, call nvmaxnorm and accumulate to overall max */ + } else { + + lmax = N_VMaxNorm(MANYVECTOR_SUBVEC(x,i)); + max = (max > lmax) ? max : lmax; + + } + } + + return(max); +} + + +#if SUNDIALS_MPI_ENABLED +/* Performs the maximum norm of a ManyVector by calling N_VMaxNormLocal and + combining the results. */ +realtype N_VMaxNorm_MPIManyVector(N_Vector x) +{ + realtype lmax, gmax; + lmax = gmax = N_VMaxNormLocal_MPIManyVector(x); + if (MANYVECTOR_COMM(x) != MPI_COMM_NULL) + MPI_Allreduce(&lmax, &gmax, 1, MPI_SUNREALTYPE, MPI_MAX, MANYVECTOR_COMM(x)); + return(gmax); +} +#endif + + +/* Performs the MPI task-local weighted squared sum of a ManyVector by calling + N_VWSqrSumLocal on all subvectors; this routine does not check that x and + w are ManyVectors, if they have the same number of subvectors, or if these + subvectors are compatible. + + If any subvector does not implement the N_VWSqrSumLocal routine (NULL + function pointer), then this routine will call N_VWrmsNorm and N_VGetLength + to unravel the squared sum of the subvector components. It will then only + accumulate this to the overall sum if this is the root task for that + subvector's communicator (note: serial vectors are always root task). */ +realtype MVAPPEND(N_VWSqrSumLocal)(N_Vector x, N_Vector w) +{ + sunindextype i, N; + realtype sum, contrib; +#if SUNDIALS_MPI_ENABLED + int rank; +#endif + + /* initialize output*/ + sum = ZERO; + + for (i=0; iops->nvwsqrsumlocal) { + + sum += N_VWSqrSumLocal(MANYVECTOR_SUBVEC(x,i), MANYVECTOR_SUBVEC(w,i)); + + /* otherwise, call nvwrmsnorm, and accumulate to overall sum on root task */ + } else { + + contrib = N_VWrmsNorm(MANYVECTOR_SUBVEC(x,i), MANYVECTOR_SUBVEC(w,i)); + + /* get this task's rank in subvector communicator (note: serial + subvectors will result in rank==0) */ + rank = SubvectorMPIRank(MANYVECTOR_SUBVEC(x,i)); + if (rank < 0) return(ZERO); + if (rank == 0) { + N = N_VGetLength(MANYVECTOR_SUBVEC(x,i)); + sum += (contrib*contrib*N); + } + } + +#else + + /* accumulate subvector contribution to overall sum */ + contrib = N_VWrmsNorm(MANYVECTOR_SUBVEC(x,i), MANYVECTOR_SUBVEC(w,i)); + N = N_VGetLength(MANYVECTOR_SUBVEC(x,i)); + sum += (contrib*contrib*N); + +#endif + + } + + return(sum); +} + + +/* Performs the WRMS norm of a ManyVector by calling N_VWSqrSumLocal and + combining the results; this routine does not check that x and + w are ManyVectors, if they have the same number of subvectors, or if these + subvectors are compatible. */ +realtype MVAPPEND(N_VWrmsNorm)(N_Vector x, N_Vector w) +{ + realtype gsum; +#if SUNDIALS_MPI_ENABLED + realtype lsum; + lsum = gsum = N_VWSqrSumLocal_MPIManyVector(x, w); + if (MANYVECTOR_COMM(x) != MPI_COMM_NULL) + MPI_Allreduce(&lsum, &gsum, 1, MPI_SUNREALTYPE, MPI_SUM, MANYVECTOR_COMM(x)); +#else + gsum = N_VWSqrSumLocal_ManyVector(x, w); +#endif + return(SUNRsqrt(gsum/(MANYVECTOR_GLOBLENGTH(x)))); +} + + +/* Performs the MPI task-local masked weighted squared sum of a ManyVector by + calling N_VWSqrSumMaskLocal on all subvectors; this routine does not check + that x, w and id are ManyVectors, if they have the same number of + subvectors, or if these subvectors are compatible. + + If any subvector does not implement the N_VWSqrSumLocal routine (NULL + function pointer), then this routine will call N_VWrmsNormMask and + N_VGetLength to unravel the masked squared sum of the subvector components. + It will then only accumulate this to the overall sum if this is the root + task for that subvector's communicator (note: serial vectors are always + root task). */ +realtype MVAPPEND(N_VWSqrSumMaskLocal)(N_Vector x, N_Vector w, N_Vector id) +{ + sunindextype i, N; + realtype sum, contrib; +#if SUNDIALS_MPI_ENABLED + int rank; +#endif + + /* initialize output*/ + sum = ZERO; + + for (i=0; iops->nvwsqrsummasklocal) { + + sum += N_VWSqrSumMaskLocal(MANYVECTOR_SUBVEC(x,i), MANYVECTOR_SUBVEC(w,i), + MANYVECTOR_SUBVEC(id,i)); + + /* otherwise, call nvwrmsnormmask, and accumulate to overall sum on root task */ + } else { + + contrib = N_VWrmsNormMask(MANYVECTOR_SUBVEC(x,i), MANYVECTOR_SUBVEC(w,i), + MANYVECTOR_SUBVEC(id,i)); + + /* get this task's rank in subvector communicator (note: serial + subvectors will result in rank==0) */ + rank = SubvectorMPIRank(MANYVECTOR_SUBVEC(x,i)); + if (rank < 0) return(ZERO); + if (rank == 0) { + N = N_VGetLength(MANYVECTOR_SUBVEC(x,i)); + sum += (contrib*contrib*N); + } + } + +#else + + /* accumulate subvector contribution to overall sum */ + contrib = N_VWrmsNormMask(MANYVECTOR_SUBVEC(x,i), MANYVECTOR_SUBVEC(w,i), + MANYVECTOR_SUBVEC(id,i)); + N = N_VGetLength(MANYVECTOR_SUBVEC(x,i)); + sum += (contrib*contrib*N); + +#endif + + } + + return(sum); +} + + +/* Performs the masked WRMS norm of a ManyVector by calling N_VWSqrSumMaskLocal + and combining the results; this routine does not check that x, w and id are + ManyVectors, if they have the same number of subvectors, or if these subvectors + are compatible. */ +realtype MVAPPEND(N_VWrmsNormMask)(N_Vector x, N_Vector w, N_Vector id) +{ + realtype gsum; +#if SUNDIALS_MPI_ENABLED + realtype lsum; + lsum = gsum = N_VWSqrSumMaskLocal_MPIManyVector(x, w, id); + if (MANYVECTOR_COMM(x) != MPI_COMM_NULL) + MPI_Allreduce(&lsum, &gsum, 1, MPI_SUNREALTYPE, MPI_SUM, MANYVECTOR_COMM(x)); +#else + gsum = N_VWSqrSumMaskLocal_ManyVector(x, w, id); +#endif + return(SUNRsqrt(gsum/(MANYVECTOR_GLOBLENGTH(x)))); +} + + +/* Computes the MPI task-local minimum entry of a ManyVector by calling + N_VMinLocal on all subvectors. + + If any subvector does not implement the N_VMinLocal routine (NULL + function pointer), then this routine will call N_VMin instead. */ +realtype MVAPPEND(N_VMinLocal)(N_Vector x) +{ + sunindextype i; + realtype min, lmin; + + /* initialize output*/ + min = BIG_REAL; + + for (i=0; iops->nvminlocal) { + + lmin = N_VMinLocal(MANYVECTOR_SUBVEC(x,i)); + min = (min < lmin) ? min : lmin; + + /* otherwise, call nvmin and accumulate to overall min */ + } else { + + lmin = N_VMin(MANYVECTOR_SUBVEC(x,i)); + min = (min < lmin) ? min : lmin; + + } + } + + return(min); +} + + +#if SUNDIALS_MPI_ENABLED +/* Computes the minimum entry of a ManyVector by calling N_VMinLocal and + combining the results. */ +realtype N_VMin_MPIManyVector(N_Vector x) +{ + realtype lmin, gmin; + lmin = gmin = N_VMinLocal_MPIManyVector(x); + if (MANYVECTOR_COMM(x) != MPI_COMM_NULL) + MPI_Allreduce(&lmin, &gmin, 1, MPI_SUNREALTYPE, MPI_MIN, MANYVECTOR_COMM(x)); + return(gmin); +} +#endif + + +/* Performs the WL2 norm of a ManyVector by calling N_VSqrSumLocal and + 'massaging' the result. This routine does not check that x and w are + ManyVectors, if they have the same number of subvectors, or if these + subvectors are compatible. */ +realtype MVAPPEND(N_VWL2Norm)(N_Vector x, N_Vector w) +{ + realtype gsum; +#if SUNDIALS_MPI_ENABLED + realtype lsum; + lsum = gsum = N_VWSqrSumLocal_MPIManyVector(x, w); + if (MANYVECTOR_COMM(x) != MPI_COMM_NULL) + MPI_Allreduce(&lsum, &gsum, 1, MPI_SUNREALTYPE, MPI_SUM, MANYVECTOR_COMM(x)); +#else + gsum = N_VWSqrSumLocal_ManyVector(x, w); +#endif + return(SUNRsqrt(gsum)); +} + + +/* Performs the MPI task-local L1 norm of a ManyVector by calling N_VL1NormLocal on + all subvectors. If any subvector does not implement the N_VL1NormLocal routine + (NULL function pointer), then this routine will call N_VL1Norm, but only + accumulate the sum if this is the root task for that subvector's + communicator (note: serial vectors are always root task). */ +realtype MVAPPEND(N_VL1NormLocal)(N_Vector x) +{ + sunindextype i; + realtype sum; +#if SUNDIALS_MPI_ENABLED + realtype contrib; + int rank; +#endif + + /* initialize output*/ + sum = ZERO; + + for (i=0; iops->nvl1normlocal) { + + sum += N_VL1NormLocal(MANYVECTOR_SUBVEC(x,i)); + + /* otherwise, call nvl1norm and root tasks accumulate to overall sum */ + } else { + + contrib = N_VL1Norm(MANYVECTOR_SUBVEC(x,i)); + + /* get this task's rank in subvector communicator (note: serial + subvectors will result in rank==0) */ + rank = SubvectorMPIRank(MANYVECTOR_SUBVEC(x,i)); + if (rank < 0) return(ZERO); + if (rank == 0) sum += contrib; + + } + +#else + + /* accumulate subvector contribution to overall sum */ + sum += N_VL1Norm(MANYVECTOR_SUBVEC(x,i)); + +#endif + + } + + return(sum); +} + + +#if SUNDIALS_MPI_ENABLED +/* Performs the L1 norm of a ManyVector by calling N_VL1NormLocal and + combining the results. */ +realtype N_VL1Norm_MPIManyVector(N_Vector x) +{ + realtype lsum, gsum; + lsum = gsum = N_VL1NormLocal_MPIManyVector(x); + if (MANYVECTOR_COMM(x) != MPI_COMM_NULL) + MPI_Allreduce(&lsum, &gsum, 1, MPI_SUNREALTYPE, MPI_SUM, MANYVECTOR_COMM(x)); + return(gsum); +} +#endif + + +/* Performs N_VCompare on all subvectors; this routine does not check that x and z are + ManyVectors, if they have the same number of subvectors, or if these subvectors are + compatible. */ +void MVAPPEND(N_VCompare)(realtype c, N_Vector x, N_Vector z) +{ + sunindextype i; + for (i=0; iops->nvinvtestlocal) { + + subval = N_VInvTestLocal(MANYVECTOR_SUBVEC(x,i), MANYVECTOR_SUBVEC(z,i)); + val = (val && subval); + + /* otherwise, call nvinvtest and accumulate to overall val */ + } else { + + subval = N_VInvTest(MANYVECTOR_SUBVEC(x,i), MANYVECTOR_SUBVEC(z,i)); + val = (val && subval); + + } + } + + return(val); +} + + +#if SUNDIALS_MPI_ENABLED +/* Performs the InvTest for a ManyVector by calling N_VInvTestLocal and + combining the results. This routine does not check that x and z + are ManyVectors, if they have the same number of subvectors, or if these + subvectors are compatible. */ +booleantype N_VInvTest_MPIManyVector(N_Vector x, N_Vector z) +{ + realtype val, gval; + val = gval = (N_VInvTestLocal_MPIManyVector(x, z)) ? ONE : ZERO; + if (MANYVECTOR_COMM(x) != MPI_COMM_NULL) + MPI_Allreduce(&val, &gval, 1, MPI_SUNREALTYPE, MPI_MIN, MANYVECTOR_COMM(x)); + return (gval != ZERO); +} +#endif + + +/* Performs the MPI task-local ConstrMask for a ManyVector by calling N_VConstrMaskLocal + on all subvectors and combining the results appropriately. This routine does not + check that c, x and m are ManyVectors, if they have the same number of subvectors, + or if these subvectors are compatible. + + If any subvector does not implement the N_VConstrMaskLocal routine (NULL + function pointer), then this routine will call N_VConstrMask instead. */ +booleantype MVAPPEND(N_VConstrMaskLocal)(N_Vector c, N_Vector x, N_Vector m) +{ + sunindextype i; + booleantype val, subval; + + /* initialize output*/ + val = SUNTRUE; + + for (i=0; iops->nvconstrmasklocal) { + + subval = N_VConstrMaskLocal(MANYVECTOR_SUBVEC(c,i), MANYVECTOR_SUBVEC(x,i), + MANYVECTOR_SUBVEC(m,i)); + val = (val && subval); + + /* otherwise, call nvconstrmask and accumulate to overall val */ + } else { + + subval = N_VConstrMask(MANYVECTOR_SUBVEC(c,i), MANYVECTOR_SUBVEC(x,i), + MANYVECTOR_SUBVEC(m,i)); + val = (val && subval); + + } + } + + return(val); +} + + +#if SUNDIALS_MPI_ENABLED +/* Performs the ConstrMask for a ManyVector by calling N_VConstrMaskLocal and + combining the results. This routine does not check that c, x and m + are ManyVectors, if they have the same number of subvectors, or if these + subvectors are compatible. */ +booleantype N_VConstrMask_MPIManyVector(N_Vector c, N_Vector x, N_Vector m) +{ + realtype val, gval; + val = gval = (N_VConstrMaskLocal_MPIManyVector(c, x, m)) ? ONE : ZERO; + if (MANYVECTOR_COMM(x) != MPI_COMM_NULL) + MPI_Allreduce(&val, &gval, 1, MPI_SUNREALTYPE, MPI_MIN, MANYVECTOR_COMM(x)); + return (gval != ZERO); +} +#endif + + +/* Performs the MPI task-local MinQuotient for a ManyVector by calling N_VMinQuotientLocal + on all subvectors and combining the results appropriately. This routine does not check + that num and denom are ManyVectors, if they have the same number of subvectors, or if + these subvectors are compatible. + + If any subvector does not implement the N_VMinQuotientLocal routine (NULL + function pointer), then this routine will call N_VMinQuotient instead. */ +realtype MVAPPEND(N_VMinQuotientLocal)(N_Vector num, N_Vector denom) +{ + sunindextype i; + realtype min, lmin; + + /* initialize output*/ + min = BIG_REAL; + + for (i=0; iops->nvminquotientlocal) { + + lmin = N_VMinQuotientLocal(MANYVECTOR_SUBVEC(num,i), + MANYVECTOR_SUBVEC(denom,i)); + min = (min < lmin) ? min : lmin; + + /* otherwise, call nvmin and accumulate to overall min */ + } else { + + lmin = N_VMinQuotient(MANYVECTOR_SUBVEC(num,i), + MANYVECTOR_SUBVEC(denom,i)); + min = (min < lmin) ? min : lmin; + + } + } + + return(min); +} + + +#if SUNDIALS_MPI_ENABLED +/* Performs the MinQuotient for a ManyVector by calling N_VMinQuotientLocal + and combining the results. This routine does not check that num and + denom are ManyVectors, if they have the same number of subvectors, or if + these subvectors are compatible. */ +realtype N_VMinQuotient_MPIManyVector(N_Vector num, N_Vector denom) +{ + realtype lmin, gmin; + lmin = gmin = N_VMinQuotientLocal_MPIManyVector(num, denom); + if (MANYVECTOR_COMM(num) != MPI_COMM_NULL) + MPI_Allreduce(&lmin, &gmin, 1, MPI_SUNREALTYPE, MPI_MIN, MANYVECTOR_COMM(num)); + return(gmin); +} +#endif + + + +/* ----------------------------------------------------------------- + Fused vector operations + ----------------------------------------------------------------- */ + +/* Performs the linear combination z = sum_j c[j]*X[j] by calling + N_VLinearCombination on all subvectors; this routine does not check that z + or the components of X are ManyVectors, if they have the same number of + subvectors, or if these subvectors are compatible. + + NOTE: implementation of this routine is more challenging, due to the + array-of-arrays of N_Vectors that comprise X. This routine will be + passed an array of ManyVectors, so to call the subvector-specific routines + we must unravel the subvectors while retaining an array of outer vectors. */ +int MVAPPEND(N_VLinearCombination)(int nvec, realtype* c, N_Vector* X, N_Vector z) +{ + sunindextype i, j; + int retval; + N_Vector *Xsub; + + /* create array of nvec N_Vector pointers for reuse within loop */ + Xsub = NULL; + Xsub = (N_Vector *) malloc( nvec * sizeof(N_Vector) ); + if (Xsub == NULL) return(1); + + /* perform operation by calling N_VLinearCombination for each subvector */ + for (i=0; i pair */ + for (i=0; iops == NULL) return(-1); + + if (tf) { + /* enable all fused vector operations */ + v->ops->nvlinearcombination = MVAPPEND(N_VLinearCombination); + v->ops->nvscaleaddmulti = MVAPPEND(N_VScaleAddMulti); + v->ops->nvdotprodmulti = MVAPPEND(N_VDotProdMulti); + /* enable all vector array operations */ + v->ops->nvlinearsumvectorarray = MVAPPEND(N_VLinearSumVectorArray); + v->ops->nvscalevectorarray = MVAPPEND(N_VScaleVectorArray); + v->ops->nvconstvectorarray = MVAPPEND(N_VConstVectorArray); + v->ops->nvwrmsnormvectorarray = MVAPPEND(N_VWrmsNormVectorArray); + v->ops->nvwrmsnormmaskvectorarray = MVAPPEND(N_VWrmsNormMaskVectorArray); + v->ops->nvscaleaddmultivectorarray = NULL; + v->ops->nvlinearcombinationvectorarray = NULL; + } else { + /* disable all fused vector operations */ + v->ops->nvlinearcombination = NULL; + v->ops->nvscaleaddmulti = NULL; + v->ops->nvdotprodmulti = NULL; + /* disable all vector array operations */ + v->ops->nvlinearsumvectorarray = NULL; + v->ops->nvscalevectorarray = NULL; + v->ops->nvconstvectorarray = NULL; + v->ops->nvwrmsnormvectorarray = NULL; + v->ops->nvwrmsnormmaskvectorarray = NULL; + v->ops->nvscaleaddmultivectorarray = NULL; + v->ops->nvlinearcombinationvectorarray = NULL; + } + + /* return success */ + return(0); +} + + +int MVAPPEND(N_VEnableLinearCombination)(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvlinearcombination = MVAPPEND(N_VLinearCombination); + else + v->ops->nvlinearcombination = NULL; + + /* return success */ + return(0); +} + +int MVAPPEND(N_VEnableScaleAddMulti)(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvscaleaddmulti = MVAPPEND(N_VScaleAddMulti); + else + v->ops->nvscaleaddmulti = NULL; + + /* return success */ + return(0); +} + +int MVAPPEND(N_VEnableDotProdMulti)(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvdotprodmulti = MVAPPEND(N_VDotProdMulti); + else + v->ops->nvdotprodmulti = NULL; + + /* return success */ + return(0); +} + +int MVAPPEND(N_VEnableLinearSumVectorArray)(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvlinearsumvectorarray = MVAPPEND(N_VLinearSumVectorArray); + else + v->ops->nvlinearsumvectorarray = NULL; + + /* return success */ + return(0); +} + +int MVAPPEND(N_VEnableScaleVectorArray)(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvscalevectorarray = MVAPPEND(N_VScaleVectorArray); + else + v->ops->nvscalevectorarray = NULL; + + /* return success */ + return(0); +} + +int MVAPPEND(N_VEnableConstVectorArray)(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvconstvectorarray = MVAPPEND(N_VConstVectorArray); + else + v->ops->nvconstvectorarray = NULL; + + /* return success */ + return(0); +} + +int MVAPPEND(N_VEnableWrmsNormVectorArray)(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvwrmsnormvectorarray = MVAPPEND(N_VWrmsNormVectorArray); + else + v->ops->nvwrmsnormvectorarray = NULL; + + /* return success */ + return(0); +} + +int MVAPPEND(N_VEnableWrmsNormMaskVectorArray)(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvwrmsnormmaskvectorarray = MVAPPEND(N_VWrmsNormMaskVectorArray); + else + v->ops->nvwrmsnormmaskvectorarray = NULL; + + /* return success */ + return(0); +} + + +/* ----------------------------------------------------------------- + Implementation of utility routines + -----------------------------------------------------------------*/ + +/* This function performs a generic clone operation on an input N_Vector. + Based on the 'cloneempty' flag it will either call "nvclone" or + "nvcloneempty" when creating subvectors in the cloned vector. */ +static N_Vector ManyVectorClone(N_Vector w, booleantype cloneempty) +{ + N_Vector v; + MVAPPEND(N_VectorContent) content; + sunindextype i; + + if (w == NULL) return(NULL); + + /* Create vector */ + v = NULL; + v = N_VNewEmpty(); + if (v == NULL) return(NULL); + + /* Attach operations */ + if (N_VCopyOps(w, v)) { N_VDestroy(v); return(NULL); } + + /* Create content */ + content = NULL; + content = (MVAPPEND(N_VectorContent)) malloc(sizeof *content); + if (content == NULL) { N_VDestroy(v); return(NULL); } + + /* Attach content and ops to new vector, and return */ + v->content = content; + + /* Attach content components */ + + /* Set scalar components */ +#if SUNDIALS_MPI_ENABLED + content->comm = MPI_COMM_NULL; +#endif + content->num_subvectors = MANYVECTOR_NUM_SUBVECS(w); + content->global_length = MANYVECTOR_GLOBLENGTH(w); + content->own_data = SUNTRUE; + + /* Allocate the subvector array */ + content->subvec_array = NULL; + content->subvec_array = (N_Vector *) malloc(content->num_subvectors * sizeof(N_Vector)); + if (content->subvec_array == NULL) { N_VDestroy(v); return(NULL); } + + /* Initialize the subvector array to NULL */ + for (i=0; inum_subvectors; i++) + content->subvec_array[i] = NULL; + + /* Duplicate the input communicator (if applicable) */ +#if SUNDIALS_MPI_ENABLED + if (MANYVECTOR_COMM(w) != MPI_COMM_NULL) { + if (MPI_Comm_dup(MANYVECTOR_COMM(w), &(content->comm)) != MPI_SUCCESS) + { N_VDestroy(v); return(NULL); } + } +#endif + + /* Clone vectors into the subvector array */ + for (i=0; inum_subvectors; i++) { + if (cloneempty) { + content->subvec_array[i] = N_VCloneEmpty(MANYVECTOR_SUBVEC(w,i)); + } else { + content->subvec_array[i] = N_VClone(MANYVECTOR_SUBVEC(w,i)); + } + if (content->subvec_array[i] == NULL) { + N_VDestroy(v); + return(NULL); + } + } + + return(v); +} + + +#if SUNDIALS_MPI_ENABLED +/* This function returns the rank of this task in the MPI communicator + associated with the input N_Vector. If the input N_Vector is MPI-unaware, it + returns 0. If an error occurs in the call to MPI_Comm_Rank, it returns -1. */ +static int SubvectorMPIRank(N_Vector x) +{ + void* tmpcomm; + MPI_Comm *comm; + int rank, retval; + tmpcomm = N_VGetCommunicator(x); + if (tmpcomm == NULL) return(0); + comm = (MPI_Comm *) tmpcomm; + if ((*comm) == MPI_COMM_NULL) return(0); + retval = MPI_Comm_rank(*comm, &rank); + if (retval != MPI_SUCCESS) return(-1); + return(rank); +} +#endif diff --git a/bazaar/plugin/sundials/src/nvector/serial/fmod/fnvector_serial_mod.c b/bazaar/plugin/sundials/src/nvector/serial/fmod/fnvector_serial_mod.c new file mode 100644 index 000000000..e8f3cae5d --- /dev/null +++ b/bazaar/plugin/sundials/src/nvector/serial/fmod/fnvector_serial_mod.c @@ -0,0 +1,945 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ + +/* --------------------------------------------------------------- + * Programmer(s): Auto-generated by swig. + * --------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * -------------------------------------------------------------*/ + +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_nvector.h" + + +#include "nvector/nvector_serial.h" + +SWIGEXPORT N_Vector _wrap_FN_VNew_Serial(int64_t const *farg1) { + N_Vector fresult ; + sunindextype arg1 ; + N_Vector result; + + arg1 = (sunindextype)(*farg1); + result = (N_Vector)N_VNew_Serial(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT N_Vector _wrap_FN_VNewEmpty_Serial(int64_t const *farg1) { + N_Vector fresult ; + sunindextype arg1 ; + N_Vector result; + + arg1 = (sunindextype)(*farg1); + result = (N_Vector)N_VNewEmpty_Serial(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT N_Vector _wrap_FN_VMake_Serial(int64_t const *farg1, double *farg2) { + N_Vector fresult ; + sunindextype arg1 ; + realtype *arg2 = (realtype *) 0 ; + N_Vector result; + + arg1 = (sunindextype)(*farg1); + arg2 = (realtype *)(farg2); + result = (N_Vector)N_VMake_Serial(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT void * _wrap_FN_VCloneVectorArray_Serial(int const *farg1, N_Vector farg2) { + void * fresult ; + int arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector *result = 0 ; + + arg1 = (int)(*farg1); + arg2 = (N_Vector)(farg2); + result = (N_Vector *)N_VCloneVectorArray_Serial(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT void * _wrap_FN_VCloneVectorArrayEmpty_Serial(int const *farg1, N_Vector farg2) { + void * fresult ; + int arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector *result = 0 ; + + arg1 = (int)(*farg1); + arg2 = (N_Vector)(farg2); + result = (N_Vector *)N_VCloneVectorArrayEmpty_Serial(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FN_VDestroyVectorArray_Serial(void *farg1, int const *farg2) { + N_Vector *arg1 = (N_Vector *) 0 ; + int arg2 ; + + arg1 = (N_Vector *)(farg1); + arg2 = (int)(*farg2); + N_VDestroyVectorArray_Serial(arg1,arg2); +} + + +SWIGEXPORT int64_t _wrap_FN_VGetLength_Serial(N_Vector farg1) { + int64_t fresult ; + N_Vector arg1 = (N_Vector) 0 ; + sunindextype result; + + arg1 = (N_Vector)(farg1); + result = N_VGetLength_Serial(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_FN_VPrint_Serial(N_Vector farg1) { + N_Vector arg1 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + N_VPrint_Serial(arg1); +} + + +SWIGEXPORT void _wrap_FN_VPrintFile_Serial(N_Vector farg1, void *farg2) { + N_Vector arg1 = (N_Vector) 0 ; + FILE *arg2 = (FILE *) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (FILE *)(farg2); + N_VPrintFile_Serial(arg1,arg2); +} + + +SWIGEXPORT int _wrap_FN_VGetVectorID_Serial(N_Vector farg1) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector_ID result; + + arg1 = (N_Vector)(farg1); + result = (N_Vector_ID)N_VGetVectorID_Serial(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT N_Vector _wrap_FN_VCloneEmpty_Serial(N_Vector farg1) { + N_Vector fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector result; + + arg1 = (N_Vector)(farg1); + result = (N_Vector)N_VCloneEmpty_Serial(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT N_Vector _wrap_FN_VClone_Serial(N_Vector farg1) { + N_Vector fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector result; + + arg1 = (N_Vector)(farg1); + result = (N_Vector)N_VClone_Serial(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FN_VDestroy_Serial(N_Vector farg1) { + N_Vector arg1 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + N_VDestroy_Serial(arg1); +} + + +SWIGEXPORT void _wrap_FN_VSpace_Serial(N_Vector farg1, int64_t *farg2, int64_t *farg3) { + N_Vector arg1 = (N_Vector) 0 ; + sunindextype *arg2 = (sunindextype *) 0 ; + sunindextype *arg3 = (sunindextype *) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (sunindextype *)(farg2); + arg3 = (sunindextype *)(farg3); + N_VSpace_Serial(arg1,arg2,arg3); +} + + +SWIGEXPORT double * _wrap_FN_VGetArrayPointer_Serial(N_Vector farg1) { + double * fresult ; + N_Vector arg1 = (N_Vector) 0 ; + realtype *result = 0 ; + + arg1 = (N_Vector)(farg1); + result = (realtype *)N_VGetArrayPointer_Serial(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FN_VSetArrayPointer_Serial(double *farg1, N_Vector farg2) { + realtype *arg1 = (realtype *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + + arg1 = (realtype *)(farg1); + arg2 = (N_Vector)(farg2); + N_VSetArrayPointer_Serial(arg1,arg2); +} + + +SWIGEXPORT void _wrap_FN_VLinearSum_Serial(double const *farg1, N_Vector farg2, double const *farg3, N_Vector farg4, N_Vector farg5) { + realtype arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype arg3 ; + N_Vector arg4 = (N_Vector) 0 ; + N_Vector arg5 = (N_Vector) 0 ; + + arg1 = (realtype)(*farg1); + arg2 = (N_Vector)(farg2); + arg3 = (realtype)(*farg3); + arg4 = (N_Vector)(farg4); + arg5 = (N_Vector)(farg5); + N_VLinearSum_Serial(arg1,arg2,arg3,arg4,arg5); +} + + +SWIGEXPORT void _wrap_FN_VConst_Serial(double const *farg1, N_Vector farg2) { + realtype arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + + arg1 = (realtype)(*farg1); + arg2 = (N_Vector)(farg2); + N_VConst_Serial(arg1,arg2); +} + + +SWIGEXPORT void _wrap_FN_VProd_Serial(N_Vector farg1, N_Vector farg2, N_Vector farg3) { + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + N_VProd_Serial(arg1,arg2,arg3); +} + + +SWIGEXPORT void _wrap_FN_VDiv_Serial(N_Vector farg1, N_Vector farg2, N_Vector farg3) { + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + N_VDiv_Serial(arg1,arg2,arg3); +} + + +SWIGEXPORT void _wrap_FN_VScale_Serial(double const *farg1, N_Vector farg2, N_Vector farg3) { + realtype arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + + arg1 = (realtype)(*farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + N_VScale_Serial(arg1,arg2,arg3); +} + + +SWIGEXPORT void _wrap_FN_VAbs_Serial(N_Vector farg1, N_Vector farg2) { + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + N_VAbs_Serial(arg1,arg2); +} + + +SWIGEXPORT void _wrap_FN_VInv_Serial(N_Vector farg1, N_Vector farg2) { + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + N_VInv_Serial(arg1,arg2); +} + + +SWIGEXPORT void _wrap_FN_VAddConst_Serial(N_Vector farg1, double const *farg2, N_Vector farg3) { + N_Vector arg1 = (N_Vector) 0 ; + realtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector)(farg3); + N_VAddConst_Serial(arg1,arg2,arg3); +} + + +SWIGEXPORT double _wrap_FN_VDotProd_Serial(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VDotProd_Serial(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VMaxNorm_Serial(N_Vector farg1) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + result = (realtype)N_VMaxNorm_Serial(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VWrmsNorm_Serial(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VWrmsNorm_Serial(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VWrmsNormMask_Serial(N_Vector farg1, N_Vector farg2, N_Vector farg3) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (realtype)N_VWrmsNormMask_Serial(arg1,arg2,arg3); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VMin_Serial(N_Vector farg1) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + result = (realtype)N_VMin_Serial(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VWL2Norm_Serial(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VWL2Norm_Serial(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VL1Norm_Serial(N_Vector farg1) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + result = (realtype)N_VL1Norm_Serial(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_FN_VCompare_Serial(double const *farg1, N_Vector farg2, N_Vector farg3) { + realtype arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + + arg1 = (realtype)(*farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + N_VCompare_Serial(arg1,arg2,arg3); +} + + +SWIGEXPORT int _wrap_FN_VInvTest_Serial(N_Vector farg1, N_Vector farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (int)N_VInvTest_Serial(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VConstrMask_Serial(N_Vector farg1, N_Vector farg2, N_Vector farg3) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)N_VConstrMask_Serial(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VMinQuotient_Serial(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VMinQuotient_Serial(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VLinearCombination_Serial(int const *farg1, double *farg2, void *farg3, N_Vector farg4) { + int fresult ; + int arg1 ; + realtype *arg2 = (realtype *) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype *)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (N_Vector)(farg4); + result = (int)N_VLinearCombination_Serial(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VScaleAddMulti_Serial(int const *farg1, double *farg2, N_Vector farg3, void *farg4, void *farg5) { + int fresult ; + int arg1 ; + realtype *arg2 = (realtype *) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + N_Vector *arg4 = (N_Vector *) 0 ; + N_Vector *arg5 = (N_Vector *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype *)(farg2); + arg3 = (N_Vector)(farg3); + arg4 = (N_Vector *)(farg4); + arg5 = (N_Vector *)(farg5); + result = (int)N_VScaleAddMulti_Serial(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VDotProdMulti_Serial(int const *farg1, N_Vector farg2, void *farg3, double *farg4) { + int fresult ; + int arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + realtype *arg4 = (realtype *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (realtype *)(farg4); + result = (int)N_VDotProdMulti_Serial(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VLinearSumVectorArray_Serial(int const *farg1, double const *farg2, void *farg3, double const *farg4, void *farg5, void *farg6) { + int fresult ; + int arg1 ; + realtype arg2 ; + N_Vector *arg3 = (N_Vector *) 0 ; + realtype arg4 ; + N_Vector *arg5 = (N_Vector *) 0 ; + N_Vector *arg6 = (N_Vector *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (realtype)(*farg4); + arg5 = (N_Vector *)(farg5); + arg6 = (N_Vector *)(farg6); + result = (int)N_VLinearSumVectorArray_Serial(arg1,arg2,arg3,arg4,arg5,arg6); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VScaleVectorArray_Serial(int const *farg1, double *farg2, void *farg3, void *farg4) { + int fresult ; + int arg1 ; + realtype *arg2 = (realtype *) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + N_Vector *arg4 = (N_Vector *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype *)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (N_Vector *)(farg4); + result = (int)N_VScaleVectorArray_Serial(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VConstVectorArray_Serial(int const *farg1, double const *farg2, void *farg3) { + int fresult ; + int arg1 ; + realtype arg2 ; + N_Vector *arg3 = (N_Vector *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector *)(farg3); + result = (int)N_VConstVectorArray_Serial(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VWrmsNormVectorArray_Serial(int const *farg1, void *farg2, void *farg3, double *farg4) { + int fresult ; + int arg1 ; + N_Vector *arg2 = (N_Vector *) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + realtype *arg4 = (realtype *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (N_Vector *)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (realtype *)(farg4); + result = (int)N_VWrmsNormVectorArray_Serial(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VWrmsNormMaskVectorArray_Serial(int const *farg1, void *farg2, void *farg3, N_Vector farg4, double *farg5) { + int fresult ; + int arg1 ; + N_Vector *arg2 = (N_Vector *) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + realtype *arg5 = (realtype *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (N_Vector *)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (N_Vector)(farg4); + arg5 = (realtype *)(farg5); + result = (int)N_VWrmsNormMaskVectorArray_Serial(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VWSqrSumLocal_Serial(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VWSqrSumLocal_Serial(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VWSqrSumMaskLocal_Serial(N_Vector farg1, N_Vector farg2, N_Vector farg3) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (realtype)N_VWSqrSumMaskLocal_Serial(arg1,arg2,arg3); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableFusedOps_Serial(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableFusedOps_Serial(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableLinearCombination_Serial(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableLinearCombination_Serial(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableScaleAddMulti_Serial(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableScaleAddMulti_Serial(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableDotProdMulti_Serial(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableDotProdMulti_Serial(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableLinearSumVectorArray_Serial(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableLinearSumVectorArray_Serial(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableScaleVectorArray_Serial(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableScaleVectorArray_Serial(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableConstVectorArray_Serial(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableConstVectorArray_Serial(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableWrmsNormVectorArray_Serial(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableWrmsNormVectorArray_Serial(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VEnableWrmsNormMaskVectorArray_Serial(N_Vector farg1, int const *farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (int)N_VEnableWrmsNormMaskVectorArray_Serial(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/nvector/serial/fnvector_serial.c b/bazaar/plugin/sundials/src/nvector/serial/fnvector_serial.c new file mode 100644 index 000000000..c5b5bdea4 --- /dev/null +++ b/bazaar/plugin/sundials/src/nvector/serial/fnvector_serial.c @@ -0,0 +1,154 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * 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" + +/* Define global vector variables */ + +N_Vector F2C_CVODE_vec; +N_Vector F2C_CVODE_vecQ; +N_Vector *F2C_CVODE_vecS; +N_Vector F2C_CVODE_vecB; +N_Vector F2C_CVODE_vecQB; + +N_Vector F2C_IDA_vec; +N_Vector F2C_IDA_vecQ; +N_Vector *F2C_IDA_vecS; +N_Vector F2C_IDA_vecB; +N_Vector F2C_IDA_vecQB; + +N_Vector F2C_KINSOL_vec; + +N_Vector F2C_ARKODE_vec; + +/* Fortran callable interfaces */ + +void FNV_INITS(int *code, long int *N, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vec = NULL; + F2C_CVODE_vec = N_VNewEmpty_Serial((sunindextype)(*N)); + if (F2C_CVODE_vec == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vec = NULL; + F2C_IDA_vec = N_VNewEmpty_Serial((sunindextype)(*N)); + if (F2C_IDA_vec == NULL) *ier = -1; + break; + case FCMIX_KINSOL: + F2C_KINSOL_vec = NULL; + F2C_KINSOL_vec = N_VNewEmpty_Serial((sunindextype)(*N)); + if (F2C_KINSOL_vec == NULL) *ier = -1; + break; + case FCMIX_ARKODE: + F2C_ARKODE_vec = NULL; + F2C_ARKODE_vec = N_VNewEmpty_Serial((sunindextype)(*N)); + if (F2C_ARKODE_vec == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITS_Q(int *code, long int *Nq, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecQ = NULL; + F2C_CVODE_vecQ = N_VNewEmpty_Serial((sunindextype)(*Nq)); + if (F2C_CVODE_vecQ == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecQ = NULL; + F2C_IDA_vecQ = N_VNewEmpty_Serial((sunindextype)(*Nq)); + if (F2C_IDA_vecQ == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITS_B(int *code, long int *NB, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecB = NULL; + F2C_CVODE_vecB = N_VNewEmpty_Serial((sunindextype)(*NB)); + if (F2C_CVODE_vecB == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecB = NULL; + F2C_IDA_vecB = N_VNewEmpty_Serial((sunindextype)(*NB)); + if (F2C_IDA_vecB == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITS_QB(int *code, long int *NqB, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecQB = NULL; + F2C_CVODE_vecQB = N_VNewEmpty_Serial((sunindextype)(*NqB)); + if (F2C_CVODE_vecQB == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecQB = NULL; + F2C_IDA_vecQB = N_VNewEmpty_Serial((sunindextype)(*NqB)); + if (F2C_IDA_vecQB == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITS_S(int *code, int *Ns, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecS = NULL; + F2C_CVODE_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Serial(*Ns, F2C_CVODE_vec); + if (F2C_CVODE_vecS == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecS = NULL; + F2C_IDA_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Serial(*Ns, F2C_IDA_vec); + if (F2C_IDA_vecS == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} diff --git a/bazaar/plugin/sundials/src/nvector/serial/fnvector_serial.h b/bazaar/plugin/sundials/src/nvector/serial/fnvector_serial.h new file mode 100644 index 000000000..5ab7452da --- /dev/null +++ b/bazaar/plugin/sundials/src/nvector/serial/fnvector_serial.h @@ -0,0 +1,92 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * 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 + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#if defined(SUNDIALS_F77_FUNC) +#define FNV_INITS SUNDIALS_F77_FUNC(fnvinits, FNVINITS) +#else +#define FNV_INITS fnvinits_ +#endif + +#if defined(SUNDIALS_F77_FUNC_) + +#define FNV_INITS_Q SUNDIALS_F77_FUNC_(fnvinits_q, FNVINITS_Q) +#define FNV_INITS_S SUNDIALS_F77_FUNC_(fnvinits_s, FNVINITS_S) +#define FNV_INITS_B SUNDIALS_F77_FUNC_(fnvinits_b, FNVINITS_B) +#define FNV_INITS_QB SUNDIALS_F77_FUNC_(fnvinits_qb, FNVINITS_QB) + +#else + +#define FNV_INITS_Q fnvinits_q_ +#define FNV_INITS_S fnvinits_s_ +#define FNV_INITS_B fnvinits_b_ +#define FNV_INITS_QB fnvinits_qb_ + +#endif + +/* Declarations of global variables */ + +extern N_Vector F2C_CVODE_vec; +extern N_Vector F2C_CVODE_vecQ; +extern N_Vector *F2C_CVODE_vecS; +extern N_Vector F2C_CVODE_vecB; +extern N_Vector F2C_CVODE_vecQB; + +extern N_Vector F2C_IDA_vec; +extern N_Vector F2C_IDA_vecQ; +extern N_Vector *F2C_IDA_vecS; +extern N_Vector F2C_IDA_vecB; +extern N_Vector F2C_IDA_vecQB; + +extern N_Vector F2C_KINSOL_vec; + +extern N_Vector F2C_ARKODE_vec; + +/* + * Prototypes of exported functions + * + * FNV_INITS - initializes serial vector operations for main problem + * FNV_INITS_Q - initializes serial vector operations for quadratures + * FNV_INITS_S - initializes serial vector operations for sensitivities + * FNV_INITS_B - initializes serial vector operations for adjoint problem + * FNV_INITS_QB - initializes serial vector operations for adjoint quadratures + * + */ + +void FNV_INITS(int *code, long int *neq, int *ier); +void FNV_INITS_Q(int *code, long int *Nq, int *ier); +void FNV_INITS_S(int *code, int *Ns, int *ier); +void FNV_INITS_B(int *code, long int *NB, int *ier); +void FNV_INITS_QB(int *code, long int *NqB, int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/nvector/serial/nvector_serial.c b/bazaar/plugin/sundials/src/nvector/serial/nvector_serial.c new file mode 100644 index 000000000..5b5dbd6bd --- /dev/null +++ b/bazaar/plugin/sundials/src/nvector/serial/nvector_serial.c @@ -0,0 +1,2117 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for a serial implementation + * of the NVECTOR package. + * -----------------------------------------------------------------*/ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define HALF RCONST(0.5) +#define ONE RCONST(1.0) +#define ONEPT5 RCONST(1.5) + +/* Private functions for special cases of vector operations */ +static void VCopy_Serial(N_Vector x, N_Vector z); /* z=x */ +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-y */ +static void VNeg_Serial(N_Vector x, N_Vector z); /* z=-x */ +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=c(x-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); /* z=ax-y */ +static void Vaxpy_Serial(realtype a, N_Vector x, N_Vector y); /* y <- ax+y */ +static void VScaleBy_Serial(realtype a, N_Vector x); /* x <- ax */ + +/* Private functions for special cases of vector array operations */ +static int VSumVectorArray_Serial(int nvec, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=X+Y */ +static int VDiffVectorArray_Serial(int nvec, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=X-Y */ +static int VScaleSumVectorArray_Serial(int nvec, realtype c, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=c(X+Y) */ +static int VScaleDiffVectorArray_Serial(int nvec, realtype c, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=c(X-Y) */ +static int VLin1VectorArray_Serial(int nvec, realtype a, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=aX+Y */ +static int VLin2VectorArray_Serial(int nvec, realtype a, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=aX-Y */ +static int VaxpyVectorArray_Serial(int nvec, realtype a, N_Vector* X, N_Vector* Y); /* Y <- aX+Y */ + +/* + * ----------------------------------------------------------------- + * exported functions + * ----------------------------------------------------------------- + */ + +/* ---------------------------------------------------------------- + * Returns vector type ID. Used to identify vector implementation + * from abstract N_Vector interface. + */ +N_Vector_ID N_VGetVectorID_Serial(N_Vector v) +{ + return SUNDIALS_NVEC_SERIAL; +} + +/* ---------------------------------------------------------------------------- + * Function to create a new empty serial vector + */ + +N_Vector N_VNewEmpty_Serial(sunindextype length) +{ + N_Vector v; + N_VectorContent_Serial content; + + /* Create an empty vector object */ + v = NULL; + v = N_VNewEmpty(); + if (v == NULL) return(NULL); + + /* Attach operations */ + + /* constructors, destructors, and utility operations */ + v->ops->nvgetvectorid = N_VGetVectorID_Serial; + v->ops->nvclone = N_VClone_Serial; + v->ops->nvcloneempty = N_VCloneEmpty_Serial; + v->ops->nvdestroy = N_VDestroy_Serial; + v->ops->nvspace = N_VSpace_Serial; + v->ops->nvgetarraypointer = N_VGetArrayPointer_Serial; + v->ops->nvsetarraypointer = N_VSetArrayPointer_Serial; + v->ops->nvgetlength = N_VGetLength_Serial; + + /* standard vector operations */ + v->ops->nvlinearsum = N_VLinearSum_Serial; + v->ops->nvconst = N_VConst_Serial; + v->ops->nvprod = N_VProd_Serial; + v->ops->nvdiv = N_VDiv_Serial; + v->ops->nvscale = N_VScale_Serial; + v->ops->nvabs = N_VAbs_Serial; + v->ops->nvinv = N_VInv_Serial; + v->ops->nvaddconst = N_VAddConst_Serial; + v->ops->nvdotprod = N_VDotProd_Serial; + v->ops->nvmaxnorm = N_VMaxNorm_Serial; + v->ops->nvwrmsnormmask = N_VWrmsNormMask_Serial; + v->ops->nvwrmsnorm = N_VWrmsNorm_Serial; + v->ops->nvmin = N_VMin_Serial; + v->ops->nvwl2norm = N_VWL2Norm_Serial; + v->ops->nvl1norm = N_VL1Norm_Serial; + v->ops->nvcompare = N_VCompare_Serial; + v->ops->nvinvtest = N_VInvTest_Serial; + v->ops->nvconstrmask = N_VConstrMask_Serial; + v->ops->nvminquotient = N_VMinQuotient_Serial; + + /* fused and vector array operations are disabled (NULL) by default */ + + /* local reduction operations */ + v->ops->nvdotprodlocal = N_VDotProd_Serial; + v->ops->nvmaxnormlocal = N_VMaxNorm_Serial; + v->ops->nvminlocal = N_VMin_Serial; + v->ops->nvl1normlocal = N_VL1Norm_Serial; + v->ops->nvinvtestlocal = N_VInvTest_Serial; + v->ops->nvconstrmasklocal = N_VConstrMask_Serial; + v->ops->nvminquotientlocal = N_VMinQuotient_Serial; + v->ops->nvwsqrsumlocal = N_VWSqrSumLocal_Serial; + v->ops->nvwsqrsummasklocal = N_VWSqrSumMaskLocal_Serial; + + /* Create content */ + content = NULL; + content = (N_VectorContent_Serial) malloc(sizeof *content); + if (content == NULL) { N_VDestroy(v); return(NULL); } + + /* Attach content */ + v->content = content; + + /* Initialize content */ + content->length = length; + content->own_data = SUNFALSE; + content->data = NULL; + + return(v); +} + +/* ---------------------------------------------------------------------------- + * Function to create a new serial vector + */ + +N_Vector N_VNew_Serial(sunindextype length) +{ + N_Vector v; + realtype *data; + + v = NULL; + v = N_VNewEmpty_Serial(length); + if (v == NULL) return(NULL); + + /* Create data */ + if (length > 0) { + + /* Allocate memory */ + data = NULL; + data = (realtype *) malloc(length * sizeof(realtype)); + if(data == NULL) { N_VDestroy_Serial(v); return(NULL); } + + /* Attach data */ + NV_OWN_DATA_S(v) = SUNTRUE; + NV_DATA_S(v) = data; + + } + + return(v); +} + +/* ---------------------------------------------------------------------------- + * Function to create a serial N_Vector with user data component + */ + +N_Vector N_VMake_Serial(sunindextype length, realtype *v_data) +{ + N_Vector v; + + v = NULL; + v = N_VNewEmpty_Serial(length); + if (v == NULL) return(NULL); + + if (length > 0) { + /* Attach data */ + NV_OWN_DATA_S(v) = SUNFALSE; + NV_DATA_S(v) = v_data; + } + + return(v); +} + +/* ---------------------------------------------------------------------------- + * Function to create an array of new serial vectors. + */ + +N_Vector* N_VCloneVectorArray_Serial(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; j < count; j++) { + vs[j] = NULL; + vs[j] = N_VClone_Serial(w); + if (vs[j] == NULL) { + N_VDestroyVectorArray_Serial(vs, j-1); + return(NULL); + } + } + + return(vs); +} + +/* ---------------------------------------------------------------------------- + * Function to create an array of new serial vectors with NULL data array. + */ + +N_Vector* N_VCloneVectorArrayEmpty_Serial(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; j < count; j++) { + vs[j] = NULL; + vs[j] = N_VCloneEmpty_Serial(w); + if (vs[j] == NULL) { + N_VDestroyVectorArray_Serial(vs, j-1); + return(NULL); + } + } + + return(vs); +} + +/* ---------------------------------------------------------------------------- + * Function to free an array created with N_VCloneVectorArray_Serial + */ + +void N_VDestroyVectorArray_Serial(N_Vector* vs, int count) +{ + int j; + + for (j = 0; j < count; j++) N_VDestroy_Serial(vs[j]); + + free(vs); vs = NULL; + + return; +} + +/* ---------------------------------------------------------------------------- + * Function to return number of vector elements + */ +sunindextype N_VGetLength_Serial(N_Vector v) +{ + return NV_LENGTH_S(v); +} + +/* ---------------------------------------------------------------------------- + * Function to print the a serial vector to stdout + */ + +void N_VPrint_Serial(N_Vector x) +{ + N_VPrintFile_Serial(x, stdout); +} + +/* ---------------------------------------------------------------------------- + * Function to print the a serial vector to outfile + */ + +void N_VPrintFile_Serial(N_Vector x, FILE* outfile) +{ + sunindextype i, N; + realtype *xd; + + xd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + + for (i = 0; i < N; i++) { +#if defined(SUNDIALS_EXTENDED_PRECISION) + fprintf(outfile, "%35.32Lg\n", xd[i]); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + fprintf(outfile, "%19.16g\n", xd[i]); +#else + fprintf(outfile, "%11.8g\n", xd[i]); +#endif + } + fprintf(outfile, "\n"); + + return; +} + +/* + * ----------------------------------------------------------------- + * implementation of vector operations + * ----------------------------------------------------------------- + */ + +N_Vector N_VCloneEmpty_Serial(N_Vector w) +{ + N_Vector v; + N_VectorContent_Serial content; + + if (w == NULL) return(NULL); + + /* Create vector */ + v = NULL; + v = N_VNewEmpty(); + if (v == NULL) return(NULL); + + /* Attach operations */ + if (N_VCopyOps(w, v)) { N_VDestroy(v); return(NULL); } + + /* Create content */ + content = NULL; + content = (N_VectorContent_Serial) malloc(sizeof *content); + if (content == NULL) { N_VDestroy(v); return(NULL); } + + /* Attach content */ + v->content = content; + + /* Initialize content */ + content->length = NV_LENGTH_S(w); + content->own_data = SUNFALSE; + content->data = NULL; + + return(v); +} + +N_Vector N_VClone_Serial(N_Vector w) +{ + N_Vector v; + realtype *data; + sunindextype length; + + v = NULL; + v = N_VCloneEmpty_Serial(w); + if (v == NULL) return(NULL); + + length = NV_LENGTH_S(w); + + /* Create data */ + if (length > 0) { + + /* Allocate memory */ + data = NULL; + data = (realtype *) malloc(length * sizeof(realtype)); + if(data == NULL) { N_VDestroy_Serial(v); return(NULL); } + + /* Attach data */ + NV_OWN_DATA_S(v) = SUNTRUE; + NV_DATA_S(v) = data; + + } + + return(v); +} + +void N_VDestroy_Serial(N_Vector v) +{ + if (v == NULL) return; + + /* free content */ + if (v->content != NULL) { + /* free data array if it's owned by the vector */ + if (NV_OWN_DATA_S(v) && NV_DATA_S(v) != NULL) { + free(NV_DATA_S(v)); + NV_DATA_S(v) = NULL; + } + free(v->content); + v->content = NULL; + } + + /* free ops and vector */ + if (v->ops != NULL) { free(v->ops); v->ops = NULL; } + free(v); v = NULL; + + return; +} + +void N_VSpace_Serial(N_Vector v, sunindextype *lrw, sunindextype *liw) +{ + *lrw = NV_LENGTH_S(v); + *liw = 1; + + return; +} + +realtype *N_VGetArrayPointer_Serial(N_Vector v) +{ + return((realtype *) NV_DATA_S(v)); +} + +void N_VSetArrayPointer_Serial(realtype *v_data, N_Vector v) +{ + if (NV_LENGTH_S(v) > 0) NV_DATA_S(v) = v_data; + + return; +} + +void N_VLinearSum_Serial(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) +{ + 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_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[i] = (a*xd[i])+(b*yd[i]); + + return; +} + +void N_VConst_Serial(realtype c, N_Vector z) +{ + sunindextype i, N; + realtype *zd; + + zd = NULL; + + N = NV_LENGTH_S(z); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) zd[i] = c; + + return; +} + +void N_VProd_Serial(N_Vector x, N_Vector y, N_Vector z) +{ + sunindextype i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + 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[i] = xd[i]*yd[i]; + + return; +} + +void N_VDiv_Serial(N_Vector x, N_Vector y, N_Vector z) +{ + sunindextype i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + 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[i] = xd[i]/yd[i]; + + return; +} + +void N_VScale_Serial(realtype c, N_Vector x, N_Vector z) +{ + sunindextype i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + 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[i] = c*xd[i]; + } + + return; +} + +void N_VAbs_Serial(N_Vector x, N_Vector z) +{ + sunindextype i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = SUNRabs(xd[i]); + + return; +} + +void N_VInv_Serial(N_Vector x, N_Vector z) +{ + sunindextype i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = ONE/xd[i]; + + return; +} + +void N_VAddConst_Serial(N_Vector x, realtype b, N_Vector z) +{ + sunindextype i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]+b; + + return; +} + +realtype N_VDotProd_Serial(N_Vector x, N_Vector y) +{ + sunindextype i, N; + realtype sum, *xd, *yd; + + sum = ZERO; + xd = yd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + + for (i = 0; i < N; i++) + sum += xd[i]*yd[i]; + + return(sum); +} + +realtype N_VMaxNorm_Serial(N_Vector x) +{ + sunindextype i, N; + realtype max, *xd; + + max = ZERO; + xd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + + for (i = 0; i < N; i++) { + if (SUNRabs(xd[i]) > max) max = SUNRabs(xd[i]); + } + + return(max); +} + +realtype N_VWrmsNorm_Serial(N_Vector x, N_Vector w) +{ + return(SUNRsqrt(N_VWSqrSumLocal_Serial(x, w)/(NV_LENGTH_S(x)))); +} + +realtype N_VWSqrSumLocal_Serial(N_Vector x, N_Vector w) +{ + sunindextype i, N; + realtype sum, prodi, *xd, *wd; + + sum = ZERO; + xd = wd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + wd = NV_DATA_S(w); + + for (i = 0; i < N; i++) { + prodi = xd[i]*wd[i]; + sum += SUNSQR(prodi); + } + + return(sum); +} + +realtype N_VWrmsNormMask_Serial(N_Vector x, N_Vector w, N_Vector id) +{ + return(SUNRsqrt(N_VWSqrSumMaskLocal_Serial(x, w, id) / (NV_LENGTH_S(x)))); +} + +realtype N_VWSqrSumMaskLocal_Serial(N_Vector x, N_Vector w, N_Vector id) +{ + sunindextype i, N; + realtype sum, prodi, *xd, *wd, *idd; + + sum = ZERO; + xd = wd = idd = NULL; + + 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 += SUNSQR(prodi); + } + } + + return(sum); +} + +realtype N_VMin_Serial(N_Vector x) +{ + sunindextype i, N; + realtype min, *xd; + + xd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + + min = xd[0]; + + for (i = 1; i < N; i++) { + if (xd[i] < min) min = xd[i]; + } + + return(min); +} + +realtype N_VWL2Norm_Serial(N_Vector x, N_Vector w) +{ + sunindextype i, N; + realtype sum, prodi, *xd, *wd; + + sum = ZERO; + xd = wd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + wd = NV_DATA_S(w); + + for (i = 0; i < N; i++) { + prodi = xd[i]*wd[i]; + sum += SUNSQR(prodi); + } + + return(SUNRsqrt(sum)); +} + +realtype N_VL1Norm_Serial(N_Vector x) +{ + sunindextype i, N; + realtype sum, *xd; + + sum = ZERO; + xd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + + for (i = 0; i= c) ? ONE : ZERO; + } + + return; +} + +booleantype N_VInvTest_Serial(N_Vector x, N_Vector z) +{ + sunindextype i, N; + realtype *xd, *zd; + booleantype no_zero_found; + + xd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + + no_zero_found = SUNTRUE; + for (i = 0; i < N; i++) { + if (xd[i] == ZERO) + no_zero_found = SUNFALSE; + else + zd[i] = ONE/xd[i]; + } + + return no_zero_found; +} + +booleantype N_VConstrMask_Serial(N_Vector c, N_Vector x, N_Vector m) +{ + sunindextype i, N; + realtype temp; + realtype *cd, *xd, *md; + booleantype test; + + cd = xd = md = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + cd = NV_DATA_S(c); + md = NV_DATA_S(m); + + temp = ZERO; + + for (i = 0; i < N; i++) { + md[i] = ZERO; + + /* Continue if no constraints were set for the variable */ + if (cd[i] == ZERO) + continue; + + /* 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 false if any constraint was violated */ + return (temp == ONE) ? SUNFALSE : SUNTRUE; +} + +realtype N_VMinQuotient_Serial(N_Vector num, N_Vector denom) +{ + booleantype notEvenOnce; + sunindextype i, N; + realtype *nd, *dd, min; + + nd = dd = NULL; + + N = NV_LENGTH_S(num); + nd = NV_DATA_S(num); + dd = NV_DATA_S(denom); + + notEvenOnce = SUNTRUE; + min = BIG_REAL; + + for (i = 0; i < N; i++) { + if (dd[i] == ZERO) continue; + else { + if (!notEvenOnce) min = SUNMIN(min, nd[i]/dd[i]); + else { + min = nd[i]/dd[i]; + notEvenOnce = SUNFALSE; + } + } + } + + return(min); +} + + +/* + * ----------------------------------------------------------------- + * fused vector operations + * ----------------------------------------------------------------- + */ + +int N_VLinearCombination_Serial(int nvec, realtype* c, N_Vector* X, N_Vector z) +{ + int i; + sunindextype j, N; + realtype* zd=NULL; + realtype* xd=NULL; + + /* invalid number of vectors */ + if (nvec < 1) return(-1); + + /* should have called N_VScale */ + if (nvec == 1) { + N_VScale_Serial(c[0], X[0], z); + return(0); + } + + /* should have called N_VLinearSum */ + if (nvec == 2) { + N_VLinearSum_Serial(c[0], X[0], c[1], X[1], z); + return(0); + } + + /* get vector length and data array */ + N = NV_LENGTH_S(z); + zd = NV_DATA_S(z); + + /* + * X[0] += c[i]*X[i], i = 1,...,nvec-1 + */ + if ((X[0] == z) && (c[0] == ONE)) { + for (i=1; i ZERO) + nrm[i] += SUNSQR(xd[j] * wd[j]); + } + nrm[i] = SUNRsqrt(nrm[i]/N); + } + + return(0); +} + + +int N_VScaleAddMultiVectorArray_Serial(int nvec, int nsum, realtype* a, + N_Vector* X, N_Vector** Y, N_Vector** Z) +{ + int i, j; + sunindextype k, N; + realtype* xd=NULL; + realtype* yd=NULL; + realtype* zd=NULL; + + int retval; + N_Vector* YY; + N_Vector* ZZ; + + /* invalid number of vectors */ + if (nvec < 1) return(-1); + if (nsum < 1) return(-1); + + /* --------------------------- + * Special cases for nvec == 1 + * --------------------------- */ + + if (nvec == 1) { + + /* should have called N_VLinearSum */ + if (nsum == 1) { + N_VLinearSum_Serial(a[0], X[0], ONE, Y[0][0], Z[0][0]); + return(0); + } + + /* should have called N_VScaleAddMulti */ + YY = (N_Vector*) malloc(nsum * sizeof(N_Vector)); + ZZ = (N_Vector*) malloc(nsum * sizeof(N_Vector)); + + for (j=0; j 1 + * -------------------------- */ + + /* should have called N_VLinearSumVectorArray */ + if (nsum == 1) { + retval = N_VLinearSumVectorArray_Serial(nvec, a[0], X, ONE, Y[0], Z[0]); + return(retval); + } + + /* ---------------------------- + * Compute multiple linear sums + * ---------------------------- */ + + /* get vector length */ + N = NV_LENGTH_S(X[0]); + + /* + * Y[i][j] += a[i] * x[j] + */ + if (Y == Z) { + for (i=0; i 1 + * -------------------------- */ + + /* should have called N_VScaleVectorArray */ + if (nsum == 1) { + + ctmp = (realtype*) malloc(nvec * sizeof(realtype)); + + for (j=0; jops == NULL) return(-1); + + if (tf) { + /* enable all fused vector operations */ + v->ops->nvlinearcombination = N_VLinearCombination_Serial; + v->ops->nvscaleaddmulti = N_VScaleAddMulti_Serial; + v->ops->nvdotprodmulti = N_VDotProdMulti_Serial; + /* enable all vector array operations */ + v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_Serial; + v->ops->nvscalevectorarray = N_VScaleVectorArray_Serial; + v->ops->nvconstvectorarray = N_VConstVectorArray_Serial; + v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_Serial; + v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_Serial; + v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_Serial; + v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_Serial; + } else { + /* disable all fused vector operations */ + v->ops->nvlinearcombination = NULL; + v->ops->nvscaleaddmulti = NULL; + v->ops->nvdotprodmulti = NULL; + /* disable all vector array operations */ + v->ops->nvlinearsumvectorarray = NULL; + v->ops->nvscalevectorarray = NULL; + v->ops->nvconstvectorarray = NULL; + v->ops->nvwrmsnormvectorarray = NULL; + v->ops->nvwrmsnormmaskvectorarray = NULL; + v->ops->nvscaleaddmultivectorarray = NULL; + v->ops->nvlinearcombinationvectorarray = NULL; + } + + /* return success */ + return(0); +} + + +int N_VEnableLinearCombination_Serial(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvlinearcombination = N_VLinearCombination_Serial; + else + v->ops->nvlinearcombination = NULL; + + /* return success */ + return(0); +} + +int N_VEnableScaleAddMulti_Serial(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvscaleaddmulti = N_VScaleAddMulti_Serial; + else + v->ops->nvscaleaddmulti = NULL; + + /* return success */ + return(0); +} + +int N_VEnableDotProdMulti_Serial(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvdotprodmulti = N_VDotProdMulti_Serial; + else + v->ops->nvdotprodmulti = NULL; + + /* return success */ + return(0); +} + +int N_VEnableLinearSumVectorArray_Serial(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_Serial; + else + v->ops->nvlinearsumvectorarray = NULL; + + /* return success */ + return(0); +} + +int N_VEnableScaleVectorArray_Serial(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvscalevectorarray = N_VScaleVectorArray_Serial; + else + v->ops->nvscalevectorarray = NULL; + + /* return success */ + return(0); +} + +int N_VEnableConstVectorArray_Serial(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvconstvectorarray = N_VConstVectorArray_Serial; + else + v->ops->nvconstvectorarray = NULL; + + /* return success */ + return(0); +} + +int N_VEnableWrmsNormVectorArray_Serial(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_Serial; + else + v->ops->nvwrmsnormvectorarray = NULL; + + /* return success */ + return(0); +} + +int N_VEnableWrmsNormMaskVectorArray_Serial(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_Serial; + else + v->ops->nvwrmsnormmaskvectorarray = NULL; + + /* return success */ + return(0); +} + +int N_VEnableScaleAddMultiVectorArray_Serial(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_Serial; + else + v->ops->nvscaleaddmultivectorarray = NULL; + + /* return success */ + return(0); +} + +int N_VEnableLinearCombinationVectorArray_Serial(N_Vector v, booleantype tf) +{ + /* check that vector is non-NULL */ + if (v == NULL) return(-1); + + /* check that ops structure is non-NULL */ + if (v->ops == NULL) return(-1); + + /* enable/disable operation */ + if (tf) + v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_Serial; + else + v->ops->nvlinearcombinationvectorarray = NULL; + + /* return success */ + return(0); +} diff --git a/bazaar/plugin/sundials/src/sundials/fmod/fsundials_futils_mod.c b/bazaar/plugin/sundials/src/sundials/fmod/fsundials_futils_mod.c new file mode 100644 index 000000000..ef44c7d75 --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/fmod/fsundials_futils_mod.c @@ -0,0 +1,255 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ + +/* --------------------------------------------------------------- + * Programmer(s): Auto-generated by swig. + * --------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * -------------------------------------------------------------*/ + +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_futils.h" + + +#include +#ifdef _MSC_VER +# ifndef strtoull +# define strtoull _strtoui64 +# endif +# ifndef strtoll +# define strtoll _strtoi64 +# endif +#endif + + +typedef struct { + void* data; + size_t size; +} SwigArrayWrapper; + + +SWIGINTERN SwigArrayWrapper SwigArrayWrapper_uninitialized() { + SwigArrayWrapper result; + result.data = NULL; + result.size = 0; + return result; +} + +SWIGEXPORT void * _wrap_FSUNDIALSFileOpen(SwigArrayWrapper *farg1, SwigArrayWrapper *farg2) { + void * fresult ; + char *arg1 = (char *) 0 ; + char *arg2 = (char *) 0 ; + FILE *result = 0 ; + + arg1 = (char *)(farg1->data); + arg2 = (char *)(farg2->data); + result = (FILE *)SUNDIALSFileOpen((char const *)arg1,(char const *)arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FSUNDIALSFileClose(void *farg1) { + FILE *arg1 = (FILE *) 0 ; + + arg1 = (FILE *)(farg1); + SUNDIALSFileClose(arg1); +} + + + diff --git a/bazaar/plugin/sundials/src/sundials/fmod/fsundials_linearsolver_mod.c b/bazaar/plugin/sundials/src/sundials/fmod/fsundials_linearsolver_mod.c new file mode 100644 index 000000000..c53fe1bb6 --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/fmod/fsundials_linearsolver_mod.c @@ -0,0 +1,488 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_iterative.h" +#include "sundials/sundials_linearsolver.h" + +SWIGEXPORT int _wrap_FModifiedGS(void *farg1, void *farg2, int const *farg3, int const *farg4, double *farg5) { + int fresult ; + N_Vector *arg1 = (N_Vector *) 0 ; + realtype **arg2 = (realtype **) 0 ; + int arg3 ; + int arg4 ; + realtype *arg5 = (realtype *) 0 ; + int result; + + arg1 = (N_Vector *)(farg1); + arg2 = (realtype **)(farg2); + arg3 = (int)(*farg3); + arg4 = (int)(*farg4); + arg5 = (realtype *)(farg5); + result = (int)ModifiedGS(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FClassicalGS(void *farg1, void *farg2, int const *farg3, int const *farg4, double *farg5, double *farg6, void *farg7) { + int fresult ; + N_Vector *arg1 = (N_Vector *) 0 ; + realtype **arg2 = (realtype **) 0 ; + int arg3 ; + int arg4 ; + realtype *arg5 = (realtype *) 0 ; + realtype *arg6 = (realtype *) 0 ; + N_Vector *arg7 = (N_Vector *) 0 ; + int result; + + arg1 = (N_Vector *)(farg1); + arg2 = (realtype **)(farg2); + arg3 = (int)(*farg3); + arg4 = (int)(*farg4); + arg5 = (realtype *)(farg5); + arg6 = (realtype *)(farg6); + arg7 = (N_Vector *)(farg7); + result = (int)ClassicalGS(arg1,arg2,arg3,arg4,arg5,arg6,arg7); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FQRfact(int const *farg1, void *farg2, double *farg3, int const *farg4) { + int fresult ; + int arg1 ; + realtype **arg2 = (realtype **) 0 ; + realtype *arg3 = (realtype *) 0 ; + int arg4 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype **)(farg2); + arg3 = (realtype *)(farg3); + arg4 = (int)(*farg4); + result = (int)QRfact(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FQRsol(int const *farg1, void *farg2, double *farg3, double *farg4) { + int fresult ; + int arg1 ; + realtype **arg2 = (realtype **) 0 ; + realtype *arg3 = (realtype *) 0 ; + realtype *arg4 = (realtype *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype **)(farg2); + arg3 = (realtype *)(farg3); + arg4 = (realtype *)(farg4); + result = (int)QRsol(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SUNLinearSolver _wrap_FSUNLinSolNewEmpty() { + SUNLinearSolver fresult ; + SUNLinearSolver result; + + result = (SUNLinearSolver)SUNLinSolNewEmpty(); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FSUNLinSolFreeEmpty(SUNLinearSolver farg1) { + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + + arg1 = (SUNLinearSolver)(farg1); + SUNLinSolFreeEmpty(arg1); +} + + +SWIGEXPORT int _wrap_FSUNLinSolGetType(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNLinearSolver_Type result; + + arg1 = (SUNLinearSolver)(farg1); + result = (SUNLinearSolver_Type)SUNLinSolGetType(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolGetID(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNLinearSolver_ID result; + + arg1 = (SUNLinearSolver)(farg1); + result = (SUNLinearSolver_ID)SUNLinSolGetID(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetATimes(SUNLinearSolver farg1, void *farg2, ATimesFn farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + void *arg2 = (void *) 0 ; + ATimesFn arg3 = (ATimesFn) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (void *)(farg2); + arg3 = (ATimesFn)(farg3); + result = (int)SUNLinSolSetATimes(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetPreconditioner(SUNLinearSolver farg1, void *farg2, PSetupFn farg3, PSolveFn farg4) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + void *arg2 = (void *) 0 ; + PSetupFn arg3 = (PSetupFn) 0 ; + PSolveFn arg4 = (PSolveFn) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (void *)(farg2); + arg3 = (PSetupFn)(farg3); + arg4 = (PSolveFn)(farg4); + result = (int)SUNLinSolSetPreconditioner(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetScalingVectors(SUNLinearSolver farg1, N_Vector farg2, N_Vector farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)SUNLinSolSetScalingVectors(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolInitialize(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolInitialize(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetup(SUNLinearSolver farg1, SUNMatrix farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNLinSolSetup(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSolve(SUNLinearSolver farg1, SUNMatrix farg2, N_Vector farg3, N_Vector farg4, double const *farg5) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + realtype arg5 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (SUNMatrix)(farg2); + arg3 = (N_Vector)(farg3); + arg4 = (N_Vector)(farg4); + arg5 = (realtype)(*farg5); + result = (int)SUNLinSolSolve(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolNumIters(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolNumIters(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FSUNLinSolResNorm(SUNLinearSolver farg1) { + double fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + realtype result; + + arg1 = (SUNLinearSolver)(farg1); + result = (realtype)SUNLinSolResNorm(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT N_Vector _wrap_FSUNLinSolResid(SUNLinearSolver farg1) { + N_Vector fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + N_Vector result; + + arg1 = (SUNLinearSolver)(farg1); + result = (N_Vector)SUNLinSolResid(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNLinSolLastFlag(SUNLinearSolver farg1) { + int64_t fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + sunindextype result; + + arg1 = (SUNLinearSolver)(farg1); + result = SUNLinSolLastFlag(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSpace(SUNLinearSolver farg1, long *farg2, long *farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)SUNLinSolSpace(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolFree(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolFree(arg1); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/sundials/fmod/fsundials_matrix_mod.c b/bazaar/plugin/sundials/src/sundials/fmod/fsundials_matrix_mod.c new file mode 100644 index 000000000..a30b3b5d6 --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/fmod/fsundials_matrix_mod.c @@ -0,0 +1,357 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_matrix.h" + +SWIGEXPORT SUNMatrix _wrap_FSUNMatNewEmpty() { + SUNMatrix fresult ; + SUNMatrix result; + + result = (SUNMatrix)SUNMatNewEmpty(); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FSUNMatFreeEmpty(SUNMatrix farg1) { + SUNMatrix arg1 = (SUNMatrix) 0 ; + + arg1 = (SUNMatrix)(farg1); + SUNMatFreeEmpty(arg1); +} + + +SWIGEXPORT int _wrap_FSUNMatCopyOps(SUNMatrix farg1, SUNMatrix farg2) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNMatCopyOps(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatGetID(SUNMatrix farg1) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + SUNMatrix_ID result; + + arg1 = (SUNMatrix)(farg1); + result = (SUNMatrix_ID)SUNMatGetID(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SUNMatrix _wrap_FSUNMatClone(SUNMatrix farg1) { + SUNMatrix fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + SUNMatrix result; + + arg1 = (SUNMatrix)(farg1); + result = (SUNMatrix)SUNMatClone(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FSUNMatDestroy(SUNMatrix farg1) { + SUNMatrix arg1 = (SUNMatrix) 0 ; + + arg1 = (SUNMatrix)(farg1); + SUNMatDestroy(arg1); +} + + +SWIGEXPORT int _wrap_FSUNMatZero(SUNMatrix farg1) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + result = (int)SUNMatZero(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatCopy(SUNMatrix farg1, SUNMatrix farg2) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNMatCopy(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatScaleAdd(double const *farg1, SUNMatrix farg2, SUNMatrix farg3) { + int fresult ; + realtype arg1 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + SUNMatrix arg3 = (SUNMatrix) 0 ; + int result; + + arg1 = (realtype)(*farg1); + arg2 = (SUNMatrix)(farg2); + arg3 = (SUNMatrix)(farg3); + result = (int)SUNMatScaleAdd(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatScaleAddI(double const *farg1, SUNMatrix farg2) { + int fresult ; + realtype arg1 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (realtype)(*farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNMatScaleAddI(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatMatvecSetup(SUNMatrix farg1) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + result = (int)SUNMatMatvecSetup(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatMatvec(SUNMatrix farg1, N_Vector farg2, N_Vector farg3) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)SUNMatMatvec(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatSpace(SUNMatrix farg1, long *farg2, long *farg3) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)SUNMatSpace(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/sundials/fmod/fsundials_nonlinearsolver_mod.c b/bazaar/plugin/sundials/src/sundials/fmod/fsundials_nonlinearsolver_mod.c new file mode 100644 index 000000000..de8c83860 --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/fmod/fsundials_nonlinearsolver_mod.c @@ -0,0 +1,401 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_nonlinearsolver.h" + +SWIGEXPORT SUNNonlinearSolver _wrap_FSUNNonlinSolNewEmpty() { + SUNNonlinearSolver fresult ; + SUNNonlinearSolver result; + + result = (SUNNonlinearSolver)SUNNonlinSolNewEmpty(); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FSUNNonlinSolFreeEmpty(SUNNonlinearSolver farg1) { + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + + arg1 = (SUNNonlinearSolver)(farg1); + SUNNonlinSolFreeEmpty(arg1); +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolGetType(SUNNonlinearSolver farg1) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + SUNNonlinearSolver_Type result; + + arg1 = (SUNNonlinearSolver)(farg1); + result = (SUNNonlinearSolver_Type)SUNNonlinSolGetType(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolInitialize(SUNNonlinearSolver farg1) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + result = (int)SUNNonlinSolInitialize(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSetup(SUNNonlinearSolver farg1, N_Vector farg2, void *farg3) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + void *arg3 = (void *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (void *)(farg3); + result = (int)SUNNonlinSolSetup(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSolve(SUNNonlinearSolver farg1, N_Vector farg2, N_Vector farg3, N_Vector farg4, double const *farg5, int const *farg6, void *farg7) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + realtype arg5 ; + int arg6 ; + void *arg7 = (void *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + arg4 = (N_Vector)(farg4); + arg5 = (realtype)(*farg5); + arg6 = (int)(*farg6); + arg7 = (void *)(farg7); + result = (int)SUNNonlinSolSolve(arg1,arg2,arg3,arg4,arg5,arg6,arg7); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolFree(SUNNonlinearSolver farg1) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + result = (int)SUNNonlinSolFree(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSetSysFn(SUNNonlinearSolver farg1, SUNNonlinSolSysFn farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + SUNNonlinSolSysFn arg2 = (SUNNonlinSolSysFn) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (SUNNonlinSolSysFn)(farg2); + result = (int)SUNNonlinSolSetSysFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSetLSetupFn(SUNNonlinearSolver farg1, SUNNonlinSolLSetupFn farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + SUNNonlinSolLSetupFn arg2 = (SUNNonlinSolLSetupFn) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (SUNNonlinSolLSetupFn)(farg2); + result = (int)SUNNonlinSolSetLSetupFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSetLSolveFn(SUNNonlinearSolver farg1, SUNNonlinSolLSolveFn farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + SUNNonlinSolLSolveFn arg2 = (SUNNonlinSolLSolveFn) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (SUNNonlinSolLSolveFn)(farg2); + result = (int)SUNNonlinSolSetLSolveFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSetConvTestFn(SUNNonlinearSolver farg1, SUNNonlinSolConvTestFn farg2, void *farg3) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + SUNNonlinSolConvTestFn arg2 = (SUNNonlinSolConvTestFn) 0 ; + void *arg3 = (void *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (SUNNonlinSolConvTestFn)(farg2); + arg3 = (void *)(farg3); + result = (int)SUNNonlinSolSetConvTestFn(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSetMaxIters(SUNNonlinearSolver farg1, int const *farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNNonlinSolSetMaxIters(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolGetNumIters(SUNNonlinearSolver farg1, long *farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (long *)(farg2); + result = (int)SUNNonlinSolGetNumIters(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolGetCurIter(SUNNonlinearSolver farg1, int *farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + int *arg2 = (int *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (int *)(farg2); + result = (int)SUNNonlinSolGetCurIter(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolGetNumConvFails(SUNNonlinearSolver farg1, long *farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (long *)(farg2); + result = (int)SUNNonlinSolGetNumConvFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/sundials/fmod/fsundials_nvector_mod.c b/bazaar/plugin/sundials/src/sundials/fmod/fsundials_nvector_mod.c new file mode 100644 index 000000000..45c0bdac7 --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/fmod/fsundials_nvector_mod.c @@ -0,0 +1,921 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_nvector.h" + +SWIGEXPORT N_Vector _wrap_FN_VNewEmpty() { + N_Vector fresult ; + N_Vector result; + + result = (N_Vector)N_VNewEmpty(); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FN_VFreeEmpty(N_Vector farg1) { + N_Vector arg1 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + N_VFreeEmpty(arg1); +} + + +SWIGEXPORT int _wrap_FN_VCopyOps(N_Vector farg1, N_Vector farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (int)N_VCopyOps(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VGetVectorID(N_Vector farg1) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector_ID result; + + arg1 = (N_Vector)(farg1); + result = (N_Vector_ID)N_VGetVectorID(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT N_Vector _wrap_FN_VClone(N_Vector farg1) { + N_Vector fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector result; + + arg1 = (N_Vector)(farg1); + result = (N_Vector)N_VClone(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT N_Vector _wrap_FN_VCloneEmpty(N_Vector farg1) { + N_Vector fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector result; + + arg1 = (N_Vector)(farg1); + result = (N_Vector)N_VCloneEmpty(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FN_VDestroy(N_Vector farg1) { + N_Vector arg1 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + N_VDestroy(arg1); +} + + +SWIGEXPORT void _wrap_FN_VSpace(N_Vector farg1, int64_t *farg2, int64_t *farg3) { + N_Vector arg1 = (N_Vector) 0 ; + sunindextype *arg2 = (sunindextype *) 0 ; + sunindextype *arg3 = (sunindextype *) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (sunindextype *)(farg2); + arg3 = (sunindextype *)(farg3); + N_VSpace(arg1,arg2,arg3); +} + + +SWIGEXPORT double * _wrap_FN_VGetArrayPointer(N_Vector farg1) { + double * fresult ; + N_Vector arg1 = (N_Vector) 0 ; + realtype *result = 0 ; + + arg1 = (N_Vector)(farg1); + result = (realtype *)N_VGetArrayPointer(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FN_VSetArrayPointer(double *farg1, N_Vector farg2) { + realtype *arg1 = (realtype *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + + arg1 = (realtype *)(farg1); + arg2 = (N_Vector)(farg2); + N_VSetArrayPointer(arg1,arg2); +} + + +SWIGEXPORT void * _wrap_FN_VGetCommunicator(N_Vector farg1) { + void * fresult ; + N_Vector arg1 = (N_Vector) 0 ; + void *result = 0 ; + + arg1 = (N_Vector)(farg1); + result = (void *)N_VGetCommunicator(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FN_VGetLength(N_Vector farg1) { + int64_t fresult ; + N_Vector arg1 = (N_Vector) 0 ; + sunindextype result; + + arg1 = (N_Vector)(farg1); + result = N_VGetLength(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_FN_VLinearSum(double const *farg1, N_Vector farg2, double const *farg3, N_Vector farg4, N_Vector farg5) { + realtype arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype arg3 ; + N_Vector arg4 = (N_Vector) 0 ; + N_Vector arg5 = (N_Vector) 0 ; + + arg1 = (realtype)(*farg1); + arg2 = (N_Vector)(farg2); + arg3 = (realtype)(*farg3); + arg4 = (N_Vector)(farg4); + arg5 = (N_Vector)(farg5); + N_VLinearSum(arg1,arg2,arg3,arg4,arg5); +} + + +SWIGEXPORT void _wrap_FN_VConst(double const *farg1, N_Vector farg2) { + realtype arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + + arg1 = (realtype)(*farg1); + arg2 = (N_Vector)(farg2); + N_VConst(arg1,arg2); +} + + +SWIGEXPORT void _wrap_FN_VProd(N_Vector farg1, N_Vector farg2, N_Vector farg3) { + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + N_VProd(arg1,arg2,arg3); +} + + +SWIGEXPORT void _wrap_FN_VDiv(N_Vector farg1, N_Vector farg2, N_Vector farg3) { + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + N_VDiv(arg1,arg2,arg3); +} + + +SWIGEXPORT void _wrap_FN_VScale(double const *farg1, N_Vector farg2, N_Vector farg3) { + realtype arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + + arg1 = (realtype)(*farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + N_VScale(arg1,arg2,arg3); +} + + +SWIGEXPORT void _wrap_FN_VAbs(N_Vector farg1, N_Vector farg2) { + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + N_VAbs(arg1,arg2); +} + + +SWIGEXPORT void _wrap_FN_VInv(N_Vector farg1, N_Vector farg2) { + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + N_VInv(arg1,arg2); +} + + +SWIGEXPORT void _wrap_FN_VAddConst(N_Vector farg1, double const *farg2, N_Vector farg3) { + N_Vector arg1 = (N_Vector) 0 ; + realtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + + arg1 = (N_Vector)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector)(farg3); + N_VAddConst(arg1,arg2,arg3); +} + + +SWIGEXPORT double _wrap_FN_VDotProd(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VDotProd(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VMaxNorm(N_Vector farg1) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + result = (realtype)N_VMaxNorm(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VWrmsNorm(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VWrmsNorm(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VWrmsNormMask(N_Vector farg1, N_Vector farg2, N_Vector farg3) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (realtype)N_VWrmsNormMask(arg1,arg2,arg3); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VMin(N_Vector farg1) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + result = (realtype)N_VMin(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VWL2Norm(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VWL2Norm(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VL1Norm(N_Vector farg1) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + result = (realtype)N_VL1Norm(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_FN_VCompare(double const *farg1, N_Vector farg2, N_Vector farg3) { + realtype arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + + arg1 = (realtype)(*farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + N_VCompare(arg1,arg2,arg3); +} + + +SWIGEXPORT int _wrap_FN_VInvTest(N_Vector farg1, N_Vector farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (int)N_VInvTest(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VConstrMask(N_Vector farg1, N_Vector farg2, N_Vector farg3) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)N_VConstrMask(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VMinQuotient(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VMinQuotient(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VLinearCombination(int const *farg1, double *farg2, void *farg3, N_Vector farg4) { + int fresult ; + int arg1 ; + realtype *arg2 = (realtype *) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype *)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (N_Vector)(farg4); + result = (int)N_VLinearCombination(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VScaleAddMulti(int const *farg1, double *farg2, N_Vector farg3, void *farg4, void *farg5) { + int fresult ; + int arg1 ; + realtype *arg2 = (realtype *) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + N_Vector *arg4 = (N_Vector *) 0 ; + N_Vector *arg5 = (N_Vector *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype *)(farg2); + arg3 = (N_Vector)(farg3); + arg4 = (N_Vector *)(farg4); + arg5 = (N_Vector *)(farg5); + result = (int)N_VScaleAddMulti(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VDotProdMulti(int const *farg1, N_Vector farg2, void *farg3, double *farg4) { + int fresult ; + int arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + realtype *arg4 = (realtype *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (realtype *)(farg4); + result = (int)N_VDotProdMulti(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VLinearSumVectorArray(int const *farg1, double const *farg2, void *farg3, double const *farg4, void *farg5, void *farg6) { + int fresult ; + int arg1 ; + realtype arg2 ; + N_Vector *arg3 = (N_Vector *) 0 ; + realtype arg4 ; + N_Vector *arg5 = (N_Vector *) 0 ; + N_Vector *arg6 = (N_Vector *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (realtype)(*farg4); + arg5 = (N_Vector *)(farg5); + arg6 = (N_Vector *)(farg6); + result = (int)N_VLinearSumVectorArray(arg1,arg2,arg3,arg4,arg5,arg6); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VScaleVectorArray(int const *farg1, double *farg2, void *farg3, void *farg4) { + int fresult ; + int arg1 ; + realtype *arg2 = (realtype *) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + N_Vector *arg4 = (N_Vector *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype *)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (N_Vector *)(farg4); + result = (int)N_VScaleVectorArray(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VConstVectorArray(int const *farg1, double const *farg2, void *farg3) { + int fresult ; + int arg1 ; + realtype arg2 ; + N_Vector *arg3 = (N_Vector *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector *)(farg3); + result = (int)N_VConstVectorArray(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VWrmsNormVectorArray(int const *farg1, void *farg2, void *farg3, double *farg4) { + int fresult ; + int arg1 ; + N_Vector *arg2 = (N_Vector *) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + realtype *arg4 = (realtype *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (N_Vector *)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (realtype *)(farg4); + result = (int)N_VWrmsNormVectorArray(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VWrmsNormMaskVectorArray(int const *farg1, void *farg2, void *farg3, N_Vector farg4, double *farg5) { + int fresult ; + int arg1 ; + N_Vector *arg2 = (N_Vector *) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + realtype *arg5 = (realtype *) 0 ; + int result; + + arg1 = (int)(*farg1); + arg2 = (N_Vector *)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (N_Vector)(farg4); + arg5 = (realtype *)(farg5); + result = (int)N_VWrmsNormMaskVectorArray(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VDotProdLocal(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VDotProdLocal(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VMaxNormLocal(N_Vector farg1) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + result = (realtype)N_VMaxNormLocal(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VMinLocal(N_Vector farg1) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + result = (realtype)N_VMinLocal(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VL1NormLocal(N_Vector farg1) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + result = (realtype)N_VL1NormLocal(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VWSqrSumLocal(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VWSqrSumLocal(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VWSqrSumMaskLocal(N_Vector farg1, N_Vector farg2, N_Vector farg3) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (realtype)N_VWSqrSumMaskLocal(arg1,arg2,arg3); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VInvTestLocal(N_Vector farg1, N_Vector farg2) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (int)N_VInvTestLocal(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FN_VConstrMaskLocal(N_Vector farg1, N_Vector farg2, N_Vector farg3) { + int fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)N_VConstrMaskLocal(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FN_VMinQuotientLocal(N_Vector farg1, N_Vector farg2) { + double fresult ; + N_Vector arg1 = (N_Vector) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype result; + + arg1 = (N_Vector)(farg1); + arg2 = (N_Vector)(farg2); + result = (realtype)N_VMinQuotientLocal(arg1,arg2); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT void * _wrap_FN_VNewVectorArray(int const *farg1) { + void * fresult ; + int arg1 ; + N_Vector *result = 0 ; + + arg1 = (int)(*farg1); + result = (N_Vector *)N_VNewVectorArray(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT void * _wrap_FN_VCloneEmptyVectorArray(int const *farg1, N_Vector farg2) { + void * fresult ; + int arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector *result = 0 ; + + arg1 = (int)(*farg1); + arg2 = (N_Vector)(farg2); + result = (N_Vector *)N_VCloneEmptyVectorArray(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT void * _wrap_FN_VCloneVectorArray(int const *farg1, N_Vector farg2) { + void * fresult ; + int arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector *result = 0 ; + + arg1 = (int)(*farg1); + arg2 = (N_Vector)(farg2); + result = (N_Vector *)N_VCloneVectorArray(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FN_VDestroyVectorArray(void *farg1, int const *farg2) { + N_Vector *arg1 = (N_Vector *) 0 ; + int arg2 ; + + arg1 = (N_Vector *)(farg1); + arg2 = (int)(*farg2); + N_VDestroyVectorArray(arg1,arg2); +} + + +SWIGEXPORT N_Vector _wrap_FN_VGetVecAtIndexVectorArray(void *farg1, int const *farg2) { + N_Vector fresult ; + N_Vector *arg1 = (N_Vector *) 0 ; + int arg2 ; + N_Vector result; + + arg1 = (N_Vector *)(farg1); + arg2 = (int)(*farg2); + result = (N_Vector)N_VGetVecAtIndexVectorArray(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FN_VSetVecAtIndexVectorArray(void *farg1, int const *farg2, N_Vector farg3) { + N_Vector *arg1 = (N_Vector *) 0 ; + int arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + + arg1 = (N_Vector *)(farg1); + arg2 = (int)(*farg2); + arg3 = (N_Vector)(farg3); + N_VSetVecAtIndexVectorArray(arg1,arg2,arg3); +} + + + diff --git a/bazaar/plugin/sundials/src/sundials/fmod/fsundials_types_mod.c b/bazaar/plugin/sundials/src/sundials/fmod/fsundials_types_mod.c new file mode 100644 index 000000000..57838fd9e --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/fmod/fsundials_types_mod.c @@ -0,0 +1,219 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ + +/* --------------------------------------------------------------- + * Programmer(s): Auto-generated by swig. + * --------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * -------------------------------------------------------------*/ + +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include + + +#include "sundials/sundials_types.h" + +#ifndef SUNDIALS_DOUBLE_PRECISION +#error "The Fortran bindings are only targeted at double-precision" +#endif + +#ifndef SUNDIALS_INT64_T +#error "The Fortran bindings are only targeted at 64-bit indices" +#endif + + diff --git a/bazaar/plugin/sundials/src/sundials/sundials_band.c b/bazaar/plugin/sundials/src/sundials/sundials_band.c new file mode 100644 index 000000000..124ace82b --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/sundials_band.c @@ -0,0 +1,264 @@ +/* + * ----------------------------------------------------------------- + * $Revision$ + * $Date$ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for a generic BAND linear + * solver package. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +#define ROW(i,j,smu) (i-j+smu) + +/* + * ----------------------------------------------------- + * Functions working on DlsMat + * ----------------------------------------------------- + */ + +sunindextype BandGBTRF(DlsMat A, sunindextype *p) +{ + return(bandGBTRF(A->cols, A->M, A->mu, A->ml, A->s_mu, p)); +} + +void BandGBTRS(DlsMat A, sunindextype *p, realtype *b) +{ + bandGBTRS(A->cols, A->M, A->s_mu, A->ml, p, b); +} + +void BandCopy(DlsMat A, DlsMat B, sunindextype copymu, sunindextype copyml) +{ + bandCopy(A->cols, B->cols, A->M, A->s_mu, B->s_mu, copymu, copyml); +} + +void BandScale(realtype c, DlsMat A) +{ + bandScale(c, A->cols, A->M, A->mu, A->ml, A->s_mu); +} + +void BandMatvec(DlsMat A, realtype *x, realtype *y) +{ + bandMatvec(A->cols, x, y, A->M, A->mu, A->ml, A->s_mu); +} + +/* + * ----------------------------------------------------- + * Functions working on realtype** + * ----------------------------------------------------- + */ + +sunindextype bandGBTRF(realtype **a, sunindextype n, sunindextype mu, sunindextype ml, sunindextype smu, sunindextype *p) +{ + sunindextype c, r, num_rows; + sunindextype 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 = SUNMIN(n-1,k+ml); + + /* find l = pivot row number */ + + l=k; + max = SUNRabs(*diag_k); + for (i=k+1, kptr=sub_diag_k; i <= last_row_k; i++, kptr++) { + if (SUNRabs(*kptr) > max) { + l=i; + max = SUNRabs(*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, ..., SUNMIN(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, ..., SUNMIN(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, ..., SUNMIN(k+smu,n-1). */ + + last_col_k = SUNMIN(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 bandGBTRS(realtype **a, sunindextype n, sunindextype smu, sunindextype ml, sunindextype *p, realtype *b) +{ + sunindextype 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 = SUNMIN(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 = SUNMAX(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 bandCopy(realtype **a, realtype **b, sunindextype n, sunindextype a_smu, sunindextype b_smu, + sunindextype copymu, sunindextype copyml) +{ + sunindextype 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, sunindextype n, sunindextype mu, sunindextype ml, sunindextype smu) +{ + sunindextype 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 bandAddIdentity(realtype **a, sunindextype n, sunindextype smu) +{ + sunindextype j; + + for(j=0; j < n; j++) + a[j][smu] += ONE; +} + +void bandMatvec(realtype **a, realtype *x, realtype *y, sunindextype n, + sunindextype mu, sunindextype ml, sunindextype smu) +{ + sunindextype i, j, is, ie; + realtype *col_j; + + for (i=0; i j-mu) ? 0 : j-mu; + ie = (n-1 < j+ml) ? n-1 : j+ml; + for (i=is; i<=ie; i++) + y[i] += col_j[i-j+mu]*x[j]; + } +} + diff --git a/bazaar/plugin/sundials/src/sundials/sundials_cuda.h b/bazaar/plugin/sundials/src/sundials/sundials_cuda.h new file mode 100644 index 000000000..e629ae423 --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/sundials_cuda.h @@ -0,0 +1,101 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Cody J. Balos @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This header files defines internal utility functions and macros + * for working with CUDA. + * ----------------------------------------------------------------- + */ + +#include + +#include +#include +#include + +#include + +#ifndef _SUNDIALS_CUDA_H +#define _SUNDIALS_CUDA_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* --------------------------------------------------------------------------- + * Constants + * ---------------------------------------------------------------------------*/ + +#define CUDA_WARP_SIZE 32 + + +/* --------------------------------------------------------------------------- + * Utility macros + * ---------------------------------------------------------------------------*/ + +#define SUNDIALS_CUDA_VERIFY(cuerr) SUNDIALS_CUDA_Assert(cuerr, __FILE__, __LINE__) +#define SUNDIALS_CUSPARSE_VERIFY(cuerr) SUNDIALS_CUSPARSE_Assert(cuerr, __FILE__, __LINE__) +#define SUNDIALS_CUSOLVER_VERIFY(cuerr) SUNDIALS_CUSOLVER_Assert(cuerr, __FILE__, __LINE__) + + +/* --------------------------------------------------------------------------- + * Utility functions + * ---------------------------------------------------------------------------*/ +inline booleantype SUNDIALS_CUDA_Assert(cudaError_t cuerr, const char *file, int line) +{ + if (cuerr != cudaSuccess) + { +#ifdef SUNDIALS_DEBUG + fprintf(stderr, + "ERROR in CUDA runtime operation: %s %s:%d\n", + cudaGetErrorString(cuerr), file, line); +#endif + return SUNFALSE; /* Assert failed */ + } + return SUNTRUE; /* Assert OK */ +} + +inline booleantype SUNDIALS_CUSPARSE_Assert(cusparseStatus_t status, const char *file, int line) +{ + if (status != CUSPARSE_STATUS_SUCCESS) + { +#ifdef SUNDIALS_DEBUG + fprintf(stderr, + "ERROR in cuSPARSE runtime operation: cusparseStatus_t = %d %s:%d\n", + status, file, line); +#endif + return SUNFALSE; /* Assert failed */ + } + return SUNTRUE; /* Assert OK */ +} + +inline booleantype SUNDIALS_CUSOLVER_Assert(cusolverStatus_t status, const char *file, int line) +{ + if (status != CUSOLVER_STATUS_SUCCESS) + { +#ifdef SUNDIALS_DEBUG + fprintf(stderr, + "ERROR in cuSOLVER runtime operation: cusolverStatus_t = %d %s:%d\n", + status, file, line); +#endif + return SUNFALSE; /* Assert failed */ + } + return SUNTRUE; /* Assert OK */ +} + + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +} +#endif + +#endif /* _SUNDIALS_CUDA_H */ \ No newline at end of file diff --git a/bazaar/plugin/sundials/src/sundials/sundials_debug.h b/bazaar/plugin/sundials/src/sundials/sundials_debug.h new file mode 100644 index 000000000..17178d8b6 --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/sundials_debug.h @@ -0,0 +1,40 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Cody J. Balos @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This header files defines internal utility functions and macros + * for SUNDIALS debugging. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALS_DEBUG_H +#define _SUNDIALS_DEBUG_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * Macro which prints to stderr when in debug mode + */ +#ifdef SUNDIALS_DEBUG +#define SUNDIALS_DEBUG_PRINT(str) fprintf(stderr, str) +#else +#define SUNDIALS_DEBUG_PRINT(str) +#endif + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +} +#endif + +#endif /* _SUNDIALS_DEBUG_H */ \ No newline at end of file diff --git a/bazaar/plugin/sundials/src/sundials/sundials_dense.c b/bazaar/plugin/sundials/src/sundials/sundials_dense.c new file mode 100644 index 000000000..3ef5bfda2 --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/sundials_dense.c @@ -0,0 +1,400 @@ +/* + * ----------------------------------------------------------------- + * $Revision$ + * $Date$ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for a generic package of dense + * matrix operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) + +/* + * ----------------------------------------------------- + * Functions working on DlsMat + * ----------------------------------------------------- + */ + +sunindextype DenseGETRF(DlsMat A, sunindextype *p) +{ + return(denseGETRF(A->cols, A->M, A->N, p)); +} + +void DenseGETRS(DlsMat A, sunindextype *p, realtype *b) +{ + denseGETRS(A->cols, A->N, p, b); +} + +sunindextype DensePOTRF(DlsMat A) +{ + return(densePOTRF(A->cols, A->M)); +} + +void DensePOTRS(DlsMat A, realtype *b) +{ + densePOTRS(A->cols, A->M, b); +} + +int DenseGEQRF(DlsMat A, realtype *beta, realtype *wrk) +{ + return(denseGEQRF(A->cols, A->M, A->N, beta, wrk)); +} + +int DenseORMQR(DlsMat A, realtype *beta, realtype *vn, realtype *vm, realtype *wrk) +{ + return(denseORMQR(A->cols, A->M, A->N, beta, vn, vm, wrk)); +} + +void DenseCopy(DlsMat A, DlsMat B) +{ + denseCopy(A->cols, B->cols, A->M, A->N); +} + +void DenseScale(realtype c, DlsMat A) +{ + denseScale(c, A->cols, A->M, A->N); +} + +void DenseMatvec(DlsMat A, realtype *x, realtype *y) +{ + denseMatvec(A->cols, x, y, A->M, A->N); +} + +sunindextype denseGETRF(realtype **a, sunindextype m, sunindextype n, sunindextype *p) +{ + sunindextype i, j, k, l; + realtype *col_j, *col_k; + realtype temp, mult, a_kj; + + /* k-th elimination step number */ + for (k=0; k < n; k++) { + + col_k = a[k]; + + /* find l = pivot row number */ + l=k; + for (i=k+1; i < m; i++) + if (SUNRabs(col_k[i]) > SUNRabs(col_k[l])) l=i; + p[k] = l; + + /* check for zero pivot element */ + if (col_k[l] == ZERO) return(k+1); + + /* swap a(k,1:n) and a(l,1:n) if necessary */ + if ( l!= k ) { + for (i=0; i 0; k--) { + col_k = a[k]; + b[k] /= col_k[k]; + for (i=0; i0) { + for(i=j; i=0; i--) { + col_i = a[i]; + for (j=i+1; j= n) + * using Householder reflections. + * + * On exit, the elements on and above the diagonal of A contain the n by n + * upper triangular matrix R; the elements below the diagonal, with the array beta, + * represent the orthogonal matrix Q as a product of elementary reflectors . + * + * v (of length m) must be provided as workspace. + * + */ + +int denseGEQRF(realtype **a, sunindextype m, sunindextype n, realtype *beta, realtype *v) +{ + realtype ajj, s, mu, v1, v1_2; + realtype *col_j, *col_k; + sunindextype i, j, k; + + /* For each column...*/ + for(j=0; j= n. + * + * v (of length m) must be provided as workspace. + */ +int denseORMQR(realtype **a, sunindextype m, sunindextype n, realtype *beta, + realtype *vn, realtype *vm, realtype *v) +{ + realtype *col_j, s; + sunindextype i, j; + + /* Initialize vm */ + for(i=0; i=0; j--) { + + col_j = a[j]; + + v[0] = ONE; + s = vm[j]; + for(i=1; i +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +DlsMat NewDenseMat(sunindextype M, sunindextype N) +{ + DlsMat A; + sunindextype j; + + if ( (M <= 0) || (N <= 0) ) return(NULL); + + A = NULL; + A = (DlsMat) malloc(sizeof *A); + if (A==NULL) return (NULL); + + A->data = (realtype *) malloc(M * N * sizeof(realtype)); + if (A->data == NULL) { + free(A); A = NULL; + return(NULL); + } + A->cols = (realtype **) malloc(N * sizeof(realtype *)); + if (A->cols == NULL) { + free(A->data); A->data = NULL; + free(A); A = NULL; + return(NULL); + } + + for (j=0; j < N; j++) A->cols[j] = A->data + j * M; + + A->M = M; + A->N = N; + A->ldim = M; + A->ldata = M*N; + + A->type = SUNDIALS_DENSE; + + return(A); +} + +realtype **newDenseMat(sunindextype m, sunindextype n) +{ + sunindextype j; + realtype **a; + + if ( (n <= 0) || (m <= 0) ) return(NULL); + + a = NULL; + a = (realtype **) malloc(n * sizeof(realtype *)); + if (a == NULL) return(NULL); + + a[0] = NULL; + a[0] = (realtype *) malloc(m * n * sizeof(realtype)); + if (a[0] == NULL) { + free(a); a = NULL; + return(NULL); + } + + for (j=1; j < n; j++) a[j] = a[0] + j * m; + + return(a); +} + + +DlsMat NewBandMat(sunindextype N, sunindextype mu, sunindextype ml, sunindextype smu) +{ + DlsMat A; + sunindextype j, colSize; + + if (N <= 0) return(NULL); + + A = NULL; + A = (DlsMat) malloc(sizeof *A); + if (A == NULL) return (NULL); + + colSize = smu + ml + 1; + A->data = NULL; + A->data = (realtype *) malloc(N * colSize * sizeof(realtype)); + if (A->data == NULL) { + free(A); A = NULL; + return(NULL); + } + + A->cols = NULL; + A->cols = (realtype **) malloc(N * sizeof(realtype *)); + if (A->cols == NULL) { + free(A->data); + free(A); A = NULL; + return(NULL); + } + + for (j=0; j < N; j++) A->cols[j] = A->data + j * colSize; + + A->M = N; + A->N = N; + A->mu = mu; + A->ml = ml; + A->s_mu = smu; + A->ldim = colSize; + A->ldata = N * colSize; + + A->type = SUNDIALS_BAND; + + return(A); +} + +realtype **newBandMat(sunindextype n, sunindextype smu, sunindextype ml) +{ + realtype **a; + sunindextype j, colSize; + + if (n <= 0) return(NULL); + + a = NULL; + a = (realtype **) malloc(n * sizeof(realtype *)); + if (a == NULL) return(NULL); + + colSize = smu + ml + 1; + a[0] = NULL; + a[0] = (realtype *) malloc(n * colSize * sizeof(realtype)); + if (a[0] == NULL) { + free(a); a = NULL; + return(NULL); + } + + for (j=1; j < n; j++) a[j] = a[0] + j * colSize; + + return(a); +} + +void DestroyMat(DlsMat A) +{ + free(A->data); A->data = NULL; + free(A->cols); + free(A); A = NULL; +} + +void destroyMat(realtype **a) +{ + free(a[0]); a[0] = NULL; + free(a); a = NULL; +} + +int *NewIntArray(int N) +{ + int *vec; + + if (N <= 0) return(NULL); + + vec = NULL; + vec = (int *) malloc(N * sizeof(int)); + + return(vec); +} + +int *newIntArray(int n) +{ + int *v; + + if (n <= 0) return(NULL); + + v = NULL; + v = (int *) malloc(n * sizeof(int)); + + return(v); +} + +sunindextype *NewIndexArray(sunindextype N) +{ + sunindextype *vec; + + if (N <= 0) return(NULL); + + vec = NULL; + vec = (sunindextype *) malloc(N * sizeof(sunindextype)); + + return(vec); +} + +sunindextype *newIndexArray(sunindextype n) +{ + sunindextype *v; + + if (n <= 0) return(NULL); + + v = NULL; + v = (sunindextype *) malloc(n * sizeof(sunindextype)); + + return(v); +} + +realtype *NewRealArray(sunindextype N) +{ + realtype *vec; + + if (N <= 0) return(NULL); + + vec = NULL; + vec = (realtype *) malloc(N * sizeof(realtype)); + + return(vec); +} + +realtype *newRealArray(sunindextype m) +{ + realtype *v; + + if (m <= 0) return(NULL); + + v = NULL; + v = (realtype *) malloc(m * sizeof(realtype)); + + return(v); +} + +void DestroyArray(void *V) +{ + free(V); + V = NULL; +} + +void destroyArray(void *v) +{ + free(v); + v = NULL; +} + + +void AddIdentity(DlsMat A) +{ + sunindextype i; + + switch (A->type) { + + case SUNDIALS_DENSE: + for (i=0; iN; i++) A->cols[i][i] += ONE; + break; + + case SUNDIALS_BAND: + for (i=0; iM; i++) A->cols[i][A->s_mu] += ONE; + break; + + } + +} + + +void SetToZero(DlsMat A) +{ + sunindextype i, j, colSize; + realtype *col_j; + + switch (A->type) { + + case SUNDIALS_DENSE: + + for (j=0; jN; j++) { + col_j = A->cols[j]; + for (i=0; iM; i++) + col_j[i] = ZERO; + } + + break; + + case SUNDIALS_BAND: + + colSize = A->mu + A->ml + 1; + for (j=0; jM; j++) { + col_j = A->cols[j] + A->s_mu - A->mu; + for (i=0; itype) { + + case SUNDIALS_DENSE: + + fprintf(outfile, "\n"); + for (i=0; i < A->M; i++) { + for (j=0; j < A->N; j++) { +#if defined(SUNDIALS_EXTENDED_PRECISION) + fprintf(outfile, "%12Lg ", DENSE_ELEM(A,i,j)); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + fprintf(outfile, "%12g ", DENSE_ELEM(A,i,j)); +#else + fprintf(outfile, "%12g ", DENSE_ELEM(A,i,j)); +#endif + } + fprintf(outfile, "\n"); + } + fprintf(outfile, "\n"); + + break; + + case SUNDIALS_BAND: + + a = A->cols; + fprintf(outfile, "\n"); + for (i=0; i < A->N; i++) { + start = SUNMAX(0,i-A->ml); + finish = SUNMIN(A->N-1,i+A->mu); + for (j=0; j < start; j++) fprintf(outfile, "%12s ",""); + for (j=start; j <= finish; j++) { +#if defined(SUNDIALS_EXTENDED_PRECISION) + fprintf(outfile, "%12Lg ", a[j][i-j+A->s_mu]); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + fprintf(outfile, "%12g ", a[j][i-j+A->s_mu]); +#else + fprintf(outfile, "%12g ", a[j][i-j+A->s_mu]); +#endif + } + fprintf(outfile, "\n"); + } + fprintf(outfile, "\n"); + + break; + + } + +} + + diff --git a/bazaar/plugin/sundials/src/sundials/sundials_futils.c b/bazaar/plugin/sundials/src/sundials/sundials_futils.c new file mode 100644 index 000000000..33cad23b2 --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/sundials_futils.c @@ -0,0 +1,29 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Cody J. Balos + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * SUNDIALS Fortran 2003 interface utility implementations. + * -----------------------------------------------------------------*/ + +#include + +/* Create a file pointer with the given file name and mode. */ +FILE* SUNDIALSFileOpen(const char* filename, const char* mode) +{ + return fopen(filename, mode); +} + +/* Close a file pointer with the given file name. */ +void SUNDIALSFileClose(FILE* fp) +{ + fclose(fp); +} diff --git a/bazaar/plugin/sundials/src/sundials/sundials_iterative.c b/bazaar/plugin/sundials/src/sundials/sundials_iterative.c new file mode 100644 index 000000000..b6f640e87 --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/sundials_iterative.c @@ -0,0 +1,298 @@ +/* + * ----------------------------------------------------------------- + * $Revision$ + * $Date$ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * 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 +#include + +#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 = SUNRsqrt(N_VDotProd(v[k],v[k])); + k_minus_1 = k - 1; + i0 = SUNMAX(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 = SUNRsqrt(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 += SUNSQR(new_product); + } + + if (new_norm_2 != ZERO) { + new_product = SUNSQR(*new_vk_norm) - new_norm_2; + *new_vk_norm = (new_product > ZERO) ? SUNRsqrt(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, + realtype *stemp, N_Vector *vtemp) +{ + int i, i0, k_minus_1, retval; + realtype vk_norm; + + k_minus_1 = k - 1; + i0 = SUNMAX(k-p,0); + + /* Perform Classical Gram-Schmidt */ + + retval = N_VDotProdMulti(k-i0+1, v[k], v+i0, stemp); + if (retval != 0) return(-1); + + vk_norm = SUNRsqrt(stemp[k-i0]); + for (i=k-i0-1; i >= 0; i--) { + h[i][k_minus_1] = stemp[i]; + stemp[i+1] = -stemp[i]; + vtemp[i+1] = v[i]; + } + stemp[0] = ONE; + vtemp[0] = v[k]; + + retval = N_VLinearCombination(k-i0+1, stemp, vtemp, v[k]); + if (retval != 0) return(-1); + + /* Compute the norm of the new vector at v[k] */ + + *new_vk_norm = SUNRsqrt(N_VDotProd(v[k], v[k])); + + /* Reorthogonalize if necessary */ + + if ((FACTOR * (*new_vk_norm)) < vk_norm) { + + retval = N_VDotProdMulti(k-i0, v[k], v+i0, stemp+1); + if (retval != 0) return(-1); + + stemp[0] = ONE; + vtemp[0] = v[k]; + for (i=i0; i < k; i++) { + h[i][k_minus_1] += stemp[i-i0+1]; + stemp[i-i0+1] = -stemp[i-i0+1]; + vtemp[i-i0+1] = v[i-i0]; + } + + retval = N_VLinearCombination(k+1, stemp, vtemp, v[k]); + if (retval != 0) return(-1); + + *new_vk_norm = SUNRsqrt(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 (SUNRabs(temp2) >= SUNRabs(temp1)) { + temp3 = temp1/temp2; + s = -ONE/SUNRsqrt(ONE+SUNSQR(temp3)); + c = -s*temp3; + } else { + temp3 = temp2/temp1; + c = ONE/SUNRsqrt(ONE+SUNSQR(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 (SUNRabs(temp2) >= SUNRabs(temp1)) { + temp3 = temp1/temp2; + s = -ONE/SUNRsqrt(ONE+SUNSQR(temp3)); + c = -s*temp3; + } else { + temp3 = temp2/temp1; + c = ONE/SUNRsqrt(ONE+SUNSQR(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/bazaar/plugin/sundials/src/sundials/sundials_linearsolver.c b/bazaar/plugin/sundials/src/sundials/sundials_linearsolver.c new file mode 100644 index 000000000..b6cb21fd0 --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/sundials_linearsolver.c @@ -0,0 +1,209 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * David J. Gardner, Carol S. Woodward, and + * Slaven Peles @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for a generic SUNLINEARSOLVER + * package. It contains the implementation of the SUNLinearSolver + * operations listed in sundials_linearsolver.h + * -----------------------------------------------------------------*/ + +#include +#include + +/* ----------------------------------------------------------------- + * Create a new empty SUNLinearSolver object + * ----------------------------------------------------------------- */ + +SUNLinearSolver SUNLinSolNewEmpty() +{ + SUNLinearSolver LS; + SUNLinearSolver_Ops ops; + + /* create linear solver object */ + LS = NULL; + LS = (SUNLinearSolver) malloc(sizeof *LS); + if (LS == NULL) return(NULL); + + /* create linear solver ops structure */ + ops = NULL; + ops = (SUNLinearSolver_Ops) malloc(sizeof *ops); + if (ops == NULL) { free(LS); return(NULL); } + + /* initialize operations to NULL */ + ops->gettype = NULL; + ops->getid = NULL; + ops->setatimes = NULL; + ops->setpreconditioner = NULL; + ops->setscalingvectors = NULL; + ops->initialize = NULL; + ops->setup = NULL; + ops->solve = NULL; + ops->numiters = NULL; + ops->resnorm = NULL; + ops->resid = NULL; + ops->lastflag = NULL; + ops->space = NULL; + ops->free = NULL; + + /* attach ops and initialize content to NULL */ + LS->ops = ops; + LS->content = NULL; + + return(LS); +} + +/* ----------------------------------------------------------------- + * Free a generic SUNLinearSolver (assumes content is already empty) + * ----------------------------------------------------------------- */ + +void SUNLinSolFreeEmpty(SUNLinearSolver S) +{ + if (S == NULL) return; + + /* free non-NULL ops structure */ + if (S->ops) free(S->ops); + S->ops = NULL; + + /* free overall N_Vector object and return */ + free(S); + return; +} + +/* ----------------------------------------------------------------- + * Functions in the 'ops' structure + * -----------------------------------------------------------------*/ + +SUNLinearSolver_Type SUNLinSolGetType(SUNLinearSolver S) +{ + return(S->ops->gettype(S)); +} + +SUNLinearSolver_ID SUNLinSolGetID(SUNLinearSolver S) +{ + if (S->ops->getid) + return(S->ops->getid(S)); + else + return(SUNLINEARSOLVER_CUSTOM); +} + +int SUNLinSolSetATimes(SUNLinearSolver S, void* A_data, + ATimesFn ATimes) +{ + if (S->ops->setatimes) + return ((int) S->ops->setatimes(S, A_data, ATimes)); + else + return SUNLS_SUCCESS; +} + + +int SUNLinSolSetPreconditioner(SUNLinearSolver S, void* P_data, + PSetupFn Pset, PSolveFn Psol) +{ + if (S->ops->setpreconditioner) + return ((int) S->ops->setpreconditioner(S, P_data, Pset, Psol)); + else + return SUNLS_SUCCESS; +} + +int SUNLinSolSetScalingVectors(SUNLinearSolver S, + N_Vector s1, N_Vector s2) +{ + if (S->ops->setscalingvectors) + return ((int) S->ops->setscalingvectors(S, s1, s2)); + else + return SUNLS_SUCCESS; +} + +int SUNLinSolInitialize(SUNLinearSolver S) +{ + if (S->ops->initialize) + return ((int) S->ops->initialize(S)); + else + return SUNLS_SUCCESS; +} + +int SUNLinSolSetup(SUNLinearSolver S, SUNMatrix A) +{ + if (S->ops->setup) + return ((int) S->ops->setup(S, A)); + else + return SUNLS_SUCCESS; +} + +int SUNLinSolSolve(SUNLinearSolver S, SUNMatrix A, N_Vector x, + N_Vector b, realtype tol) +{ + return ((int) S->ops->solve(S, A, x, b, tol)); +} + +int SUNLinSolNumIters(SUNLinearSolver S) +{ + if (S->ops->numiters) + return ((int) S->ops->numiters(S)); + else + return 0; +} + +realtype SUNLinSolResNorm(SUNLinearSolver S) +{ + if (S->ops->resnorm) + return ((realtype) S->ops->resnorm(S)); + else + return RCONST(0.0); +} + +N_Vector SUNLinSolResid(SUNLinearSolver S) +{ + if (S->ops->resid) + return ((N_Vector) S->ops->resid(S)); + else + return NULL; +} + +sunindextype SUNLinSolLastFlag(SUNLinearSolver S) +{ + if (S->ops->lastflag) + return ((sunindextype) S->ops->lastflag(S)); + else + return SUNLS_SUCCESS; +} + +int SUNLinSolSpace(SUNLinearSolver S, long int *lenrwLS, + long int *leniwLS) +{ + if (S->ops->space) + return ((int) S->ops->space(S, lenrwLS, leniwLS)); + else { + *lenrwLS = 0; + *leniwLS = 0; + return SUNLS_SUCCESS; + } +} + +int SUNLinSolFree(SUNLinearSolver S) +{ + if (S == NULL) return SUNLS_SUCCESS; + + /* if the free operation exists use it */ + if (S->ops) + if (S->ops->free) return(S->ops->free(S)); + + /* if we reach this point, either ops == NULL or free == NULL, + try to cleanup by freeing the content, ops, and solver */ + if (S->content) { free(S->content); S->content = NULL; } + if (S->ops) { free(S->ops); S->ops = NULL; } + free(S); S = NULL; + + return(SUNLS_SUCCESS); +} diff --git a/bazaar/plugin/sundials/src/sundials/sundials_math.c b/bazaar/plugin/sundials/src/sundials/sundials_math.c new file mode 100644 index 000000000..246386ae0 --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/sundials_math.c @@ -0,0 +1,53 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for a simple C-language math + * library. + * -----------------------------------------------------------------*/ + +#include +#include +#include + +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +realtype SUNRpowerI(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); +} + +realtype SUNRpowerR(realtype base, realtype exponent) +{ + if (base <= ZERO) return(ZERO); + +#if defined(SUNDIALS_USE_GENERIC_MATH) + return((realtype) pow((double) base, (double) exponent)); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + return(pow(base, exponent)); +#elif defined(SUNDIALS_SINGLE_PRECISION) + return(powf(base, exponent)); +#elif defined(SUNDIALS_EXTENDED_PRECISION) + return(powl(base, exponent)); +#endif +} diff --git a/bazaar/plugin/sundials/src/sundials/sundials_matrix.c b/bazaar/plugin/sundials/src/sundials/sundials_matrix.c new file mode 100644 index 000000000..1cc6b9b85 --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/sundials_matrix.c @@ -0,0 +1,175 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * David J. Gardner, Carol S. Woodward, and + * Slaven Peles @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for a generic SUNMATRIX package. + * It contains the implementation of the SUNMatrix operations listed + * in sundials_matrix.h + * -----------------------------------------------------------------*/ + +#include +#include +#include + +/* ----------------------------------------------------------------- + * Create a new empty SUNMatrix object + * ----------------------------------------------------------------- */ + +SUNMatrix SUNMatNewEmpty() +{ + SUNMatrix A; + SUNMatrix_Ops ops; + + /* create matrix object */ + A = NULL; + A = (SUNMatrix) malloc(sizeof *A); + if (A == NULL) return(NULL); + + /* create matrix ops structure */ + ops = NULL; + ops = (SUNMatrix_Ops) malloc(sizeof *ops); + if (ops == NULL) { free(A); return(NULL); } + + /* initialize operations to NULL */ + ops->getid = NULL; + ops->clone = NULL; + ops->destroy = NULL; + ops->zero = NULL; + ops->copy = NULL; + ops->scaleadd = NULL; + ops->scaleaddi = NULL; + ops->matvecsetup = NULL; + ops->matvec = NULL; + ops->space = NULL; + + /* attach ops and initialize content to NULL */ + A->ops = ops; + A->content = NULL; + + return(A); +} + + +/* ----------------------------------------------------------------- + * Free a generic SUNMatrix (assumes content is already empty) + * ----------------------------------------------------------------- */ + +void SUNMatFreeEmpty(SUNMatrix A) +{ + if (A == NULL) return; + + /* free non-NULL ops structure */ + if (A->ops) free(A->ops); + A->ops = NULL; + + /* free overall SUNMatrix object and return */ + free(A); + return; +} + + +/* ----------------------------------------------------------------- + * Copy a matrix 'ops' structure + * -----------------------------------------------------------------*/ + +int SUNMatCopyOps(SUNMatrix A, SUNMatrix B) +{ + /* Check that ops structures exist */ + if (A == NULL || B == NULL) return(-1); + if (A->ops == NULL || B->ops == NULL) return(-1); + + /* Copy ops from A to B */ + B->ops->getid = A->ops->getid; + B->ops->clone = A->ops->clone; + B->ops->destroy = A->ops->destroy; + B->ops->zero = A->ops->zero; + B->ops->copy = A->ops->copy; + B->ops->scaleadd = A->ops->scaleadd; + B->ops->scaleaddi = A->ops->scaleaddi; + B->ops->matvec = A->ops->matvec; + B->ops->space = A->ops->space; + + return(0); +} + + +/* ----------------------------------------------------------------- + * Functions in the 'ops' structure + * ----------------------------------------------------------------- */ + +SUNMatrix_ID SUNMatGetID(SUNMatrix A) +{ + SUNMatrix_ID id; + id = A->ops->getid(A); + return(id); +} + +SUNMatrix SUNMatClone(SUNMatrix A) +{ + SUNMatrix B = NULL; + B = A->ops->clone(A); + return(B); +} + +void SUNMatDestroy(SUNMatrix A) +{ + if (A == NULL) return; + + /* if the destroy operation exists use it */ + if (A->ops) + if (A->ops->destroy) { A->ops->destroy(A); return; } + + /* if we reach this point, either ops == NULL or destroy == NULL, + try to cleanup by freeing the content, ops, and matrix */ + if (A->content) { free(A->content); A->content = NULL; } + if (A->ops) { free(A->ops); A->ops = NULL; } + free(A); A = NULL; + + return; +} + +int SUNMatZero(SUNMatrix A) +{ + return((int) A->ops->zero(A)); +} + +int SUNMatCopy(SUNMatrix A, SUNMatrix B) +{ + return((int) A->ops->copy(A, B)); +} + +int SUNMatScaleAdd(realtype c, SUNMatrix A, SUNMatrix B) +{ + return((int) A->ops->scaleadd(c, A, B)); +} + +int SUNMatScaleAddI(realtype c, SUNMatrix A) +{ + return((int) A->ops->scaleaddi(c, A)); +} + +int SUNMatMatvecSetup(SUNMatrix A) +{ + return((int) A->ops->matvecsetup(A)); +} + +int SUNMatMatvec(SUNMatrix A, N_Vector x, N_Vector y) +{ + return((int) A->ops->matvec(A, x, y)); +} + +int SUNMatSpace(SUNMatrix A, long int *lenrw, long int *leniw) +{ + return((int) A->ops->space(A, lenrw, leniw)); +} diff --git a/bazaar/plugin/sundials/src/sundials/sundials_nonlinearsolver.c b/bazaar/plugin/sundials/src/sundials/sundials_nonlinearsolver.c new file mode 100644 index 000000000..af73cd05c --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/sundials_nonlinearsolver.c @@ -0,0 +1,214 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------------------- + * This is the implementation file for a generic SUNNonlinerSolver package. It + * contains the implementation of the SUNNonlinearSolver operations listed in + * the 'ops' structure in sundials_nonlinearsolver.h + * ---------------------------------------------------------------------------*/ + +#include +#include + +/* ----------------------------------------------------------------------------- + * Create a new empty SUNLinearSolver object + * ---------------------------------------------------------------------------*/ + +SUNNonlinearSolver SUNNonlinSolNewEmpty() +{ + SUNNonlinearSolver NLS; + SUNNonlinearSolver_Ops ops; + + /* create nonlinear solver object */ + NLS = NULL; + NLS = (SUNNonlinearSolver) malloc(sizeof *NLS); + if (NLS == NULL) return(NULL); + + /* create nonlinear solver ops structure */ + ops = NULL; + ops = (SUNNonlinearSolver_Ops) malloc(sizeof *ops); + if (ops == NULL) { free(NLS); return(NULL); } + + /* initialize operations to NULL */ + ops->gettype = NULL; + ops->initialize = NULL; + ops->setup = NULL; + ops->solve = NULL; + ops->free = NULL; + ops->setsysfn = NULL; + ops->setlsetupfn = NULL; + ops->setlsolvefn = NULL; + ops->setctestfn = NULL; + ops->setmaxiters = NULL; + ops->getnumiters = NULL; + ops->getcuriter = NULL; + ops->getnumconvfails = NULL; + + /* attach ops and initialize content to NULL */ + NLS->ops = ops; + NLS->content = NULL; + + return(NLS); +} + +/* ----------------------------------------------------------------------------- + * Free a generic SUNNonlinearSolver (assumes content is already empty) + * ---------------------------------------------------------------------------*/ + +void SUNNonlinSolFreeEmpty(SUNNonlinearSolver NLS) +{ + if (NLS == NULL) return; + + /* free non-NULL ops structure */ + if (NLS->ops) free(NLS->ops); + NLS->ops = NULL; + + /* free overall N_Vector object and return */ + free(NLS); + return; +} + +/* ----------------------------------------------------------------------------- + * core functions + * ---------------------------------------------------------------------------*/ + +SUNNonlinearSolver_Type SUNNonlinSolGetType(SUNNonlinearSolver NLS) +{ + return(NLS->ops->gettype(NLS)); +} + +int SUNNonlinSolInitialize(SUNNonlinearSolver NLS) +{ + if (NLS->ops->initialize) + return((int) NLS->ops->initialize(NLS)); + else + return(SUN_NLS_SUCCESS); +} + +int SUNNonlinSolSetup(SUNNonlinearSolver NLS, N_Vector y, void* mem) +{ + if (NLS->ops->setup) + return((int) NLS->ops->setup(NLS, y, mem)); + else + return(SUN_NLS_SUCCESS); +} + +int SUNNonlinSolSolve(SUNNonlinearSolver NLS, + N_Vector y0, N_Vector y, + N_Vector w, realtype tol, + booleantype callLSetup, void* mem) +{ + return((int) NLS->ops->solve(NLS, y0, y, w, tol, callLSetup, mem)); +} + +int SUNNonlinSolFree(SUNNonlinearSolver NLS) +{ + if (NLS == NULL) return(SUN_NLS_SUCCESS); + + /* if the free operation exists use it */ + if (NLS->ops) + if (NLS->ops->free) return(NLS->ops->free(NLS)); + + /* if we reach this point, either ops == NULL or free == NULL, + try to cleanup by freeing the content, ops, and solver */ + if (NLS->content) { free(NLS->content); NLS->content = NULL; } + if (NLS->ops) { free(NLS->ops); NLS->ops = NULL; } + free(NLS); NLS = NULL; + + return(SUN_NLS_SUCCESS); +} + +/* ----------------------------------------------------------------------------- + * set functions + * ---------------------------------------------------------------------------*/ + +/* set the nonlinear system function (required) */ +int SUNNonlinSolSetSysFn(SUNNonlinearSolver NLS, SUNNonlinSolSysFn SysFn) +{ + return((int) NLS->ops->setsysfn(NLS, SysFn)); +} + +/* set the linear solver setup function (optional) */ +int SUNNonlinSolSetLSetupFn(SUNNonlinearSolver NLS, SUNNonlinSolLSetupFn LSetupFn) +{ + if (NLS->ops->setlsetupfn) + return((int) NLS->ops->setlsetupfn(NLS, LSetupFn)); + else + return(SUN_NLS_SUCCESS); +} + +/* set the linear solver solve function (optional) */ +int SUNNonlinSolSetLSolveFn(SUNNonlinearSolver NLS, SUNNonlinSolLSolveFn LSolveFn) +{ + if (NLS->ops->setlsolvefn) + return((int) NLS->ops->setlsolvefn(NLS, LSolveFn)); + else + return(SUN_NLS_SUCCESS); +} + +/* set the convergence test function (optional) */ +int SUNNonlinSolSetConvTestFn(SUNNonlinearSolver NLS, + SUNNonlinSolConvTestFn CTestFn, + void* ctest_data) +{ + if (NLS->ops->setctestfn) + return((int) NLS->ops->setctestfn(NLS, CTestFn, ctest_data)); + else + return(SUN_NLS_SUCCESS); +} + +int SUNNonlinSolSetMaxIters(SUNNonlinearSolver NLS, int maxiters) +{ + if (NLS->ops->setmaxiters) + return((int) NLS->ops->setmaxiters(NLS, maxiters)); + else + return(SUN_NLS_SUCCESS); +} + +/* ----------------------------------------------------------------------------- + * get functions + * ---------------------------------------------------------------------------*/ + +/* get the total number on nonlinear iterations (optional) */ +int SUNNonlinSolGetNumIters(SUNNonlinearSolver NLS, long int *niters) +{ + if (NLS->ops->getnumiters) { + return((int) NLS->ops->getnumiters(NLS, niters)); + } else { + *niters = 0; + return(SUN_NLS_SUCCESS); + } +} + + +/* get the iteration count for the current nonlinear solve */ +int SUNNonlinSolGetCurIter(SUNNonlinearSolver NLS, int *iter) +{ + if (NLS->ops->getcuriter) { + return((int) NLS->ops->getcuriter(NLS, iter)); + } else { + *iter = -1; + return(SUN_NLS_SUCCESS); + } +} + + +/* get the total number on nonlinear solve convergence failures (optional) */ +int SUNNonlinSolGetNumConvFails(SUNNonlinearSolver NLS, long int *nconvfails) +{ + if (NLS->ops->getnumconvfails) { + return((int) NLS->ops->getnumconvfails(NLS, nconvfails)); + } else { + *nconvfails = 0; + return(SUN_NLS_SUCCESS); + } +} diff --git a/bazaar/plugin/sundials/src/sundials/sundials_nvector.c b/bazaar/plugin/sundials/src/sundials/sundials_nvector.c new file mode 100644 index 000000000..d905748a2 --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/sundials_nvector.c @@ -0,0 +1,763 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Radu Serban, Aaron Collier, and + * David J. Gardner @ LLNL + * Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for a generic NVECTOR package. + * It contains the implementation of the N_Vector operations listed + * in nvector.h. + * -----------------------------------------------------------------*/ + +#include +#include + +/* ----------------------------------------------------------------- + * Create an empty NVector object + * -----------------------------------------------------------------*/ + +N_Vector N_VNewEmpty() +{ + N_Vector v; + N_Vector_Ops ops; + + /* create vector object */ + v = NULL; + v = (N_Vector) malloc(sizeof *v); + if (v == NULL) return(NULL); + + /* create vector ops structure */ + ops = NULL; + ops = (N_Vector_Ops) malloc(sizeof *ops); + if (ops == NULL) { free(v); return(NULL); } + + /* initialize operations to NULL */ + + /* constructors, destructors, and utility operations */ + ops->nvgetvectorid = NULL; + ops->nvclone = NULL; + ops->nvcloneempty = NULL; + ops->nvdestroy = NULL; + ops->nvspace = NULL; + ops->nvgetarraypointer = NULL; + ops->nvsetarraypointer = NULL; + ops->nvgetcommunicator = NULL; + ops->nvgetlength = NULL; + + /* standard vector operations */ + ops->nvlinearsum = NULL; + ops->nvconst = NULL; + ops->nvprod = NULL; + ops->nvdiv = NULL; + ops->nvscale = NULL; + ops->nvabs = NULL; + ops->nvinv = NULL; + ops->nvaddconst = NULL; + ops->nvdotprod = NULL; + ops->nvmaxnorm = NULL; + ops->nvwrmsnormmask = NULL; + ops->nvwrmsnorm = NULL; + ops->nvmin = NULL; + ops->nvwl2norm = NULL; + ops->nvl1norm = NULL; + ops->nvcompare = NULL; + ops->nvinvtest = NULL; + ops->nvconstrmask = NULL; + ops->nvminquotient = NULL; + + /* fused vector operations (optional) */ + ops->nvlinearcombination = NULL; + ops->nvscaleaddmulti = NULL; + ops->nvdotprodmulti = NULL; + + /* vector array operations (optional) */ + ops->nvlinearsumvectorarray = NULL; + ops->nvscalevectorarray = NULL; + ops->nvconstvectorarray = NULL; + ops->nvwrmsnormvectorarray = NULL; + ops->nvwrmsnormmaskvectorarray = NULL; + ops->nvscaleaddmultivectorarray = NULL; + ops->nvlinearcombinationvectorarray = NULL; + + /* local reduction operations (optional) */ + ops->nvdotprodlocal = NULL; + ops->nvmaxnormlocal = NULL; + ops->nvminlocal = NULL; + ops->nvl1normlocal = NULL; + ops->nvinvtestlocal = NULL; + ops->nvconstrmasklocal = NULL; + ops->nvminquotientlocal = NULL; + ops->nvwsqrsumlocal = NULL; + ops->nvwsqrsummasklocal = NULL; + + /* attach ops and initialize content to NULL */ + v->ops = ops; + v->content = NULL; + + return(v); +} + + +/* ----------------------------------------------------------------- + * Free a generic N_Vector (assumes content is already empty) + * -----------------------------------------------------------------*/ + +void N_VFreeEmpty(N_Vector v) +{ + if (v == NULL) return; + + /* free non-NULL ops structure */ + if (v->ops) free(v->ops); + v->ops = NULL; + + /* free overall N_Vector object and return */ + free(v); + return; +} + + +/* ----------------------------------------------------------------- + * Copy a vector 'ops' structure + * -----------------------------------------------------------------*/ + +int N_VCopyOps(N_Vector w, N_Vector v) +{ + /* Check that ops structures exist */ + if (w == NULL || v == NULL) return(-1); + if (w->ops == NULL || v->ops == NULL) return(-1); + + /* Copy ops from w to v */ + + /* constructors, destructors, and utility operations */ + v->ops->nvgetvectorid = w->ops->nvgetvectorid; + v->ops->nvclone = w->ops->nvclone; + v->ops->nvcloneempty = w->ops->nvcloneempty; + v->ops->nvdestroy = w->ops->nvdestroy; + v->ops->nvspace = w->ops->nvspace; + v->ops->nvgetarraypointer = w->ops->nvgetarraypointer; + v->ops->nvsetarraypointer = w->ops->nvsetarraypointer; + v->ops->nvgetcommunicator = w->ops->nvgetcommunicator; + v->ops->nvgetlength = w->ops->nvgetlength; + + /* standard vector operations */ + v->ops->nvlinearsum = w->ops->nvlinearsum; + v->ops->nvconst = w->ops->nvconst; + v->ops->nvprod = w->ops->nvprod; + v->ops->nvdiv = w->ops->nvdiv; + v->ops->nvscale = w->ops->nvscale; + v->ops->nvabs = w->ops->nvabs; + v->ops->nvinv = w->ops->nvinv; + v->ops->nvaddconst = w->ops->nvaddconst; + v->ops->nvdotprod = w->ops->nvdotprod; + v->ops->nvmaxnorm = w->ops->nvmaxnorm; + v->ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; + v->ops->nvwrmsnorm = w->ops->nvwrmsnorm; + v->ops->nvmin = w->ops->nvmin; + v->ops->nvwl2norm = w->ops->nvwl2norm; + v->ops->nvl1norm = w->ops->nvl1norm; + v->ops->nvcompare = w->ops->nvcompare; + v->ops->nvinvtest = w->ops->nvinvtest; + v->ops->nvconstrmask = w->ops->nvconstrmask; + v->ops->nvminquotient = w->ops->nvminquotient; + + /* fused vector operations */ + v->ops->nvlinearcombination = w->ops->nvlinearcombination; + v->ops->nvscaleaddmulti = w->ops->nvscaleaddmulti; + v->ops->nvdotprodmulti = w->ops->nvdotprodmulti; + + /* vector array operations */ + v->ops->nvlinearsumvectorarray = w->ops->nvlinearsumvectorarray; + v->ops->nvscalevectorarray = w->ops->nvscalevectorarray; + v->ops->nvconstvectorarray = w->ops->nvconstvectorarray; + v->ops->nvwrmsnormvectorarray = w->ops->nvwrmsnormvectorarray; + v->ops->nvwrmsnormmaskvectorarray = w->ops->nvwrmsnormmaskvectorarray; + v->ops->nvscaleaddmultivectorarray = w->ops->nvscaleaddmultivectorarray; + v->ops->nvlinearcombinationvectorarray = w->ops->nvlinearcombinationvectorarray; + + /* local reduction operations */ + v->ops->nvdotprodlocal = w->ops->nvdotprodlocal; + v->ops->nvmaxnormlocal = w->ops->nvmaxnormlocal; + v->ops->nvminlocal = w->ops->nvminlocal; + v->ops->nvl1normlocal = w->ops->nvl1normlocal; + v->ops->nvinvtestlocal = w->ops->nvinvtestlocal; + v->ops->nvconstrmasklocal = w->ops->nvconstrmasklocal; + v->ops->nvminquotientlocal = w->ops->nvminquotientlocal; + v->ops->nvwsqrsumlocal = w->ops->nvwsqrsumlocal; + v->ops->nvwsqrsummasklocal = w->ops->nvwsqrsummasklocal; + + return(0); +} + +/* ----------------------------------------------------------------- + * Functions in the 'ops' structure + * -----------------------------------------------------------------*/ + +N_Vector_ID N_VGetVectorID(N_Vector w) +{ + return(w->ops->nvgetvectorid(w)); +} + +N_Vector N_VClone(N_Vector w) +{ + return(w->ops->nvclone(w)); +} + +N_Vector N_VCloneEmpty(N_Vector w) +{ + return(w->ops->nvcloneempty(w)); +} + +void N_VDestroy(N_Vector v) +{ + if (v == NULL) return; + + /* if the destroy operation exists use it */ + if (v->ops) + if (v->ops->nvdestroy) { v->ops->nvdestroy(v); return; } + + /* if we reach this point, either ops == NULL or nvdestroy == NULL, + try to cleanup by freeing the content, ops, and vector */ + if (v->content) { free(v->content); v->content = NULL; } + if (v->ops) { free(v->ops); v->ops = NULL; } + free(v); v = NULL; + + return; +} + +void N_VSpace(N_Vector v, sunindextype *lrw, sunindextype *liw) +{ + v->ops->nvspace(v, lrw, liw); + return; +} + +realtype *N_VGetArrayPointer(N_Vector v) +{ + return((realtype *) v->ops->nvgetarraypointer(v)); +} + +void N_VSetArrayPointer(realtype *v_data, N_Vector v) +{ + v->ops->nvsetarraypointer(v_data, v); + return; +} + +void *N_VGetCommunicator(N_Vector v) +{ + if (v->ops->nvgetcommunicator) + return(v->ops->nvgetcommunicator(v)); + else + return(NULL); +} + +sunindextype N_VGetLength(N_Vector v) +{ + return((sunindextype) v->ops->nvgetlength(v)); +} + +/* ----------------------------------------------------------------- + * standard vector operations + * -----------------------------------------------------------------*/ + +void N_VLinearSum(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) +{ + z->ops->nvlinearsum(a, x, b, y, z); + return; +} + +void N_VConst(realtype c, N_Vector z) +{ + z->ops->nvconst(c, z); + return; +} + +void N_VProd(N_Vector x, N_Vector y, N_Vector z) +{ + z->ops->nvprod(x, y, z); + return; +} + +void N_VDiv(N_Vector x, N_Vector y, N_Vector z) +{ + z->ops->nvdiv(x, y, z); + return; +} + +void N_VScale(realtype c, N_Vector x, N_Vector z) +{ + z->ops->nvscale(c, x, z); + return; +} + +void N_VAbs(N_Vector x, N_Vector z) +{ + z->ops->nvabs(x, z); + return; +} + +void N_VInv(N_Vector x, N_Vector z) +{ + z->ops->nvinv(x, z); + return; +} + +void N_VAddConst(N_Vector x, realtype b, N_Vector z) +{ + z->ops->nvaddconst(x, b, z); + return; +} + +realtype N_VDotProd(N_Vector x, N_Vector y) +{ + return((realtype) y->ops->nvdotprod(x, y)); +} + +realtype N_VMaxNorm(N_Vector x) +{ + return((realtype) x->ops->nvmaxnorm(x)); +} + +realtype N_VWrmsNorm(N_Vector x, N_Vector w) +{ + return((realtype) x->ops->nvwrmsnorm(x, w)); +} + +realtype N_VWrmsNormMask(N_Vector x, N_Vector w, N_Vector id) +{ + return((realtype) x->ops->nvwrmsnormmask(x, w, id)); +} + +realtype N_VMin(N_Vector x) +{ + return((realtype) x->ops->nvmin(x)); +} + +realtype N_VWL2Norm(N_Vector x, N_Vector w) +{ + return((realtype) x->ops->nvwl2norm(x, w)); +} + +realtype N_VL1Norm(N_Vector x) +{ + return((realtype) x->ops->nvl1norm(x)); +} + +void N_VCompare(realtype c, N_Vector x, N_Vector z) +{ + z->ops->nvcompare(c, x, z); + return; +} + +booleantype N_VInvTest(N_Vector x, N_Vector z) +{ + return((booleantype) z->ops->nvinvtest(x, z)); +} + +booleantype N_VConstrMask(N_Vector c, N_Vector x, N_Vector m) +{ + return((booleantype) x->ops->nvconstrmask(c, x, m)); +} + +realtype N_VMinQuotient(N_Vector num, N_Vector denom) +{ + return((realtype) num->ops->nvminquotient(num, denom)); +} + +/* ----------------------------------------------------------------- + * OPTIONAL fused vector operations + * -----------------------------------------------------------------*/ + +int N_VLinearCombination(int nvec, realtype* c, N_Vector* X, N_Vector z) +{ + int i; + realtype ONE=RCONST(1.0); + + if (z->ops->nvlinearcombination != NULL) { + + return(z->ops->nvlinearcombination(nvec, c, X, z)); + + } else { + + z->ops->nvscale(c[0], X[0], z); + for (i=1; iops->nvlinearsum(c[i], X[i], ONE, z, z); + } + return(0); + + } +} + +int N_VScaleAddMulti(int nvec, realtype* a, N_Vector x, N_Vector* Y, N_Vector* Z) +{ + int i; + realtype ONE=RCONST(1.0); + + if (x->ops->nvscaleaddmulti != NULL) { + + return(x->ops->nvscaleaddmulti(nvec, a, x, Y, Z)); + + } else { + + for (i=0; iops->nvlinearsum(a[i], x, ONE, Y[i], Z[i]); + } + return(0); + + } +} + +int N_VDotProdMulti(int nvec, N_Vector x, N_Vector* Y, realtype* dotprods) +{ + int i; + + if (x->ops->nvdotprodmulti != NULL) { + + return(x->ops->nvdotprodmulti(nvec, x, Y, dotprods)); + + } else { + + for (i=0; iops->nvdotprod(x, Y[i]); + } + return(0); + + } +} + +/* ----------------------------------------------------------------- + * OPTIONAL vector array operations + * -----------------------------------------------------------------*/ + +int N_VLinearSumVectorArray(int nvec, realtype a, N_Vector* X, + realtype b, N_Vector* Y, N_Vector* Z) +{ + int i; + + if (Z[0]->ops->nvlinearsumvectorarray != NULL) { + + return(Z[0]->ops->nvlinearsumvectorarray(nvec, a, X, b, Y, Z)); + + } else { + + for (i=0; iops->nvlinearsum(a, X[i], b, Y[i], Z[i]); + } + return(0); + + } +} + +int N_VScaleVectorArray(int nvec, realtype* c, N_Vector* X, N_Vector* Z) +{ + int i; + + if (Z[0]->ops->nvscalevectorarray != NULL) { + + return(Z[0]->ops->nvscalevectorarray(nvec, c, X, Z)); + + } else { + + for (i=0; iops->nvscale(c[i], X[i], Z[i]); + } + return(0); + + } +} + +int N_VConstVectorArray(int nvec, realtype c, N_Vector* Z) +{ + int i, ier; + + if (Z[0]->ops->nvconstvectorarray != NULL) { + + ier = Z[0]->ops->nvconstvectorarray(nvec, c, Z); + return(ier); + + } else { + + for (i=0; iops->nvconst(c, Z[i]); + } + return(0); + + } +} + +int N_VWrmsNormVectorArray(int nvec, N_Vector* X, N_Vector* W, realtype* nrm) +{ + int i, ier; + + if (X[0]->ops->nvwrmsnormvectorarray != NULL) { + + ier = X[0]->ops->nvwrmsnormvectorarray(nvec, X, W, nrm); + return(ier); + + } else { + + for (i=0; iops->nvwrmsnorm(X[i], W[i]); + } + return(0); + + } +} + +int N_VWrmsNormMaskVectorArray(int nvec, N_Vector* X, N_Vector* W, N_Vector id, + realtype* nrm) +{ + int i, ier; + + if (id->ops->nvwrmsnormmaskvectorarray != NULL) { + + ier = id->ops->nvwrmsnormmaskvectorarray(nvec, X, W, id, nrm); + return(ier); + + } else { + + for (i=0; iops->nvwrmsnormmask(X[i], W[i], id); + } + return(0); + + } +} + +int N_VScaleAddMultiVectorArray(int nvec, int nsum, realtype* a, N_Vector* X, + N_Vector** Y, N_Vector** Z) +{ + int i, j; + int ier=0; + realtype ONE=RCONST(1.0); + N_Vector* YY=NULL; + N_Vector* ZZ=NULL; + + if (X[0]->ops->nvscaleaddmultivectorarray != NULL) { + + ier = X[0]->ops->nvscaleaddmultivectorarray(nvec, nsum, a, X, Y, Z); + return(ier); + + } else if (X[0]->ops->nvscaleaddmulti != NULL ) { + + /* allocate arrays of vectors */ + YY = (N_Vector*) malloc(nsum * sizeof(N_Vector)); + ZZ = (N_Vector*) malloc(nsum * sizeof(N_Vector)); + + for (i=0; iops->nvscaleaddmulti(nsum, a, X[i], YY, ZZ); + if (ier != 0) break; + } + + /* free array of vectors */ + free(YY); + free(ZZ); + + return(ier); + + } else { + + for (i=0; iops->nvlinearsum(a[j], X[i], ONE, Y[j][i], Z[j][i]); + } + } + return(0); + } +} + +int N_VLinearCombinationVectorArray(int nvec, int nsum, realtype* c, + N_Vector** X, N_Vector* Z) +{ + int i, j; + int ier=0; + realtype ONE=RCONST(1.0); + N_Vector* Y=NULL; + + if (Z[0]->ops->nvlinearcombinationvectorarray != NULL) { + + ier = Z[0]->ops->nvlinearcombinationvectorarray(nvec, nsum, c, X, Z); + return(ier); + + } else if (Z[0]->ops->nvlinearcombination != NULL ) { + + /* allocate array of vectors */ + Y = (N_Vector* ) malloc(nsum * sizeof(N_Vector)); + + for (i=0; iops->nvlinearcombination(nsum, c, Y, Z[i]); + if (ier != 0) break; + } + + /* free array of vectors */ + free(Y); + + return(ier); + + } else { + + for (i=0; iops->nvscale(c[0], X[0][i], Z[i]); + for (j=1; jops->nvlinearsum(c[j], X[j][i], ONE, Z[i], Z[i]); + } + } + return(0); + } +} + +/* ----------------------------------------------------------------- + * OPTIONAL local reduction kernels (no parallel communication) + * -----------------------------------------------------------------*/ + +realtype N_VDotProdLocal(N_Vector x, N_Vector y) +{ + return((realtype) y->ops->nvdotprodlocal(x, y)); +} + +realtype N_VMaxNormLocal(N_Vector x) +{ + return((realtype) x->ops->nvmaxnormlocal(x)); +} + +realtype N_VMinLocal(N_Vector x) +{ + return((realtype) x->ops->nvminlocal(x)); +} + +realtype N_VL1NormLocal(N_Vector x) +{ + return((realtype) x->ops->nvl1normlocal(x)); +} + +realtype N_VWSqrSumLocal(N_Vector x, N_Vector w) +{ + return((realtype) x->ops->nvwsqrsumlocal(x,w)); +} + +realtype N_VWSqrSumMaskLocal(N_Vector x, N_Vector w, N_Vector id) +{ + return((realtype) x->ops->nvwsqrsummasklocal(x,w,id)); +} + +booleantype N_VInvTestLocal(N_Vector x, N_Vector z) +{ + return((booleantype) z->ops->nvinvtestlocal(x,z)); +} + +booleantype N_VConstrMaskLocal(N_Vector c, N_Vector x, N_Vector m) +{ + return((booleantype) x->ops->nvconstrmasklocal(c,x,m)); +} + +realtype N_VMinQuotientLocal(N_Vector num, N_Vector denom) +{ + return((realtype) num->ops->nvminquotientlocal(num,denom)); +} + +/* ----------------------------------------------------------------- + * Additional functions exported by the generic NVECTOR: + * N_VNewVectorArray + * N_VCloneEmptyVectorArray + * N_VCloneVectorArray + * N_VDestroyVectorArray + * -----------------------------------------------------------------*/ +N_Vector* N_VNewVectorArray(int count) +{ + N_Vector* vs = NULL; + + if (count <= 0) return(NULL); + + vs = (N_Vector* ) malloc(count * sizeof(N_Vector)); + if(vs == NULL) return(NULL); + + return(vs); +} + +N_Vector* N_VCloneEmptyVectorArray(int count, N_Vector w) +{ + N_Vector* vs = NULL; + int j; + + if (count <= 0) return(NULL); + + vs = (N_Vector* ) malloc(count * sizeof(N_Vector)); + if(vs == NULL) return(NULL); + + for (j = 0; j < count; j++) { + vs[j] = N_VCloneEmpty(w); + if (vs[j] == NULL) { + N_VDestroyVectorArray(vs, j-1); + return(NULL); + } + } + + return(vs); +} + +N_Vector* N_VCloneVectorArray(int count, N_Vector w) +{ + N_Vector* vs = NULL; + int j; + + if (count <= 0) return(NULL); + + vs = (N_Vector* ) malloc(count * sizeof(N_Vector)); + if(vs == NULL) return(NULL); + + for (j = 0; j < count; j++) { + vs[j] = N_VClone(w); + if (vs[j] == NULL) { + N_VDestroyVectorArray(vs, j-1); + return(NULL); + } + } + + return(vs); +} + +void N_VDestroyVectorArray(N_Vector* vs, int count) +{ + int j; + + if (vs==NULL) return; + + for (j = 0; j < count; j++) N_VDestroy(vs[j]); + + free(vs); vs = NULL; + + return; +} + +/* These function are really only for users of the Fortran interface */ +N_Vector N_VGetVecAtIndexVectorArray(N_Vector* vs, int index) +{ + if (vs==NULL) return NULL; + else if (index < 0) return NULL; + else return vs[index]; +} + +void N_VSetVecAtIndexVectorArray(N_Vector* vs, int index, N_Vector w) +{ + if (vs==NULL) return; + else if (index < 0) return; + else vs[index] = w; +} diff --git a/bazaar/plugin/sundials/src/sundials/sundials_nvector_senswrapper.c b/bazaar/plugin/sundials/src/sundials/sundials_nvector_senswrapper.c new file mode 100644 index 000000000..099582327 --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/sundials_nvector_senswrapper.c @@ -0,0 +1,544 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------------------- + * This is the implementation file for a vector wrapper for an array of NVECTORS + * ---------------------------------------------------------------------------*/ + +#include +#include + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) + +/*============================================================================== + Constructors + ============================================================================*/ + +/*------------------------------------------------------------------------------ + create a new empty vector wrapper with space for vectors + ----------------------------------------------------------------------------*/ +N_Vector N_VNewEmpty_SensWrapper(int nvecs) +{ + int i; + N_Vector v; + N_Vector_Ops ops; + N_VectorContent_SensWrapper content; + + /* return if wrapper is empty */ + if (nvecs < 1) 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 *ops); + if (ops == NULL) {free(v); return(NULL);} + + ops->nvgetvectorid = NULL; + ops->nvclone = N_VClone_SensWrapper; + ops->nvcloneempty = N_VCloneEmpty_SensWrapper; + ops->nvdestroy = N_VDestroy_SensWrapper; + ops->nvspace = NULL; + ops->nvgetarraypointer = NULL; + ops->nvsetarraypointer = NULL; + + /* standard vector operations */ + ops->nvlinearsum = N_VLinearSum_SensWrapper; + ops->nvconst = N_VConst_SensWrapper; + ops->nvprod = N_VProd_SensWrapper; + ops->nvdiv = N_VDiv_SensWrapper; + ops->nvscale = N_VScale_SensWrapper; + ops->nvabs = N_VAbs_SensWrapper; + ops->nvinv = N_VInv_SensWrapper; + ops->nvaddconst = N_VAddConst_SensWrapper; + ops->nvdotprod = N_VDotProd_SensWrapper; + ops->nvmaxnorm = N_VMaxNorm_SensWrapper; + ops->nvwrmsnormmask = N_VWrmsNormMask_SensWrapper; + ops->nvwrmsnorm = N_VWrmsNorm_SensWrapper; + ops->nvmin = N_VMin_SensWrapper; + ops->nvwl2norm = N_VWL2Norm_SensWrapper; + ops->nvl1norm = N_VL1Norm_SensWrapper; + ops->nvcompare = N_VCompare_SensWrapper; + ops->nvinvtest = N_VInvTest_SensWrapper; + ops->nvconstrmask = N_VConstrMask_SensWrapper; + ops->nvminquotient = N_VMinQuotient_SensWrapper; + + /* fused vector operations */ + ops->nvlinearcombination = NULL; + ops->nvscaleaddmulti = NULL; + ops->nvdotprodmulti = NULL; + + /* vector array operations */ + ops->nvlinearsumvectorarray = NULL; + ops->nvscalevectorarray = NULL; + ops->nvconstvectorarray = NULL; + ops->nvwrmsnormvectorarray = NULL; + ops->nvwrmsnormmaskvectorarray = NULL; + ops->nvscaleaddmultivectorarray = NULL; + ops->nvlinearcombinationvectorarray = NULL; + + /* create content */ + content = NULL; + content = (N_VectorContent_SensWrapper) malloc(sizeof *content); + if (content == NULL) {free(ops); free(v); return(NULL);} + + content->nvecs = nvecs; + content->own_vecs = SUNFALSE; + content->vecs = NULL; + content->vecs = (N_Vector*) malloc(nvecs * sizeof(N_Vector)); + if (content->vecs == NULL) {free(ops); free(v); free(content); return(NULL);} + + /* initialize vector array to null */ + for (i=0; i < nvecs; i++) + content->vecs[i] = NULL; + + /* attach content and ops */ + v->content = content; + v->ops = ops; + + return(v); +} + + +N_Vector N_VNew_SensWrapper(int count, N_Vector w) +{ + N_Vector v; + int i; + + v = NULL; + v = N_VNewEmpty_SensWrapper(count); + if (v == NULL) return(NULL); + + for (i=0; i < NV_NVECS_SW(v); i++) { + NV_VEC_SW(v,i) = N_VClone(w); + if (NV_VEC_SW(v,i) == NULL) { N_VDestroy(v); return(NULL); } + } + + /* update own vectors status */ + NV_OWN_VECS_SW(v) = SUNTRUE; + + return(v); +} + + +/*============================================================================== + Clone operations + ============================================================================*/ + +/*------------------------------------------------------------------------------ + create an empty clone of the vector wrapper w + ----------------------------------------------------------------------------*/ +N_Vector N_VCloneEmpty_SensWrapper(N_Vector w) +{ + int i; + N_Vector v; + N_Vector_Ops ops; + N_VectorContent_SensWrapper content; + + if (w == NULL) return(NULL); + + if (NV_NVECS_SW(w) < 1) 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 *ops); + if (ops == NULL) { free(v); return(NULL); } + + ops->nvgetvectorid = 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; + + /* standard vector operations */ + 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; + + /* fused vector operations */ + ops->nvlinearcombination = w->ops->nvlinearcombination; + ops->nvscaleaddmulti = w->ops->nvscaleaddmulti; + ops->nvdotprodmulti = w->ops->nvdotprodmulti; + + /* vector array operations */ + ops->nvlinearsumvectorarray = w->ops->nvlinearsumvectorarray; + ops->nvscalevectorarray = w->ops->nvscalevectorarray; + ops->nvconstvectorarray = w->ops->nvconstvectorarray; + ops->nvwrmsnormvectorarray = w->ops->nvwrmsnormvectorarray; + ops->nvwrmsnormmaskvectorarray = w->ops->nvwrmsnormmaskvectorarray; + ops->nvscaleaddmultivectorarray = w->ops->nvscaleaddmultivectorarray; + ops->nvlinearcombinationvectorarray = w->ops->nvlinearcombinationvectorarray; + + /* Create content */ + content = NULL; + content = (N_VectorContent_SensWrapper) malloc(sizeof *content); + if (content == NULL) { free(ops); free(v); return(NULL); } + + content->nvecs = NV_NVECS_SW(w); + content->own_vecs = SUNFALSE; + content->vecs = NULL; + content->vecs = (N_Vector*) malloc(NV_NVECS_SW(w) * sizeof(N_Vector)); + if (content->vecs == NULL) {free(ops); free(v); free(content); return(NULL);} + + /* initialize vector array to null */ + for (i=0; i < NV_NVECS_SW(w); i++) + content->vecs[i] = NULL; + + /* Attach content and ops */ + v->content = content; + v->ops = ops; + + return(v); +} + + +/*------------------------------------------------------------------------------ + create a clone of the vector wrapper w + ----------------------------------------------------------------------------*/ +N_Vector N_VClone_SensWrapper(N_Vector w) +{ + N_Vector v; + int i; + + /* create empty wrapper */ + v = NULL; + v = N_VCloneEmpty_SensWrapper(w); + if (v == NULL) return(NULL); + + /* update own vectors status */ + NV_OWN_VECS_SW(v) = SUNTRUE; + + /* allocate arrays */ + for (i=0; i < NV_NVECS_SW(v); i++) { + NV_VEC_SW(v,i) = N_VClone(NV_VEC_SW(w,i)); + if (NV_VEC_SW(v,i) == NULL) { N_VDestroy(v); return(NULL); } + } + + return(v); +} + + +/*============================================================================== + Destructor + ============================================================================*/ + +void N_VDestroy_SensWrapper(N_Vector v) +{ + int i; + + if (NV_OWN_VECS_SW(v) == SUNTRUE) { + for (i=0; i < NV_NVECS_SW(v); i++) { + if (NV_VEC_SW(v,i)) N_VDestroy(NV_VEC_SW(v,i)); + NV_VEC_SW(v,i) = NULL; + } + } + + free(NV_VECS_SW(v)); NV_VECS_SW(v) = NULL; + free(v->content); v->content = NULL; + free(v->ops); v->ops = NULL; + free(v); v = NULL; + + return; +} + + +/*============================================================================== + Standard vector operations + ============================================================================*/ + +void N_VLinearSum_SensWrapper(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) +{ + int i; + + for (i=0; i < NV_NVECS_SW(x); i++) + N_VLinearSum(a, NV_VEC_SW(x,i), b, NV_VEC_SW(y,i), NV_VEC_SW(z,i)); + + return; +} + + +void N_VConst_SensWrapper(realtype c, N_Vector z) +{ + int i; + + for (i=0; i < NV_NVECS_SW(z); i++) + N_VConst(c, NV_VEC_SW(z,i)); + + return; +} + + +void N_VProd_SensWrapper(N_Vector x, N_Vector y, N_Vector z) +{ + int i; + + for (i=0; i < NV_NVECS_SW(x); i++) + N_VProd(NV_VEC_SW(x,i), NV_VEC_SW(y,i), NV_VEC_SW(z,i)); + + return; +} + + +void N_VDiv_SensWrapper(N_Vector x, N_Vector y, N_Vector z) +{ + int i; + + for (i=0; i < NV_NVECS_SW(x); i++) + N_VDiv(NV_VEC_SW(x,i), NV_VEC_SW(y,i), NV_VEC_SW(z,i)); + + return; +} + + +void N_VScale_SensWrapper(realtype c, N_Vector x, N_Vector z) +{ + int i; + + for (i=0; i < NV_NVECS_SW(x); i++) + N_VScale(c, NV_VEC_SW(x,i), NV_VEC_SW(z,i)); + + return; +} + + +void N_VAbs_SensWrapper(N_Vector x, N_Vector z) +{ + int i; + + for (i=0; i < NV_NVECS_SW(x); i++) + N_VAbs(NV_VEC_SW(x,i), NV_VEC_SW(z,i)); + + return; +} + + +void N_VInv_SensWrapper(N_Vector x, N_Vector z) +{ + int i; + + for (i=0; i < NV_NVECS_SW(x); i++) + N_VInv(NV_VEC_SW(x,i), NV_VEC_SW(z,i)); + + return; +} + + +void N_VAddConst_SensWrapper(N_Vector x, realtype b, N_Vector z) +{ + int i; + + for (i=0; i < NV_NVECS_SW(x); i++) + N_VAddConst(NV_VEC_SW(x,i), b, NV_VEC_SW(z,i)); + + return; +} + + +realtype N_VDotProd_SensWrapper(N_Vector x, N_Vector y) +{ + int i; + realtype sum; + + sum = ZERO; + + for (i=0; i < NV_NVECS_SW(x); i++) + sum += N_VDotProd(NV_VEC_SW(x,i), NV_VEC_SW(y,i)); + + return(sum); +} + + +realtype N_VMaxNorm_SensWrapper(N_Vector x) +{ + int i; + realtype max, tmp; + + max = ZERO; + + for (i=0; i < NV_NVECS_SW(x); i++) { + tmp = N_VMaxNorm(NV_VEC_SW(x,i)); + if (tmp > max) max = tmp; + } + + return(max); +} + + +realtype N_VWrmsNorm_SensWrapper(N_Vector x, N_Vector w) +{ + int i; + realtype nrm, tmp; + + nrm = ZERO; + + for (i=0; i < NV_NVECS_SW(x); i++) { + tmp = N_VWrmsNorm(NV_VEC_SW(x,i), NV_VEC_SW(w,i)); + if (tmp > nrm) nrm = tmp; + } + + return(nrm); +} + + +realtype N_VWrmsNormMask_SensWrapper(N_Vector x, N_Vector w, N_Vector id) +{ + int i; + realtype nrm, tmp; + + nrm = ZERO; + + for (i=0; i < NV_NVECS_SW(x); i++) { + tmp = N_VWrmsNormMask(NV_VEC_SW(x,i), NV_VEC_SW(w,i), NV_VEC_SW(id,i)); + if (tmp > nrm) nrm = tmp; + } + + return(nrm); +} + + +realtype N_VMin_SensWrapper(N_Vector x) +{ + int i; + realtype min, tmp; + + min = N_VMin(NV_VEC_SW(x,0)); + + for (i=1; i < NV_NVECS_SW(x); i++) { + tmp = N_VMin(NV_VEC_SW(x,i)); + if (tmp < min) min = tmp; + } + + return(min); +} + + +realtype N_VWL2Norm_SensWrapper(N_Vector x, N_Vector w) +{ + int i; + realtype nrm, tmp; + + nrm = ZERO; + + for (i=0; i < NV_NVECS_SW(x); i++) { + tmp = N_VWL2Norm(NV_VEC_SW(x,i), NV_VEC_SW(w,i)); + if (tmp > nrm) nrm = tmp; + } + + return(nrm); +} + + +realtype N_VL1Norm_SensWrapper(N_Vector x) +{ + int i; + realtype nrm, tmp; + + nrm = ZERO; + + for (i=0; i < NV_NVECS_SW(x); i++) { + tmp = N_VL1Norm(NV_VEC_SW(x,i)); + if (tmp > nrm) nrm = tmp; + } + + return(nrm); +} + + +void N_VCompare_SensWrapper(realtype c, N_Vector x, N_Vector z) +{ + int i; + + for (i=0; i < NV_NVECS_SW(x); i++) + N_VCompare(c, NV_VEC_SW(x,i), NV_VEC_SW(z,i)); + + return; +} + + +booleantype N_VInvTest_SensWrapper(N_Vector x, N_Vector z) +{ + int i; + booleantype no_zero_found, tmp; + + no_zero_found = SUNTRUE; + + for (i=0; i < NV_NVECS_SW(x); i++) { + tmp = N_VInvTest(NV_VEC_SW(x,i), NV_VEC_SW(z,i)); + if (tmp != SUNTRUE) no_zero_found = SUNFALSE; + } + + return(no_zero_found); +} + + +booleantype N_VConstrMask_SensWrapper(N_Vector c, N_Vector x, N_Vector m) +{ + int i; + booleantype test, tmp; + + test = SUNTRUE; + + for (i=0; i < NV_NVECS_SW(x); i++) { + tmp = N_VConstrMask(c, NV_VEC_SW(x,i), NV_VEC_SW(m,i)); + if (tmp != SUNTRUE) test = SUNFALSE; + } + + return(test); +} + + +realtype N_VMinQuotient_SensWrapper(N_Vector num, N_Vector denom) +{ + int i; + realtype min, tmp; + + min = N_VMinQuotient(NV_VEC_SW(num,0), NV_VEC_SW(denom,0)); + + for (i=1; i < NV_NVECS_SW(num); i++) { + tmp = N_VMinQuotient(NV_VEC_SW(num,i), NV_VEC_SW(denom,i)); + if (tmp < min) min = tmp; + } + + return(min); +} diff --git a/bazaar/plugin/sundials/src/sundials/sundials_version.c b/bazaar/plugin/sundials/src/sundials/sundials_version.c new file mode 100644 index 000000000..3012d67be --- /dev/null +++ b/bazaar/plugin/sundials/src/sundials/sundials_version.c @@ -0,0 +1,48 @@ +/* ----------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file implements functions for getting SUNDIALS version + * information. + * -----------------------------------------------------------------*/ + +#include + +#include + +/* fill string with SUNDIALS version information */ +int SUNDIALSGetVersion(char *version, int len) +{ + if (strlen(SUNDIALS_VERSION) > len) { + return(-1); + } + + strncpy(version, SUNDIALS_VERSION, len); + return(0); +} + +/* fill integers with SUNDIALS major, minor, and patch release + numbers and fill a string with the release label */ +int SUNDIALSGetVersionNumber(int *major, int *minor, int *patch, + char *label, int len) +{ + if (strlen(SUNDIALS_VERSION_LABEL) > len) { + return(-1); + } + + *major = SUNDIALS_VERSION_MAJOR; + *minor = SUNDIALS_VERSION_MINOR; + *patch = SUNDIALS_VERSION_PATCH; + strncpy(label, SUNDIALS_VERSION_LABEL, len); + + return(0); +} diff --git a/bazaar/plugin/sundials/src/sunlinsol/band/fmod/fsunlinsol_band_mod.c b/bazaar/plugin/sundials/src/sunlinsol/band/fmod/fsunlinsol_band_mod.c new file mode 100644 index 000000000..7216a68d0 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/band/fmod/fsunlinsol_band_mod.c @@ -0,0 +1,349 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ + +/* --------------------------------------------------------------- + * Programmer(s): Auto-generated by swig. + * --------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * -------------------------------------------------------------*/ + +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_linearsolver.h" + + +#include "sunlinsol/sunlinsol_band.h" + +SWIGEXPORT SUNLinearSolver _wrap_FSUNLinSol_Band(N_Vector farg1, SUNMatrix farg2) { + SUNLinearSolver fresult ; + N_Vector arg1 = (N_Vector) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + SUNLinearSolver result; + + arg1 = (N_Vector)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (SUNLinearSolver)SUNLinSol_Band(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT SUNLinearSolver _wrap_FSUNBandLinearSolver(N_Vector farg1, SUNMatrix farg2) { + SUNLinearSolver fresult ; + N_Vector arg1 = (N_Vector) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + SUNLinearSolver result; + + arg1 = (N_Vector)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (SUNLinearSolver)SUNBandLinearSolver(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolGetType_Band(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNLinearSolver_Type result; + + arg1 = (SUNLinearSolver)(farg1); + result = (SUNLinearSolver_Type)SUNLinSolGetType_Band(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolGetID_Band(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNLinearSolver_ID result; + + arg1 = (SUNLinearSolver)(farg1); + result = (SUNLinearSolver_ID)SUNLinSolGetID_Band(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolInitialize_Band(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolInitialize_Band(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetup_Band(SUNLinearSolver farg1, SUNMatrix farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNLinSolSetup_Band(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSolve_Band(SUNLinearSolver farg1, SUNMatrix farg2, N_Vector farg3, N_Vector farg4, double const *farg5) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + realtype arg5 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (SUNMatrix)(farg2); + arg3 = (N_Vector)(farg3); + arg4 = (N_Vector)(farg4); + arg5 = (realtype)(*farg5); + result = (int)SUNLinSolSolve_Band(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNLinSolLastFlag_Band(SUNLinearSolver farg1) { + int64_t fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + sunindextype result; + + arg1 = (SUNLinearSolver)(farg1); + result = SUNLinSolLastFlag_Band(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSpace_Band(SUNLinearSolver farg1, long *farg2, long *farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)SUNLinSolSpace_Band(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolFree_Band(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolFree_Band(arg1); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/sunlinsol/band/fsunlinsol_band.c b/bazaar/plugin/sundials/src/sunlinsol/band/fsunlinsol_band.c new file mode 100644 index 000000000..8e5dba864 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/band/fsunlinsol_band.c @@ -0,0 +1,96 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunlinsol_band.h) contains the + * implementation needed for the Fortran initialization of band + * linear solver operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fsunlinsol_band.h" + +/* Define global linsol variables */ + +SUNLinearSolver F2C_CVODE_linsol; +SUNLinearSolver F2C_IDA_linsol; +SUNLinearSolver F2C_KINSOL_linsol; +SUNLinearSolver F2C_ARKODE_linsol; +SUNLinearSolver F2C_ARKODE_mass_sol; + +/* Declarations of external global variables */ + +extern SUNMatrix F2C_CVODE_matrix; +extern SUNMatrix F2C_IDA_matrix; +extern SUNMatrix F2C_KINSOL_matrix; +extern SUNMatrix F2C_ARKODE_matrix; +extern SUNMatrix F2C_ARKODE_mass_matrix; + +extern N_Vector F2C_CVODE_vec; +extern N_Vector F2C_IDA_vec; +extern N_Vector F2C_KINSOL_vec; +extern N_Vector F2C_ARKODE_vec; + +/* Fortran callable interfaces */ + +void FSUNBANDLINSOL_INIT(int *code, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); + F2C_CVODE_linsol = NULL; + F2C_CVODE_linsol = SUNLinSol_Band(F2C_CVODE_vec, + F2C_CVODE_matrix); + if (F2C_CVODE_linsol == NULL) *ier = -1; + break; + case FCMIX_IDA: + if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); + F2C_IDA_linsol = NULL; + F2C_IDA_linsol = SUNLinSol_Band(F2C_IDA_vec, + F2C_IDA_matrix); + if (F2C_IDA_linsol == NULL) *ier = -1; + break; + case FCMIX_KINSOL: + if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); + F2C_KINSOL_linsol = NULL; + F2C_KINSOL_linsol = SUNLinSol_Band(F2C_KINSOL_vec, + F2C_KINSOL_matrix); + if (F2C_KINSOL_linsol == NULL) *ier = -1; + break; + case FCMIX_ARKODE: + if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); + F2C_ARKODE_linsol = NULL; + F2C_ARKODE_linsol = SUNLinSol_Band(F2C_ARKODE_vec, + F2C_ARKODE_matrix); + if (F2C_ARKODE_linsol == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + + +void FSUNMASSBANDLINSOL_INIT(int *ier) +{ + *ier = 0; + if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); + F2C_ARKODE_mass_sol = NULL; + F2C_ARKODE_mass_sol = SUNLinSol_Band(F2C_ARKODE_vec, + F2C_ARKODE_mass_matrix); + if (F2C_ARKODE_mass_sol == NULL) *ier = -1; +} diff --git a/bazaar/plugin/sundials/src/sunlinsol/band/fsunlinsol_band.h b/bazaar/plugin/sundials/src/sunlinsol/band/fsunlinsol_band.h new file mode 100644 index 000000000..f07a2451e --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/band/fsunlinsol_band.h @@ -0,0 +1,62 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunlinsol_band.c) contains the + * definitions needed for the initialization of band + * linear solver operations in Fortran. + * ----------------------------------------------------------------- + */ + +#ifndef _FSUNLINSOL_BAND_H +#define _FSUNLINSOL_BAND_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#if defined(SUNDIALS_F77_FUNC) +#define FSUNBANDLINSOL_INIT SUNDIALS_F77_FUNC(fsunbandlinsolinit, FSUNBANDLINSOLINIT) +#define FSUNMASSBANDLINSOL_INIT SUNDIALS_F77_FUNC(fsunmassbandlinsolinit, FSUNMASSBANDLINSOLINIT) +#else +#define FSUNBANDLINSOL_INIT fsunbandlinsolinit_ +#define FSUNMASSBANDLINSOL_INIT fsunmassbandlinsolinit_ +#endif + + +/* Declarations of global variables */ + +extern SUNLinearSolver F2C_CVODE_linsol; +extern SUNLinearSolver F2C_IDA_linsol; +extern SUNLinearSolver F2C_KINSOL_linsol; +extern SUNLinearSolver F2C_ARKODE_linsol; +extern SUNLinearSolver F2C_ARKODE_mass_sol; + +/* + * Prototypes of exported functions + * + * FSUNBANDLINSOL_INIT - initializes band linear solver for main problem + * FSUNMASSBANDLINSOL_INIT - initializes band linear solver for mass matrix solve + */ + +void FSUNBANDLINSOL_INIT(int *code, int *ier); +void FSUNMASSBANDLINSOL_INIT(int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/sunlinsol/band/sunlinsol_band.c b/bazaar/plugin/sundials/src/sunlinsol/band/sunlinsol_band.c new file mode 100644 index 000000000..86c64cac1 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/band/sunlinsol_band.c @@ -0,0 +1,250 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for the band implementation of + * the SUNLINSOL package. + * -----------------------------------------------------------------*/ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define ROW(i,j,smu) (i-j+smu) + +/* + * ----------------------------------------------------------------- + * Band solver structure accessibility macros: + * ----------------------------------------------------------------- + */ + +#define BAND_CONTENT(S) ( (SUNLinearSolverContent_Band)(S->content) ) +#define PIVOTS(S) ( BAND_CONTENT(S)->pivots ) +#define LASTFLAG(S) ( BAND_CONTENT(S)->last_flag ) + +/* + * ----------------------------------------------------------------- + * deprecated wrapper functions + * ----------------------------------------------------------------- + */ + +SUNLinearSolver SUNBandLinearSolver(N_Vector y, SUNMatrix A) +{ return(SUNLinSol_Band(y, A)); } + +/* + * ----------------------------------------------------------------- + * exported functions + * ----------------------------------------------------------------- + */ + +/* ---------------------------------------------------------------------------- + * Function to create a new band linear solver + */ + +SUNLinearSolver SUNLinSol_Band(N_Vector y, SUNMatrix A) +{ + SUNLinearSolver S; + SUNLinearSolverContent_Band content; + sunindextype MatrixRows; + + /* Check compatibility with supplied SUNMatrix and N_Vector */ + if (SUNMatGetID(A) != SUNMATRIX_BAND) return(NULL); + + if (SUNBandMatrix_Rows(A) != SUNBandMatrix_Columns(A)) return(NULL); + + if ( (N_VGetVectorID(y) != SUNDIALS_NVEC_SERIAL) && + (N_VGetVectorID(y) != SUNDIALS_NVEC_OPENMP) && + (N_VGetVectorID(y) != SUNDIALS_NVEC_PTHREADS) ) + return(NULL); + + /* Check that A has appropriate storage upper bandwidth for factorization */ + MatrixRows = SUNBandMatrix_Rows(A); + + if (SUNBandMatrix_StoredUpperBandwidth(A) < + SUNMIN(MatrixRows-1, + SUNBandMatrix_LowerBandwidth(A)+SUNBandMatrix_UpperBandwidth(A))) + return(NULL); + + if (MatrixRows != N_VGetLength(y)) return(NULL); + + /* Create an empty linear solver */ + S = NULL; + S = SUNLinSolNewEmpty(); + if (S == NULL) return(NULL); + + /* Attach operations */ + S->ops->gettype = SUNLinSolGetType_Band; + S->ops->getid = SUNLinSolGetID_Band; + S->ops->initialize = SUNLinSolInitialize_Band; + S->ops->setup = SUNLinSolSetup_Band; + S->ops->solve = SUNLinSolSolve_Band; + S->ops->lastflag = SUNLinSolLastFlag_Band; + S->ops->space = SUNLinSolSpace_Band; + S->ops->free = SUNLinSolFree_Band; + + /* Create content */ + content = NULL; + content = (SUNLinearSolverContent_Band) malloc(sizeof *content); + if (content == NULL) { SUNLinSolFree(S); return(NULL); } + + /* Attach content */ + S->content = content; + + /* Fill content */ + content->N = MatrixRows; + content->last_flag = 0; + content->pivots = NULL; + + /* Allocate content */ + content->pivots = (sunindextype *) malloc(MatrixRows * sizeof(sunindextype)); + if (content->pivots == NULL) { SUNLinSolFree(S); return(NULL); } + + return(S); +} + +/* + * ----------------------------------------------------------------- + * implementation of linear solver operations + * ----------------------------------------------------------------- + */ + +SUNLinearSolver_Type SUNLinSolGetType_Band(SUNLinearSolver S) +{ + return(SUNLINEARSOLVER_DIRECT); +} + +SUNLinearSolver_ID SUNLinSolGetID_Band(SUNLinearSolver S) +{ + return(SUNLINEARSOLVER_BAND); +} + +int SUNLinSolInitialize_Band(SUNLinearSolver S) +{ + /* all solver-specific memory has already been allocated */ + LASTFLAG(S) = SUNLS_SUCCESS; + return(SUNLS_SUCCESS); +} + +int SUNLinSolSetup_Band(SUNLinearSolver S, SUNMatrix A) +{ + realtype **A_cols; + sunindextype *pivots; + + /* check for valid inputs */ + if ( (A == NULL) || (S == NULL) ) + return(SUNLS_MEM_NULL); + + /* Ensure that A is a band matrix */ + if (SUNMatGetID(A) != SUNMATRIX_BAND) { + LASTFLAG(S) = SUNLS_ILL_INPUT; + return(SUNLS_ILL_INPUT); + } + + /* access data pointers (return with failure on NULL) */ + A_cols = NULL; + pivots = NULL; + A_cols = SM_COLS_B(A); + pivots = PIVOTS(S); + if ( (A_cols == NULL) || (pivots == NULL) ) { + LASTFLAG(S) = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + + /* ensure that storage upper bandwidth is sufficient for fill-in */ + if (SM_SUBAND_B(A) < SUNMIN(SM_COLUMNS_B(A)-1, SM_UBAND_B(A) + SM_LBAND_B(A))) { + LASTFLAG(S) = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + + /* perform LU factorization of input matrix */ + LASTFLAG(S) = bandGBTRF(A_cols, SM_COLUMNS_B(A), SM_UBAND_B(A), + SM_LBAND_B(A), SM_SUBAND_B(A), pivots); + + /* store error flag (if nonzero, that row encountered zero-valued pivod) */ + if (LASTFLAG(S) > 0) + return(SUNLS_LUFACT_FAIL); + return(SUNLS_SUCCESS); +} + +int SUNLinSolSolve_Band(SUNLinearSolver S, SUNMatrix A, N_Vector x, + N_Vector b, realtype tol) +{ + realtype **A_cols, *xdata; + sunindextype *pivots; + + /* check for valid inputs */ + if ( (A == NULL) || (S == NULL) || (x == NULL) || (b == NULL) ) + return(SUNLS_MEM_NULL); + + /* copy b into x */ + N_VScale(ONE, b, x); + + /* access data pointers (return with failure on NULL) */ + A_cols = NULL; + xdata = NULL; + pivots = NULL; + A_cols = SUNBandMatrix_Cols(A); + xdata = N_VGetArrayPointer(x); + pivots = PIVOTS(S); + if ( (A_cols == NULL) || (xdata == NULL) || (pivots == NULL) ) { + LASTFLAG(S) = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + + /* solve using LU factors */ + bandGBTRS(A_cols, SM_COLUMNS_B(A), SM_SUBAND_B(A), + SM_LBAND_B(A), pivots, xdata); + LASTFLAG(S) = SUNLS_SUCCESS; + return(SUNLS_SUCCESS); +} + +sunindextype SUNLinSolLastFlag_Band(SUNLinearSolver S) +{ + /* return the stored 'last_flag' value */ + if (S == NULL) return(-1); + return(LASTFLAG(S)); +} + +int SUNLinSolSpace_Band(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS) +{ + *leniwLS = 2 + BAND_CONTENT(S)->N; + *lenrwLS = 0; + return(SUNLS_SUCCESS); +} + +int SUNLinSolFree_Band(SUNLinearSolver S) +{ + /* return if S is already free */ + if (S == NULL) return(SUNLS_SUCCESS); + + /* delete items from contents, then delete generic structure */ + if (S->content) { + if (PIVOTS(S)) { + free(PIVOTS(S)); + PIVOTS(S) = NULL; + } + free(S->content); + S->content = NULL; + } + if (S->ops) { + free(S->ops); + S->ops = NULL; + } + free(S); S = NULL; + return(SUNLS_SUCCESS); +} diff --git a/bazaar/plugin/sundials/src/sunlinsol/dense/fmod/fsunlinsol_dense_mod.c b/bazaar/plugin/sundials/src/sunlinsol/dense/fmod/fsunlinsol_dense_mod.c new file mode 100644 index 000000000..85dfbd7ca --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/dense/fmod/fsunlinsol_dense_mod.c @@ -0,0 +1,349 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ + +/* --------------------------------------------------------------- + * Programmer(s): Auto-generated by swig. + * --------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * -------------------------------------------------------------*/ + +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_linearsolver.h" + + +#include "sunlinsol/sunlinsol_dense.h" + +SWIGEXPORT SUNLinearSolver _wrap_FSUNLinSol_Dense(N_Vector farg1, SUNMatrix farg2) { + SUNLinearSolver fresult ; + N_Vector arg1 = (N_Vector) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + SUNLinearSolver result; + + arg1 = (N_Vector)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (SUNLinearSolver)SUNLinSol_Dense(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT SUNLinearSolver _wrap_FSUNDenseLinearSolver(N_Vector farg1, SUNMatrix farg2) { + SUNLinearSolver fresult ; + N_Vector arg1 = (N_Vector) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + SUNLinearSolver result; + + arg1 = (N_Vector)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (SUNLinearSolver)SUNDenseLinearSolver(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolGetType_Dense(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNLinearSolver_Type result; + + arg1 = (SUNLinearSolver)(farg1); + result = (SUNLinearSolver_Type)SUNLinSolGetType_Dense(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolGetID_Dense(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNLinearSolver_ID result; + + arg1 = (SUNLinearSolver)(farg1); + result = (SUNLinearSolver_ID)SUNLinSolGetID_Dense(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolInitialize_Dense(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolInitialize_Dense(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetup_Dense(SUNLinearSolver farg1, SUNMatrix farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNLinSolSetup_Dense(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSolve_Dense(SUNLinearSolver farg1, SUNMatrix farg2, N_Vector farg3, N_Vector farg4, double const *farg5) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + realtype arg5 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (SUNMatrix)(farg2); + arg3 = (N_Vector)(farg3); + arg4 = (N_Vector)(farg4); + arg5 = (realtype)(*farg5); + result = (int)SUNLinSolSolve_Dense(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNLinSolLastFlag_Dense(SUNLinearSolver farg1) { + int64_t fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + sunindextype result; + + arg1 = (SUNLinearSolver)(farg1); + result = SUNLinSolLastFlag_Dense(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSpace_Dense(SUNLinearSolver farg1, long *farg2, long *farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)SUNLinSolSpace_Dense(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolFree_Dense(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolFree_Dense(arg1); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/sunlinsol/dense/fsunlinsol_dense.c b/bazaar/plugin/sundials/src/sunlinsol/dense/fsunlinsol_dense.c new file mode 100644 index 000000000..1b0fa3081 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/dense/fsunlinsol_dense.c @@ -0,0 +1,96 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunlinsol_dense.h) contains the + * implementation needed for the Fortran initialization of dense + * linear solver operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fsunlinsol_dense.h" + +/* Define global linsol variables */ + +SUNLinearSolver F2C_CVODE_linsol; +SUNLinearSolver F2C_IDA_linsol; +SUNLinearSolver F2C_KINSOL_linsol; +SUNLinearSolver F2C_ARKODE_linsol; +SUNLinearSolver F2C_ARKODE_mass_sol; + +/* Declarations of external global variables */ + +extern SUNMatrix F2C_CVODE_matrix; +extern SUNMatrix F2C_IDA_matrix; +extern SUNMatrix F2C_KINSOL_matrix; +extern SUNMatrix F2C_ARKODE_matrix; +extern SUNMatrix F2C_ARKODE_mass_matrix; + +extern N_Vector F2C_CVODE_vec; +extern N_Vector F2C_IDA_vec; +extern N_Vector F2C_KINSOL_vec; +extern N_Vector F2C_ARKODE_vec; + +/* Fortran callable interfaces */ + +void FSUNDENSELINSOL_INIT(int *code, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); + F2C_CVODE_linsol = NULL; + F2C_CVODE_linsol = SUNLinSol_Dense(F2C_CVODE_vec, + F2C_CVODE_matrix); + if (F2C_CVODE_linsol == NULL) *ier = -1; + break; + case FCMIX_IDA: + if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); + F2C_IDA_linsol = NULL; + F2C_IDA_linsol = SUNLinSol_Dense(F2C_IDA_vec, + F2C_IDA_matrix); + if (F2C_IDA_linsol == NULL) *ier = -1; + break; + case FCMIX_KINSOL: + if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); + F2C_KINSOL_linsol = NULL; + F2C_KINSOL_linsol = SUNLinSol_Dense(F2C_KINSOL_vec, + F2C_KINSOL_matrix); + if (F2C_KINSOL_linsol == NULL) *ier = -1; + break; + case FCMIX_ARKODE: + if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); + F2C_ARKODE_linsol = NULL; + F2C_ARKODE_linsol = SUNLinSol_Dense(F2C_ARKODE_vec, + F2C_ARKODE_matrix); + if (F2C_ARKODE_linsol == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + + +void FSUNMASSDENSELINSOL_INIT(int *ier) +{ + *ier = 0; + if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); + F2C_ARKODE_mass_sol = NULL; + F2C_ARKODE_mass_sol = SUNLinSol_Dense(F2C_ARKODE_vec, + F2C_ARKODE_mass_matrix); + if (F2C_ARKODE_mass_sol == NULL) *ier = -1; +} diff --git a/bazaar/plugin/sundials/src/sunlinsol/dense/fsunlinsol_dense.h b/bazaar/plugin/sundials/src/sunlinsol/dense/fsunlinsol_dense.h new file mode 100644 index 000000000..700d57ea8 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/dense/fsunlinsol_dense.h @@ -0,0 +1,62 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds, Ashley Crawford @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunlinsol_dense.c) contains the + * definitions needed for the initialization of dense + * linear solver operations in Fortran. + * ----------------------------------------------------------------- + */ + +#ifndef _FSUNLINSOL_DENSE_H +#define _FSUNLINSOL_DENSE_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#if defined(SUNDIALS_F77_FUNC) +#define FSUNDENSELINSOL_INIT SUNDIALS_F77_FUNC(fsundenselinsolinit, FSUNDENSELINSOLINIT) +#define FSUNMASSDENSELINSOL_INIT SUNDIALS_F77_FUNC(fsunmassdenselinsolinit, FSUNMASSDENSELINSOLINIT) +#else +#define FSUNDENSELINSOL_INIT fsundenselinsolinit_ +#define FSUNMASSDENSELINSOL_INIT fsunmassdenselinsolinit_ +#endif + + +/* Declarations of global variables */ + +extern SUNLinearSolver F2C_CVODE_linsol; +extern SUNLinearSolver F2C_IDA_linsol; +extern SUNLinearSolver F2C_KINSOL_linsol; +extern SUNLinearSolver F2C_ARKODE_linsol; +extern SUNLinearSolver F2C_ARKODE_mass_sol; + +/* + * Prototypes of exported functions + * + * FSUNDENSELINSOL_INIT - initializes dense linear solver for main problem + * FSUNMASSDENSELINSOL_INIT - initializes dense linear solver for mass matrix solve + */ + +void FSUNDENSELINSOL_INIT(int *code, int *ier); +void FSUNMASSDENSELINSOL_INIT(int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/sunlinsol/dense/sunlinsol_dense.c b/bazaar/plugin/sundials/src/sunlinsol/dense/sunlinsol_dense.c new file mode 100644 index 000000000..9364373de --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/dense/sunlinsol_dense.c @@ -0,0 +1,234 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds, Ashley Crawford @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for the dense implementation of + * the SUNLINSOL package. + * -----------------------------------------------------------------*/ + +#include +#include + +#include +#include + +#define ONE RCONST(1.0) + +/* + * ----------------------------------------------------------------- + * Dense solver structure accessibility macros: + * ----------------------------------------------------------------- + */ + +#define DENSE_CONTENT(S) ( (SUNLinearSolverContent_Dense)(S->content) ) +#define PIVOTS(S) ( DENSE_CONTENT(S)->pivots ) +#define LASTFLAG(S) ( DENSE_CONTENT(S)->last_flag ) + + +/* + * ----------------------------------------------------------------- + * deprecated wrapper functions + * ----------------------------------------------------------------- + */ + +SUNLinearSolver SUNDenseLinearSolver(N_Vector y, SUNMatrix A) +{ return(SUNLinSol_Dense(y, A)); } + +/* + * ----------------------------------------------------------------- + * exported functions + * ----------------------------------------------------------------- + */ + +/* ---------------------------------------------------------------------------- + * Function to create a new dense linear solver + */ + +SUNLinearSolver SUNLinSol_Dense(N_Vector y, SUNMatrix A) +{ + SUNLinearSolver S; + SUNLinearSolverContent_Dense content; + sunindextype MatrixRows; + + /* Check compatibility with supplied SUNMatrix and N_Vector */ + if (SUNMatGetID(A) != SUNMATRIX_DENSE) return(NULL); + + if (SUNDenseMatrix_Rows(A) != SUNDenseMatrix_Columns(A)) return(NULL); + + if ( (N_VGetVectorID(y) != SUNDIALS_NVEC_SERIAL) && + (N_VGetVectorID(y) != SUNDIALS_NVEC_OPENMP) && + (N_VGetVectorID(y) != SUNDIALS_NVEC_PTHREADS) ) + return(NULL); + + MatrixRows = SUNDenseMatrix_Rows(A); + if (MatrixRows != N_VGetLength(y)) return(NULL); + + /* Create an empty linear solver */ + S = NULL; + S = SUNLinSolNewEmpty(); + if (S == NULL) return(NULL); + + /* Attach operations */ + S->ops->gettype = SUNLinSolGetType_Dense; + S->ops->getid = SUNLinSolGetID_Dense; + S->ops->initialize = SUNLinSolInitialize_Dense; + S->ops->setup = SUNLinSolSetup_Dense; + S->ops->solve = SUNLinSolSolve_Dense; + S->ops->lastflag = SUNLinSolLastFlag_Dense; + S->ops->space = SUNLinSolSpace_Dense; + S->ops->free = SUNLinSolFree_Dense; + + /* Create content */ + content = NULL; + content = (SUNLinearSolverContent_Dense) malloc(sizeof *content); + if (content == NULL) { SUNLinSolFree(S); return(NULL); } + + /* Attach content */ + S->content = content; + + /* Fill content */ + content->N = MatrixRows; + content->last_flag = 0; + content->pivots = NULL; + + /* Allocate content */ + content->pivots = (sunindextype *) malloc(MatrixRows * sizeof(sunindextype)); + if (content->pivots == NULL) { SUNLinSolFree(S); return(NULL); } + + return(S); +} + +/* + * ----------------------------------------------------------------- + * implementation of linear solver operations + * ----------------------------------------------------------------- + */ + +SUNLinearSolver_Type SUNLinSolGetType_Dense(SUNLinearSolver S) +{ + return(SUNLINEARSOLVER_DIRECT); +} + +SUNLinearSolver_ID SUNLinSolGetID_Dense(SUNLinearSolver S) +{ + return(SUNLINEARSOLVER_DENSE); +} + +int SUNLinSolInitialize_Dense(SUNLinearSolver S) +{ + /* all solver-specific memory has already been allocated */ + LASTFLAG(S) = SUNLS_SUCCESS; + return(SUNLS_SUCCESS); +} + +int SUNLinSolSetup_Dense(SUNLinearSolver S, SUNMatrix A) +{ + realtype **A_cols; + sunindextype *pivots; + + /* check for valid inputs */ + if ( (A == NULL) || (S == NULL) ) + return(SUNLS_MEM_NULL); + + /* Ensure that A is a dense matrix */ + if (SUNMatGetID(A) != SUNMATRIX_DENSE) { + LASTFLAG(S) = SUNLS_ILL_INPUT; + return(SUNLS_ILL_INPUT); + } + + /* access data pointers (return with failure on NULL) */ + A_cols = NULL; + pivots = NULL; + A_cols = SUNDenseMatrix_Cols(A); + pivots = PIVOTS(S); + if ( (A_cols == NULL) || (pivots == NULL) ) { + LASTFLAG(S) = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + + /* perform LU factorization of input matrix */ + LASTFLAG(S) = denseGETRF(A_cols, SUNDenseMatrix_Rows(A), + SUNDenseMatrix_Columns(A), pivots); + + /* store error flag (if nonzero, this row encountered zero-valued pivod) */ + if (LASTFLAG(S) > 0) + return(SUNLS_LUFACT_FAIL); + return(SUNLS_SUCCESS); +} + +int SUNLinSolSolve_Dense(SUNLinearSolver S, SUNMatrix A, N_Vector x, + N_Vector b, realtype tol) +{ + realtype **A_cols, *xdata; + sunindextype *pivots; + + if ( (A == NULL) || (S == NULL) || (x == NULL) || (b == NULL) ) + return(SUNLS_MEM_NULL); + + /* copy b into x */ + N_VScale(ONE, b, x); + + /* access data pointers (return with failure on NULL) */ + A_cols = NULL; + xdata = NULL; + pivots = NULL; + A_cols = SUNDenseMatrix_Cols(A); + xdata = N_VGetArrayPointer(x); + pivots = PIVOTS(S); + if ( (A_cols == NULL) || (xdata == NULL) || (pivots == NULL) ) { + LASTFLAG(S) = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + + /* solve using LU factors */ + denseGETRS(A_cols, SUNDenseMatrix_Rows(A), pivots, xdata); + LASTFLAG(S) = SUNLS_SUCCESS; + return(SUNLS_SUCCESS); +} + +sunindextype SUNLinSolLastFlag_Dense(SUNLinearSolver S) +{ + /* return the stored 'last_flag' value */ + if (S == NULL) return(-1); + return(LASTFLAG(S)); +} + +int SUNLinSolSpace_Dense(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS) +{ + *leniwLS = 2 + DENSE_CONTENT(S)->N; + *lenrwLS = 0; + return(SUNLS_SUCCESS); +} + +int SUNLinSolFree_Dense(SUNLinearSolver S) +{ + /* return if S is already free */ + if (S == NULL) return(SUNLS_SUCCESS); + + /* delete items from contents, then delete generic structure */ + if (S->content) { + if (PIVOTS(S)) { + free(PIVOTS(S)); + PIVOTS(S) = NULL; + } + free(S->content); + S->content = NULL; + } + if (S->ops) { + free(S->ops); + S->ops = NULL; + } + free(S); S = NULL; + return(SUNLS_SUCCESS); +} diff --git a/bazaar/plugin/sundials/src/sunlinsol/pcg/fmod/fsunlinsol_pcg_mod.c b/bazaar/plugin/sundials/src/sunlinsol/pcg/fmod/fsunlinsol_pcg_mod.c new file mode 100644 index 000000000..84a66ec97 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/pcg/fmod/fsunlinsol_pcg_mod.c @@ -0,0 +1,495 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ + +/* --------------------------------------------------------------- + * Programmer(s): Auto-generated by swig. + * --------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * -------------------------------------------------------------*/ + +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_linearsolver.h" + + +#include "sunlinsol/sunlinsol_pcg.h" + +SWIGEXPORT SUNLinearSolver _wrap_FSUNLinSol_PCG(N_Vector farg1, int const *farg2, int const *farg3) { + SUNLinearSolver fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int arg3 ; + SUNLinearSolver result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + arg3 = (int)(*farg3); + result = (SUNLinearSolver)SUNLinSol_PCG(arg1,arg2,arg3); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSol_PCGSetPrecType(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNLinSol_PCGSetPrecType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSol_PCGSetMaxl(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNLinSol_PCGSetMaxl(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SUNLinearSolver _wrap_FSUNPCG(N_Vector farg1, int const *farg2, int const *farg3) { + SUNLinearSolver fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int arg3 ; + SUNLinearSolver result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + arg3 = (int)(*farg3); + result = (SUNLinearSolver)SUNPCG(arg1,arg2,arg3); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNPCGSetPrecType(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNPCGSetPrecType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNPCGSetMaxl(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNPCGSetMaxl(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolGetType_PCG(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNLinearSolver_Type result; + + arg1 = (SUNLinearSolver)(farg1); + result = (SUNLinearSolver_Type)SUNLinSolGetType_PCG(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolGetID_PCG(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNLinearSolver_ID result; + + arg1 = (SUNLinearSolver)(farg1); + result = (SUNLinearSolver_ID)SUNLinSolGetID_PCG(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolInitialize_PCG(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolInitialize_PCG(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetATimes_PCG(SUNLinearSolver farg1, void *farg2, ATimesFn farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + void *arg2 = (void *) 0 ; + ATimesFn arg3 = (ATimesFn) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (void *)(farg2); + arg3 = (ATimesFn)(farg3); + result = (int)SUNLinSolSetATimes_PCG(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetPreconditioner_PCG(SUNLinearSolver farg1, void *farg2, PSetupFn farg3, PSolveFn farg4) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + void *arg2 = (void *) 0 ; + PSetupFn arg3 = (PSetupFn) 0 ; + PSolveFn arg4 = (PSolveFn) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (void *)(farg2); + arg3 = (PSetupFn)(farg3); + arg4 = (PSolveFn)(farg4); + result = (int)SUNLinSolSetPreconditioner_PCG(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetScalingVectors_PCG(SUNLinearSolver farg1, N_Vector farg2, N_Vector farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)SUNLinSolSetScalingVectors_PCG(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetup_PCG(SUNLinearSolver farg1, SUNMatrix farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNLinSolSetup_PCG(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSolve_PCG(SUNLinearSolver farg1, SUNMatrix farg2, N_Vector farg3, N_Vector farg4, double const *farg5) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + realtype arg5 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (SUNMatrix)(farg2); + arg3 = (N_Vector)(farg3); + arg4 = (N_Vector)(farg4); + arg5 = (realtype)(*farg5); + result = (int)SUNLinSolSolve_PCG(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolNumIters_PCG(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolNumIters_PCG(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FSUNLinSolResNorm_PCG(SUNLinearSolver farg1) { + double fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + realtype result; + + arg1 = (SUNLinearSolver)(farg1); + result = (realtype)SUNLinSolResNorm_PCG(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT N_Vector _wrap_FSUNLinSolResid_PCG(SUNLinearSolver farg1) { + N_Vector fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + N_Vector result; + + arg1 = (SUNLinearSolver)(farg1); + result = (N_Vector)SUNLinSolResid_PCG(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNLinSolLastFlag_PCG(SUNLinearSolver farg1) { + int64_t fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + sunindextype result; + + arg1 = (SUNLinearSolver)(farg1); + result = SUNLinSolLastFlag_PCG(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSpace_PCG(SUNLinearSolver farg1, long *farg2, long *farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)SUNLinSolSpace_PCG(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolFree_PCG(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolFree_PCG(arg1); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/sunlinsol/pcg/fsunlinsol_pcg.c b/bazaar/plugin/sundials/src/sunlinsol/pcg/fsunlinsol_pcg.c new file mode 100644 index 000000000..05f494794 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/pcg/fsunlinsol_pcg.c @@ -0,0 +1,191 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunlinsol_pcg.h) contains the + * implementation needed for the Fortran initialization of PCG + * linear solver operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fsunlinsol_pcg.h" + +/* Define global linsol variables */ + +SUNLinearSolver F2C_CVODE_linsol; +SUNLinearSolver F2C_IDA_linsol; +SUNLinearSolver F2C_KINSOL_linsol; +SUNLinearSolver F2C_ARKODE_linsol; +SUNLinearSolver F2C_ARKODE_mass_sol; + +/* Declarations of external global variables */ + +extern SUNMatrix F2C_CVODE_matrix; +extern SUNMatrix F2C_IDA_matrix; +extern SUNMatrix F2C_KINSOL_matrix; +extern SUNMatrix F2C_ARKODE_matrix; +extern SUNMatrix F2C_ARKODE_mass_matrix; + +extern N_Vector F2C_CVODE_vec; +extern N_Vector F2C_IDA_vec; +extern N_Vector F2C_KINSOL_vec; +extern N_Vector F2C_ARKODE_vec; + +/* Fortran callable interfaces */ + +void FSUNPCG_INIT(int *code, int *pretype, int *maxl, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); + F2C_CVODE_linsol = NULL; + F2C_CVODE_linsol = SUNLinSol_PCG(F2C_CVODE_vec, *pretype, *maxl); + if (F2C_CVODE_linsol == NULL) *ier = -1; + break; + case FCMIX_IDA: + if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); + F2C_IDA_linsol = NULL; + F2C_IDA_linsol = SUNLinSol_PCG(F2C_IDA_vec, *pretype, *maxl); + if (F2C_IDA_linsol == NULL) *ier = -1; + break; + case FCMIX_KINSOL: + if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); + F2C_KINSOL_linsol = NULL; + F2C_KINSOL_linsol = SUNLinSol_PCG(F2C_KINSOL_vec, *pretype, *maxl); + if (F2C_KINSOL_linsol == NULL) *ier = -1; + break; + case FCMIX_ARKODE: + if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); + F2C_ARKODE_linsol = NULL; + F2C_ARKODE_linsol = SUNLinSol_PCG(F2C_ARKODE_vec, *pretype, *maxl); + if (F2C_ARKODE_linsol == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + + +void FSUNPCG_SETPRECTYPE(int *code, int *pretype, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (!F2C_CVODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_PCGSetPrecType(F2C_CVODE_linsol, *pretype); + break; + case FCMIX_IDA: + if (!F2C_IDA_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_PCGSetPrecType(F2C_IDA_linsol, *pretype); + break; + case FCMIX_KINSOL: + if (!F2C_KINSOL_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_PCGSetPrecType(F2C_KINSOL_linsol, *pretype); + break; + case FCMIX_ARKODE: + if (!F2C_ARKODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_PCGSetPrecType(F2C_ARKODE_linsol, *pretype); + break; + default: + *ier = -1; + } +} + + +void FSUNPCG_SETMAXL(int *code, int *maxl, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (!F2C_CVODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_PCGSetMaxl(F2C_CVODE_linsol, *maxl); + break; + case FCMIX_IDA: + if (!F2C_IDA_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_PCGSetMaxl(F2C_IDA_linsol, *maxl); + break; + case FCMIX_KINSOL: + if (!F2C_KINSOL_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_PCGSetMaxl(F2C_KINSOL_linsol, *maxl); + break; + case FCMIX_ARKODE: + if (!F2C_ARKODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_PCGSetMaxl(F2C_ARKODE_linsol, *maxl); + break; + default: + *ier = -1; + } +} + + +void FSUNMASSPCG_INIT(int *pretype, int *maxl, int *ier) +{ + *ier = 0; + if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); + F2C_ARKODE_mass_sol = NULL; + F2C_ARKODE_mass_sol = SUNLinSol_PCG(F2C_ARKODE_vec, *pretype, *maxl); + if (F2C_ARKODE_mass_sol == NULL) *ier = -1; +} + + +void FSUNMASSPCG_SETPRECTYPE(int *pretype, int *ier) +{ + *ier = 0; + if (!F2C_ARKODE_mass_sol) { + *ier = -1; + return; + } + *ier = SUNLinSol_PCGSetPrecType(F2C_ARKODE_mass_sol, *pretype); +} + + +void FSUNMASSPCG_SETMAXL(int *maxl, int *ier) +{ + *ier = 0; + if (!F2C_ARKODE_mass_sol) { + *ier = -1; + return; + } + *ier = SUNLinSol_PCGSetMaxl(F2C_ARKODE_mass_sol, *maxl); +} diff --git a/bazaar/plugin/sundials/src/sunlinsol/pcg/fsunlinsol_pcg.h b/bazaar/plugin/sundials/src/sunlinsol/pcg/fsunlinsol_pcg.h new file mode 100644 index 000000000..a56dfec0f --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/pcg/fsunlinsol_pcg.h @@ -0,0 +1,80 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunlinsol_pcg.c) contains the + * definitions needed for the initialization of PCG + * linear solver operations in Fortran. + * ----------------------------------------------------------------- + */ + +#ifndef _FSUNLINSOL_PCG_H +#define _FSUNLINSOL_PCG_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#if defined(SUNDIALS_F77_FUNC) +#define FSUNPCG_INIT SUNDIALS_F77_FUNC(fsunpcginit, FSUNPCGINIT) +#define FSUNPCG_SETPRECTYPE SUNDIALS_F77_FUNC(fsunpcgsetprectype, FSUNPCGSETPRECTYPE) +#define FSUNPCG_SETMAXL SUNDIALS_F77_FUNC(fsunpcgsetmaxl, FSUNPCGSETMAXL) +#define FSUNMASSPCG_INIT SUNDIALS_F77_FUNC(fsunmasspcginit, FSUNMASSPCGINIT) +#define FSUNMASSPCG_SETPRECTYPE SUNDIALS_F77_FUNC(fsunmasspcgsetprectype, FSUNMASSPCGSETPRECTYPE) +#define FSUNMASSPCG_SETMAXL SUNDIALS_F77_FUNC(fsunmasspcgsetmaxl, FSUNMASSPCGSETMAXL) +#else +#define FSUNPCG_INIT fsunpcginit_ +#define FSUNPCG_SETPRECTYPE fsunpcgsetprectype_ +#define FSUNPCG_SETMAXL fsunpcgsetmaxl_ +#define FSUNMASSPCG_INIT fsunmasspcginit_ +#define FSUNMASSPCG_SETPRECTYPE fsunmasspcgsetprectype_ +#define FSUNMASSPCG_SETMAXL fsunmasspcgsetmaxl_ +#endif + + +/* Declarations of global variables */ + +extern SUNLinearSolver F2C_CVODE_linsol; +extern SUNLinearSolver F2C_IDA_linsol; +extern SUNLinearSolver F2C_KINSOL_linsol; +extern SUNLinearSolver F2C_ARKODE_linsol; +extern SUNLinearSolver F2C_ARKODE_mass_sol; + +/* + * Prototypes of exported functions + * + * FSUNPCG_INIT - initializes PCG linear solver for main problem + * FSUNPCG_SETPRECTYPE - sets preconditioning type for main problem + * FSUNPCG_SETMAXL - sets the max number of iterations for main problem + * + * FSUNMASSPCG_INIT - initializes PCG linear solver for mass matrix solve + * FSUNMASSPCG_SETPRECTYPE - sets preconditioning type for mass matrix solve + * FSUNMASSPCG_SETMAXL - sets the max number of iterations for mass matrix solve + */ + +void FSUNPCG_INIT(int *code, int *pretype, int *maxl, int *ier); +void FSUNPCG_SETPRECTYPE(int *code, int *pretype, int *ier); +void FSUNPCG_SETMAXL(int *code, int *maxl, int *ier); + +void FSUNMASSPCG_INIT(int *pretype, int *maxl, int *ier); +void FSUNMASSPCG_SETPRECTYPE(int *pretype, int *ier); +void FSUNMASSPCG_SETMAXL(int *maxl, int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/sunlinsol/pcg/sunlinsol_pcg.c b/bazaar/plugin/sundials/src/sunlinsol/pcg/sunlinsol_pcg.c new file mode 100644 index 000000000..b7239fb47 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/pcg/sunlinsol_pcg.c @@ -0,0 +1,497 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds, Ashley Crawford @ SMU + * Based on sundials_pcg.c code, written by Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for the PCG implementation of + * the SUNLINSOL package. + * -----------------------------------------------------------------*/ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* + * ----------------------------------------------------------------- + * PCG solver structure accessibility macros: + * ----------------------------------------------------------------- + */ + +#define PCG_CONTENT(S) ( (SUNLinearSolverContent_PCG)(S->content) ) +#define PRETYPE(S) ( PCG_CONTENT(S)->pretype ) +#define LASTFLAG(S) ( PCG_CONTENT(S)->last_flag ) + +/* + * ----------------------------------------------------------------- + * deprecated wrapper functions + * ----------------------------------------------------------------- + */ + +SUNLinearSolver SUNPCG(N_Vector y, int pretype, int maxl) +{ return(SUNLinSol_PCG(y, pretype, maxl)); } + +int SUNPCGSetPrecType(SUNLinearSolver S, int pretype) +{ return(SUNLinSol_PCGSetPrecType(S, pretype)); } + +int SUNPCGSetMaxl(SUNLinearSolver S, int maxl) +{ return(SUNLinSol_PCGSetMaxl(S, maxl)); } + +/* + * ----------------------------------------------------------------- + * exported functions + * ----------------------------------------------------------------- + */ + +/* ---------------------------------------------------------------------------- + * Function to create a new PCG linear solver + */ + +SUNLinearSolver SUNLinSol_PCG(N_Vector y, int pretype, int maxl) +{ + SUNLinearSolver S; + SUNLinearSolverContent_PCG content; + + /* check for legal pretype and maxl values; if illegal use defaults */ + if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && + (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) + pretype = PREC_NONE; + if (maxl <= 0) + maxl = SUNPCG_MAXL_DEFAULT; + + /* Create linear solver */ + S = NULL; + S = SUNLinSolNewEmpty(); + if (S == NULL) return(NULL); + + /* Attach operations */ + S->ops->gettype = SUNLinSolGetType_PCG; + S->ops->getid = SUNLinSolGetID_PCG; + S->ops->setatimes = SUNLinSolSetATimes_PCG; + S->ops->setpreconditioner = SUNLinSolSetPreconditioner_PCG; + S->ops->setscalingvectors = SUNLinSolSetScalingVectors_PCG; + S->ops->initialize = SUNLinSolInitialize_PCG; + S->ops->setup = SUNLinSolSetup_PCG; + S->ops->solve = SUNLinSolSolve_PCG; + S->ops->numiters = SUNLinSolNumIters_PCG; + S->ops->resnorm = SUNLinSolResNorm_PCG; + S->ops->resid = SUNLinSolResid_PCG; + S->ops->lastflag = SUNLinSolLastFlag_PCG; + S->ops->space = SUNLinSolSpace_PCG; + S->ops->free = SUNLinSolFree_PCG; + + /* Create content */ + content = NULL; + content = (SUNLinearSolverContent_PCG) malloc(sizeof *content); + if (content == NULL) { SUNLinSolFree(S); return(NULL); } + + /* Attach content */ + S->content = content; + + /* Fill content */ + content->last_flag = 0; + content->maxl = maxl; + content->pretype = pretype; + content->numiters = 0; + content->resnorm = ZERO; + content->r = NULL; + content->p = NULL; + content->z = NULL; + content->Ap = NULL; + content->s = NULL; + content->ATimes = NULL; + content->ATData = NULL; + content->Psetup = NULL; + content->Psolve = NULL; + content->PData = NULL; + + /* Allocate content */ + content->r = N_VClone(y); + if (content->r == NULL) { SUNLinSolFree(S); return NULL; } + + content->p = N_VClone(y); + if (content->p == NULL) { SUNLinSolFree(S); return NULL; } + + content->z = N_VClone(y); + if (content->z == NULL) { SUNLinSolFree(S); return NULL; } + + content->Ap = N_VClone(y); + if (content->Ap == NULL) { SUNLinSolFree(S); return NULL; } + + return(S); +} + + +/* ---------------------------------------------------------------------------- + * Function to set the type of preconditioning for PCG to use + */ + +SUNDIALS_EXPORT int SUNLinSol_PCGSetPrecType(SUNLinearSolver S, int pretype) +{ + /* Check for legal pretype */ + if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && + (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { + return(SUNLS_ILL_INPUT); + } + + /* Check for non-NULL SUNLinearSolver */ + if (S == NULL) return(SUNLS_MEM_NULL); + + /* Set pretype */ + PRETYPE(S) = pretype; + return(SUNLS_SUCCESS); +} + + +/* ---------------------------------------------------------------------------- + * Function to set the maximum number of iterations for PCG to use + */ + +SUNDIALS_EXPORT int SUNLinSol_PCGSetMaxl(SUNLinearSolver S, int maxl) +{ + /* Check for non-NULL SUNLinearSolver */ + if (S == NULL) return(SUNLS_MEM_NULL); + + /* Check for legal pretype */ + if (maxl <= 0) + maxl = SUNPCG_MAXL_DEFAULT; + + /* Set pretype */ + PCG_CONTENT(S)->maxl = maxl; + return(SUNLS_SUCCESS); +} + + +/* + * ----------------------------------------------------------------- + * implementation of linear solver operations + * ----------------------------------------------------------------- + */ + +SUNLinearSolver_Type SUNLinSolGetType_PCG(SUNLinearSolver S) +{ + return(SUNLINEARSOLVER_ITERATIVE); +} + + +SUNLinearSolver_ID SUNLinSolGetID_PCG(SUNLinearSolver S) +{ + return(SUNLINEARSOLVER_PCG); +} + + +int SUNLinSolInitialize_PCG(SUNLinearSolver S) +{ + /* ensure valid options */ + if (S == NULL) return(SUNLS_MEM_NULL); + if ( (PRETYPE(S) != PREC_LEFT) && + (PRETYPE(S) != PREC_RIGHT) && + (PRETYPE(S) != PREC_BOTH) ) + PRETYPE(S) = PREC_NONE; + if (PCG_CONTENT(S)->maxl <= 0) + PCG_CONTENT(S)->maxl = SUNPCG_MAXL_DEFAULT; + + /* no additional memory to allocate */ + + /* return with success */ + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetATimes_PCG(SUNLinearSolver S, void* ATData, + ATimesFn ATimes) +{ + /* set function pointers to integrator-supplied ATimes routine + and data, and return with success */ + if (S == NULL) return(SUNLS_MEM_NULL); + PCG_CONTENT(S)->ATimes = ATimes; + PCG_CONTENT(S)->ATData = ATData; + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetPreconditioner_PCG(SUNLinearSolver S, void* PData, + PSetupFn Psetup, PSolveFn Psolve) +{ + /* set function pointers to integrator-supplied Psetup and PSolve + routines and data, and return with success */ + if (S == NULL) return(SUNLS_MEM_NULL); + PCG_CONTENT(S)->Psetup = Psetup; + PCG_CONTENT(S)->Psolve = Psolve; + PCG_CONTENT(S)->PData = PData; + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetScalingVectors_PCG(SUNLinearSolver S, N_Vector s, + N_Vector nul) +{ + /* set N_Vector pointer to integrator-supplied scaling vector + (only use the first one), and return with success */ + if (S == NULL) return(SUNLS_MEM_NULL); + PCG_CONTENT(S)->s = s; + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetup_PCG(SUNLinearSolver S, SUNMatrix nul) +{ + int ier; + PSetupFn Psetup; + void* PData; + + /* Set shortcuts to PCG memory structures */ + if (S == NULL) return(SUNLS_MEM_NULL); + Psetup = PCG_CONTENT(S)->Psetup; + PData = PCG_CONTENT(S)->PData; + + /* no solver-specific setup is required, but if user-supplied + Psetup routine exists, call that here */ + if (Psetup != NULL) { + ier = Psetup(PData); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSET_FAIL_UNREC : SUNLS_PSET_FAIL_REC; + return(LASTFLAG(S)); + } + } + + /* return with success */ + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSolve_PCG(SUNLinearSolver S, SUNMatrix nul, N_Vector x, + N_Vector b, realtype delta) +{ + /* local data and shortcut variables */ + realtype alpha, beta, r0_norm, rho, rz, rz_old; + N_Vector r, p, z, Ap, w; + booleantype UsePrec, UseScaling, converged; + int l, l_max, pretype, ier; + void *A_data, *P_data; + ATimesFn atimes; + PSolveFn psolve; + realtype *res_norm; + int *nli; + + /* Make local shorcuts to solver variables. */ + if (S == NULL) return(SUNLS_MEM_NULL); + l_max = PCG_CONTENT(S)->maxl; + r = PCG_CONTENT(S)->r; + p = PCG_CONTENT(S)->p; + z = PCG_CONTENT(S)->z; + Ap = PCG_CONTENT(S)->Ap; + w = PCG_CONTENT(S)->s; + A_data = PCG_CONTENT(S)->ATData; + P_data = PCG_CONTENT(S)->PData; + atimes = PCG_CONTENT(S)->ATimes; + psolve = PCG_CONTENT(S)->Psolve; + pretype = PCG_CONTENT(S)->pretype; + nli = &(PCG_CONTENT(S)->numiters); + res_norm = &(PCG_CONTENT(S)->resnorm); + + /* Initialize counters and convergence flag */ + *nli = 0; + converged = SUNFALSE; + + /* set booleantype flags for internal solver options */ + UsePrec = ( (pretype == PREC_BOTH) || + (pretype == PREC_LEFT) || + (pretype == PREC_RIGHT) ); + UseScaling = (w != NULL); + + /* Set r to initial residual r_0 = b - A*x_0 */ + if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r); + else { + ier = atimes(A_data, x, r); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; + return(LASTFLAG(S)); + } + N_VLinearSum(ONE, b, -ONE, r, r); + } + + /* Set rho to scaled L2 norm of r, and return if small */ + if (UseScaling) N_VProd(r, w, Ap); + else N_VScale(ONE, r, Ap); + *res_norm = r0_norm = rho = SUNRsqrt(N_VDotProd(Ap, Ap)); + if (rho <= delta) { + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); + } + + /* Apply preconditioner and b-scaling to r = r_0 */ + if (UsePrec) { + ier = psolve(P_data, r, z, delta, PREC_LEFT); /* z = P^{-1}r */ + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } + else N_VScale(ONE, r, z); + + /* Initialize rz to */ + rz = N_VDotProd(r, z); + + /* Copy z to p */ + N_VScale(ONE, z, p); + + /* Begin main iteration loop */ + for(l=0; l / */ + alpha = rz / N_VDotProd(Ap, p); + + /* Update x = x + alpha*p */ + N_VLinearSum(ONE, x, alpha, p, x); + + /* Update r = r - alpha*Ap */ + N_VLinearSum(ONE, r, -alpha, Ap, r); + + /* Set rho and check convergence */ + if (UseScaling) N_VProd(r, w, Ap); + else N_VScale(ONE, r, Ap); + *res_norm = rho = SUNRsqrt(N_VDotProd(Ap, Ap)); + if (rho <= delta) { + converged = SUNTRUE; + break; + } + + /* Apply preconditioner: z = P^{-1}*r */ + if (UsePrec) { + ier = psolve(P_data, r, z, delta, PREC_LEFT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } + else N_VScale(ONE, r, z); + + /* update rz */ + rz_old = rz; + rz = N_VDotProd(r, z); + + /* Calculate beta = / */ + beta = rz / rz_old; + + /* Update p = z + beta*p */ + N_VLinearSum(ONE, z, beta, p, p); + } + + /* Main loop finished, return with result */ + if (converged == SUNTRUE) { + LASTFLAG(S) = SUNLS_SUCCESS; + } else if (rho < r0_norm) { + LASTFLAG(S) = SUNLS_RES_REDUCED; + } else { + LASTFLAG(S) = SUNLS_CONV_FAIL; + } + return(LASTFLAG(S)); +} + + + + +int SUNLinSolNumIters_PCG(SUNLinearSolver S) +{ + /* return the stored 'numiters' value */ + if (S == NULL) return(-1); + return (PCG_CONTENT(S)->numiters); +} + + +realtype SUNLinSolResNorm_PCG(SUNLinearSolver S) +{ + /* return the stored 'resnorm' value */ + if (S == NULL) return(-ONE); + return (PCG_CONTENT(S)->resnorm); +} + + +N_Vector SUNLinSolResid_PCG(SUNLinearSolver S) +{ + /* return the stored 'r' vector */ + return (PCG_CONTENT(S)->r); +} + + +sunindextype SUNLinSolLastFlag_PCG(SUNLinearSolver S) +{ + /* return the stored 'last_flag' value */ + if (S == NULL) return(-1); + return (LASTFLAG(S)); +} + + +int SUNLinSolSpace_PCG(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS) +{ + sunindextype liw1, lrw1; + N_VSpace(PCG_CONTENT(S)->r, &lrw1, &liw1); + *lenrwLS = 1 + lrw1*4; + *leniwLS = 4 + liw1*4; + return(SUNLS_SUCCESS); +} + +int SUNLinSolFree_PCG(SUNLinearSolver S) +{ + if (S == NULL) return(SUNLS_SUCCESS); + + if (S->content) { + /* delete items from within the content structure */ + if (PCG_CONTENT(S)->r) { + N_VDestroy(PCG_CONTENT(S)->r); + PCG_CONTENT(S)->r = NULL; + } + if (PCG_CONTENT(S)->p) { + N_VDestroy(PCG_CONTENT(S)->p); + PCG_CONTENT(S)->p = NULL; + } + if (PCG_CONTENT(S)->z) { + N_VDestroy(PCG_CONTENT(S)->z); + PCG_CONTENT(S)->z = NULL; + } + if (PCG_CONTENT(S)->Ap) { + N_VDestroy(PCG_CONTENT(S)->Ap); + PCG_CONTENT(S)->Ap = NULL; + } + free(S->content); S->content = NULL; + } + if (S->ops) { free(S->ops); S->ops = NULL; } + free(S); S = NULL; + return(SUNLS_SUCCESS); +} diff --git a/bazaar/plugin/sundials/src/sunlinsol/spbcgs/fmod/fsunlinsol_spbcgs_mod.c b/bazaar/plugin/sundials/src/sunlinsol/spbcgs/fmod/fsunlinsol_spbcgs_mod.c new file mode 100644 index 000000000..932a0ebcd --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/spbcgs/fmod/fsunlinsol_spbcgs_mod.c @@ -0,0 +1,495 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ + +/* --------------------------------------------------------------- + * Programmer(s): Auto-generated by swig. + * --------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * -------------------------------------------------------------*/ + +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_linearsolver.h" + + +#include "sunlinsol/sunlinsol_spbcgs.h" + +SWIGEXPORT SUNLinearSolver _wrap_FSUNLinSol_SPBCGS(N_Vector farg1, int const *farg2, int const *farg3) { + SUNLinearSolver fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int arg3 ; + SUNLinearSolver result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + arg3 = (int)(*farg3); + result = (SUNLinearSolver)SUNLinSol_SPBCGS(arg1,arg2,arg3); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSol_SPBCGSSetPrecType(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNLinSol_SPBCGSSetPrecType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSol_SPBCGSSetMaxl(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNLinSol_SPBCGSSetMaxl(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SUNLinearSolver _wrap_FSUNSPBCGS(N_Vector farg1, int const *farg2, int const *farg3) { + SUNLinearSolver fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int arg3 ; + SUNLinearSolver result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + arg3 = (int)(*farg3); + result = (SUNLinearSolver)SUNSPBCGS(arg1,arg2,arg3); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNSPBCGSSetPrecType(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNSPBCGSSetPrecType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNSPBCGSSetMaxl(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNSPBCGSSetMaxl(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolGetType_SPBCGS(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNLinearSolver_Type result; + + arg1 = (SUNLinearSolver)(farg1); + result = (SUNLinearSolver_Type)SUNLinSolGetType_SPBCGS(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolGetID_SPBCGS(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNLinearSolver_ID result; + + arg1 = (SUNLinearSolver)(farg1); + result = (SUNLinearSolver_ID)SUNLinSolGetID_SPBCGS(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolInitialize_SPBCGS(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolInitialize_SPBCGS(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetATimes_SPBCGS(SUNLinearSolver farg1, void *farg2, ATimesFn farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + void *arg2 = (void *) 0 ; + ATimesFn arg3 = (ATimesFn) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (void *)(farg2); + arg3 = (ATimesFn)(farg3); + result = (int)SUNLinSolSetATimes_SPBCGS(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetPreconditioner_SPBCGS(SUNLinearSolver farg1, void *farg2, PSetupFn farg3, PSolveFn farg4) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + void *arg2 = (void *) 0 ; + PSetupFn arg3 = (PSetupFn) 0 ; + PSolveFn arg4 = (PSolveFn) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (void *)(farg2); + arg3 = (PSetupFn)(farg3); + arg4 = (PSolveFn)(farg4); + result = (int)SUNLinSolSetPreconditioner_SPBCGS(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetScalingVectors_SPBCGS(SUNLinearSolver farg1, N_Vector farg2, N_Vector farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)SUNLinSolSetScalingVectors_SPBCGS(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetup_SPBCGS(SUNLinearSolver farg1, SUNMatrix farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNLinSolSetup_SPBCGS(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSolve_SPBCGS(SUNLinearSolver farg1, SUNMatrix farg2, N_Vector farg3, N_Vector farg4, double const *farg5) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + realtype arg5 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (SUNMatrix)(farg2); + arg3 = (N_Vector)(farg3); + arg4 = (N_Vector)(farg4); + arg5 = (realtype)(*farg5); + result = (int)SUNLinSolSolve_SPBCGS(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolNumIters_SPBCGS(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolNumIters_SPBCGS(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FSUNLinSolResNorm_SPBCGS(SUNLinearSolver farg1) { + double fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + realtype result; + + arg1 = (SUNLinearSolver)(farg1); + result = (realtype)SUNLinSolResNorm_SPBCGS(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT N_Vector _wrap_FSUNLinSolResid_SPBCGS(SUNLinearSolver farg1) { + N_Vector fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + N_Vector result; + + arg1 = (SUNLinearSolver)(farg1); + result = (N_Vector)SUNLinSolResid_SPBCGS(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNLinSolLastFlag_SPBCGS(SUNLinearSolver farg1) { + int64_t fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + sunindextype result; + + arg1 = (SUNLinearSolver)(farg1); + result = SUNLinSolLastFlag_SPBCGS(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSpace_SPBCGS(SUNLinearSolver farg1, long *farg2, long *farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)SUNLinSolSpace_SPBCGS(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolFree_SPBCGS(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolFree_SPBCGS(arg1); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/sunlinsol/spbcgs/fsunlinsol_spbcgs.c b/bazaar/plugin/sundials/src/sunlinsol/spbcgs/fsunlinsol_spbcgs.c new file mode 100644 index 000000000..8420e2981 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/spbcgs/fsunlinsol_spbcgs.c @@ -0,0 +1,191 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunlinsol_spbcgs.h) contains the + * implementation needed for the Fortran initialization of SPBCGS + * linear solver operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fsunlinsol_spbcgs.h" + +/* Define global linsol variables */ + +SUNLinearSolver F2C_CVODE_linsol; +SUNLinearSolver F2C_IDA_linsol; +SUNLinearSolver F2C_KINSOL_linsol; +SUNLinearSolver F2C_ARKODE_linsol; +SUNLinearSolver F2C_ARKODE_mass_sol; + +/* Declarations of external global variables */ + +extern SUNMatrix F2C_CVODE_matrix; +extern SUNMatrix F2C_IDA_matrix; +extern SUNMatrix F2C_KINSOL_matrix; +extern SUNMatrix F2C_ARKODE_matrix; +extern SUNMatrix F2C_ARKODE_mass_matrix; + +extern N_Vector F2C_CVODE_vec; +extern N_Vector F2C_IDA_vec; +extern N_Vector F2C_KINSOL_vec; +extern N_Vector F2C_ARKODE_vec; + +/* Fortran callable interfaces */ + +void FSUNSPBCGS_INIT(int *code, int *pretype, int *maxl, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); + F2C_CVODE_linsol = NULL; + F2C_CVODE_linsol = SUNLinSol_SPBCGS(F2C_CVODE_vec, *pretype, *maxl); + if (F2C_CVODE_linsol == NULL) *ier = -1; + break; + case FCMIX_IDA: + if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); + F2C_IDA_linsol = NULL; + F2C_IDA_linsol = SUNLinSol_SPBCGS(F2C_IDA_vec, *pretype, *maxl); + if (F2C_IDA_linsol == NULL) *ier = -1; + break; + case FCMIX_KINSOL: + if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); + F2C_KINSOL_linsol = NULL; + F2C_KINSOL_linsol = SUNLinSol_SPBCGS(F2C_KINSOL_vec, *pretype, *maxl); + if (F2C_KINSOL_linsol == NULL) *ier = -1; + break; + case FCMIX_ARKODE: + if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); + F2C_ARKODE_linsol = NULL; + F2C_ARKODE_linsol = SUNLinSol_SPBCGS(F2C_ARKODE_vec, *pretype, *maxl); + if (F2C_ARKODE_linsol == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + + +void FSUNSPBCGS_SETPRECTYPE(int *code, int *pretype, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (!F2C_CVODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPBCGSSetPrecType(F2C_CVODE_linsol, *pretype); + break; + case FCMIX_IDA: + if (!F2C_IDA_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPBCGSSetPrecType(F2C_IDA_linsol, *pretype); + break; + case FCMIX_KINSOL: + if (!F2C_KINSOL_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPBCGSSetPrecType(F2C_KINSOL_linsol, *pretype); + break; + case FCMIX_ARKODE: + if (!F2C_ARKODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPBCGSSetPrecType(F2C_ARKODE_linsol, *pretype); + break; + default: + *ier = -1; + } +} + + +void FSUNSPBCGS_SETMAXL(int *code, int *maxl, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (!F2C_CVODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPBCGSSetMaxl(F2C_CVODE_linsol, *maxl); + break; + case FCMIX_IDA: + if (!F2C_IDA_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPBCGSSetMaxl(F2C_IDA_linsol, *maxl); + break; + case FCMIX_KINSOL: + if (!F2C_KINSOL_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPBCGSSetMaxl(F2C_KINSOL_linsol, *maxl); + break; + case FCMIX_ARKODE: + if (!F2C_ARKODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPBCGSSetMaxl(F2C_ARKODE_linsol, *maxl); + break; + default: + *ier = -1; + } +} + + +void FSUNMASSSPBCGS_INIT(int *pretype, int *maxl, int *ier) +{ + *ier = 0; + if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); + F2C_ARKODE_mass_sol = NULL; + F2C_ARKODE_mass_sol = SUNLinSol_SPBCGS(F2C_ARKODE_vec, *pretype, *maxl); + if (F2C_ARKODE_mass_sol == NULL) *ier = -1; +} + + +void FSUNMASSSPBCGS_SETPRECTYPE(int *pretype, int *ier) +{ + *ier = 0; + if (!F2C_ARKODE_mass_sol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPBCGSSetPrecType(F2C_ARKODE_mass_sol, *pretype); +} + + +void FSUNMASSSPBCGS_SETMAXL(int *maxl, int *ier) +{ + *ier = 0; + if (!F2C_ARKODE_mass_sol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPBCGSSetMaxl(F2C_ARKODE_mass_sol, *maxl); +} diff --git a/bazaar/plugin/sundials/src/sunlinsol/spbcgs/fsunlinsol_spbcgs.h b/bazaar/plugin/sundials/src/sunlinsol/spbcgs/fsunlinsol_spbcgs.h new file mode 100644 index 000000000..27566f1b3 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/spbcgs/fsunlinsol_spbcgs.h @@ -0,0 +1,80 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunlinsol_spbcgs.c) contains the + * definitions needed for the initialization of SPBCGS + * linear solver operations in Fortran. + * ----------------------------------------------------------------- + */ + +#ifndef _FSUNLINSOL_SPBCGS_H +#define _FSUNLINSOL_SPBCGS_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#if defined(SUNDIALS_F77_FUNC) +#define FSUNSPBCGS_INIT SUNDIALS_F77_FUNC(fsunspbcgsinit, FSUNSPBCGSINIT) +#define FSUNSPBCGS_SETPRECTYPE SUNDIALS_F77_FUNC(fsunspbcgssetprectype, FSUNSPBCGSSETPRECTYPE) +#define FSUNSPBCGS_SETMAXL SUNDIALS_F77_FUNC(fsunspbcgssetmaxl, FSUNSPBCGSSETMAXL) +#define FSUNMASSSPBCGS_INIT SUNDIALS_F77_FUNC(fsunmassspbcgsinit, FSUNMASSSPBCGSINIT) +#define FSUNMASSSPBCGS_SETPRECTYPE SUNDIALS_F77_FUNC(fsunmassspbcgssetprectype, FSUNMASSSPBCGSSETPRECTYPE) +#define FSUNMASSSPBCGS_SETMAXL SUNDIALS_F77_FUNC(fsunmassspbcgssetmaxl, FSUNMASSSPBCGSSETMAXL) +#else +#define FSUNSPBCGS_INIT fsunspbcgsinit_ +#define FSUNSPBCGS_SETPRECTYPE fsunspbcgssetprectype_ +#define FSUNSPBCGS_SETMAXL fsunspbcgssetmaxl_ +#define FSUNMASSSPBCGS_INIT fsunmassspbcgsinit_ +#define FSUNMASSSPBCGS_SETPRECTYPE fsunmassspbcgssetprectype_ +#define FSUNMASSSPBCGS_SETMAXL fsunmassspbcgssetmaxl_ +#endif + + +/* Declarations of global variables */ + +extern SUNLinearSolver F2C_CVODE_linsol; +extern SUNLinearSolver F2C_IDA_linsol; +extern SUNLinearSolver F2C_KINSOL_linsol; +extern SUNLinearSolver F2C_ARKODE_linsol; +extern SUNLinearSolver F2C_ARKODE_mass_sol; + +/* + * Prototypes of exported functions + * + * FSUNSPBCGS_INIT - initializes SPBCGS linear solver for main problem + * FSUNSPBCGS_SETPRECTYPE - sets the preconditioning type for main problem + * FSUNSPBCGS_SETMAXL - sets the max number of iterations for main problem + * + * FSUNMASSSPBCGS_INIT - initializes SPBCGS linear solver for mass matrix solve + * FSUNMASSSPBCGS_SETPRECTYPE - sets the preconditioning type for mass matrix solve + * FSUNMASSSPBCGS_SETMAXL - sets the max number of iterations for mass matrix solve + */ + +void FSUNSPBCGS_INIT(int *code, int *pretype, int *maxl, int *ier); +void FSUNSPBCGS_SETPRECTYPE(int *code, int *pretype, int *ier); +void FSUNSPBCGS_SETMAXL(int *code, int *maxl, int *ier); + +void FSUNMASSSPBCGS_INIT(int *pretype, int *maxl, int *ier); +void FSUNMASSSPBCGS_SETPRECTYPE(int *pretype, int *ier); +void FSUNMASSSPBCGS_SETMAXL(int *maxl, int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/sunlinsol/spbcgs/sunlinsol_spbcgs.c b/bazaar/plugin/sundials/src/sunlinsol/spbcgs/sunlinsol_spbcgs.c new file mode 100644 index 000000000..625a0dcb0 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/spbcgs/sunlinsol_spbcgs.c @@ -0,0 +1,676 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * Based on sundials_spbcgs.c code, written by Peter Brown and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for the SPBCGS implementation of + * the SUNLINSOL package. + * -----------------------------------------------------------------*/ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* + * ----------------------------------------------------------------- + * SPBCGS solver structure accessibility macros: + * ----------------------------------------------------------------- + */ + +#define SPBCGS_CONTENT(S) ( (SUNLinearSolverContent_SPBCGS)(S->content) ) +#define PRETYPE(S) ( SPBCGS_CONTENT(S)->pretype ) +#define LASTFLAG(S) ( SPBCGS_CONTENT(S)->last_flag ) + +/* + * ----------------------------------------------------------------- + * deprecated wrapper functions + * ----------------------------------------------------------------- + */ + +SUNLinearSolver SUNSPBCGS(N_Vector y, int pretype, int maxl) +{ return(SUNLinSol_SPBCGS(y, pretype, maxl)); } + +int SUNSPBCGSSetPrecType(SUNLinearSolver S, int pretype) +{ return(SUNLinSol_SPBCGSSetPrecType(S, pretype)); } + +int SUNSPBCGSSetMaxl(SUNLinearSolver S, int maxl) +{ return(SUNLinSol_SPBCGSSetMaxl(S, maxl)); } + +/* + * ----------------------------------------------------------------- + * exported functions + * ----------------------------------------------------------------- + */ + +/* ---------------------------------------------------------------------------- + * Function to create a new SPBCGS linear solver + */ + +SUNLinearSolver SUNLinSol_SPBCGS(N_Vector y, int pretype, int maxl) +{ + SUNLinearSolver S; + SUNLinearSolverContent_SPBCGS content; + + /* check for legal pretype and maxl values; if illegal use defaults */ + if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && + (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) + pretype = PREC_NONE; + if (maxl <= 0) + maxl = SUNSPBCGS_MAXL_DEFAULT; + + /* check that the supplied N_Vector supports all requisite operations */ + if ( (y->ops->nvclone == NULL) || (y->ops->nvdestroy == NULL) || + (y->ops->nvlinearsum == NULL) || (y->ops->nvprod == NULL) || + (y->ops->nvdiv == NULL) || (y->ops->nvscale == NULL) || + (y->ops->nvdotprod == NULL) ) + return(NULL); + + /* Create linear solver */ + S = NULL; + S = SUNLinSolNewEmpty(); + if (S == NULL) return(NULL); + + /* Attach operations */ + S->ops->gettype = SUNLinSolGetType_SPBCGS; + S->ops->getid = SUNLinSolGetID_SPBCGS; + S->ops->setatimes = SUNLinSolSetATimes_SPBCGS; + S->ops->setpreconditioner = SUNLinSolSetPreconditioner_SPBCGS; + S->ops->setscalingvectors = SUNLinSolSetScalingVectors_SPBCGS; + S->ops->initialize = SUNLinSolInitialize_SPBCGS; + S->ops->setup = SUNLinSolSetup_SPBCGS; + S->ops->solve = SUNLinSolSolve_SPBCGS; + S->ops->numiters = SUNLinSolNumIters_SPBCGS; + S->ops->resnorm = SUNLinSolResNorm_SPBCGS; + S->ops->resid = SUNLinSolResid_SPBCGS; + S->ops->lastflag = SUNLinSolLastFlag_SPBCGS; + S->ops->space = SUNLinSolSpace_SPBCGS; + S->ops->free = SUNLinSolFree_SPBCGS; + + /* Create content */ + content = NULL; + content = (SUNLinearSolverContent_SPBCGS) malloc(sizeof *content); + if (content == NULL) { SUNLinSolFree(S); return(NULL); } + + /* Attach content */ + S->content = content; + + /* Fill content */ + content->last_flag = 0; + content->maxl = maxl; + content->pretype = pretype; + content->numiters = 0; + content->resnorm = ZERO; + content->r_star = NULL; + content->r = NULL; + content->p = NULL; + content->q = NULL; + content->u = NULL; + content->Ap = NULL; + content->vtemp = NULL; + content->s1 = NULL; + content->s2 = NULL; + content->ATimes = NULL; + content->ATData = NULL; + content->Psetup = NULL; + content->Psolve = NULL; + content->PData = NULL; + + /* Allocate content */ + content->r_star = N_VClone(y); + if (content->r_star == NULL) { SUNLinSolFree(S); return(NULL); } + + content->r = N_VClone(y); + if (content->r == NULL) { SUNLinSolFree(S); return(NULL); } + + content->p = N_VClone(y); + if (content->p == NULL) { SUNLinSolFree(S); return(NULL); } + + content->q = N_VClone(y); + if (content->q == NULL) { SUNLinSolFree(S); return(NULL); } + + content->u = N_VClone(y); + if (content->u == NULL) { SUNLinSolFree(S); return(NULL); } + + content->Ap = N_VClone(y); + if (content->Ap == NULL) { SUNLinSolFree(S); return(NULL); } + + content->vtemp = N_VClone(y); + if (content->vtemp == NULL) { SUNLinSolFree(S); return(NULL); } + + return(S); +} + + +/* ---------------------------------------------------------------------------- + * Function to set the type of preconditioning for SPBCGS to use + */ + +SUNDIALS_EXPORT int SUNLinSol_SPBCGSSetPrecType(SUNLinearSolver S, int pretype) +{ + /* Check for legal pretype */ + if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && + (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { + return(SUNLS_ILL_INPUT); + } + + /* Check for non-NULL SUNLinearSolver */ + if (S == NULL) return(SUNLS_MEM_NULL); + + /* Set pretype */ + PRETYPE(S) = pretype; + return(SUNLS_SUCCESS); +} + + +/* ---------------------------------------------------------------------------- + * Function to set the maximum number of iterations for SPBCGS to use + */ + +SUNDIALS_EXPORT int SUNLinSol_SPBCGSSetMaxl(SUNLinearSolver S, int maxl) +{ + /* Check for non-NULL SUNLinearSolver */ + if (S == NULL) return(SUNLS_MEM_NULL); + + /* Check for legal pretype */ + if (maxl <= 0) + maxl = SUNSPBCGS_MAXL_DEFAULT; + + /* Set pretype */ + SPBCGS_CONTENT(S)->maxl = maxl; + return(SUNLS_SUCCESS); +} + + +/* + * ----------------------------------------------------------------- + * implementation of linear solver operations + * ----------------------------------------------------------------- + */ + +SUNLinearSolver_Type SUNLinSolGetType_SPBCGS(SUNLinearSolver S) +{ + return(SUNLINEARSOLVER_ITERATIVE); +} + + +SUNLinearSolver_ID SUNLinSolGetID_SPBCGS(SUNLinearSolver S) +{ + return(SUNLINEARSOLVER_SPBCGS); +} + + +int SUNLinSolInitialize_SPBCGS(SUNLinearSolver S) +{ + /* ensure valid options */ + if (S == NULL) return(SUNLS_MEM_NULL); + if ( (PRETYPE(S) != PREC_LEFT) && + (PRETYPE(S) != PREC_RIGHT) && + (PRETYPE(S) != PREC_BOTH) ) + PRETYPE(S) = PREC_NONE; + if (SPBCGS_CONTENT(S)->maxl <= 0) + SPBCGS_CONTENT(S)->maxl = SUNSPBCGS_MAXL_DEFAULT; + + /* no additional memory to allocate */ + + /* return with success */ + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetATimes_SPBCGS(SUNLinearSolver S, void* ATData, + ATimesFn ATimes) +{ + /* set function pointers to integrator-supplied ATimes routine + and data, and return with success */ + if (S == NULL) return(SUNLS_MEM_NULL); + SPBCGS_CONTENT(S)->ATimes = ATimes; + SPBCGS_CONTENT(S)->ATData = ATData; + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetPreconditioner_SPBCGS(SUNLinearSolver S, void* PData, + PSetupFn Psetup, PSolveFn Psolve) +{ + /* set function pointers to integrator-supplied Psetup and PSolve + routines and data, and return with success */ + if (S == NULL) return(SUNLS_MEM_NULL); + SPBCGS_CONTENT(S)->Psetup = Psetup; + SPBCGS_CONTENT(S)->Psolve = Psolve; + SPBCGS_CONTENT(S)->PData = PData; + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetScalingVectors_SPBCGS(SUNLinearSolver S, N_Vector s1, + N_Vector s2) +{ + /* set N_Vector pointers to integrator-supplied scaling vectors, + and return with success */ + if (S == NULL) return(SUNLS_MEM_NULL); + SPBCGS_CONTENT(S)->s1 = s1; + SPBCGS_CONTENT(S)->s2 = s2; + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetup_SPBCGS(SUNLinearSolver S, SUNMatrix A) +{ + int ier; + PSetupFn Psetup; + void* PData; + + /* Set shortcuts to SPBCGS memory structures */ + if (S == NULL) return(SUNLS_MEM_NULL); + Psetup = SPBCGS_CONTENT(S)->Psetup; + PData = SPBCGS_CONTENT(S)->PData; + + /* no solver-specific setup is required, but if user-supplied + Psetup routine exists, call that here */ + if (Psetup != NULL) { + ier = Psetup(PData); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSET_FAIL_UNREC : SUNLS_PSET_FAIL_REC; + return(LASTFLAG(S)); + } + } + + /* return with success */ + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSolve_SPBCGS(SUNLinearSolver S, SUNMatrix A, N_Vector x, + N_Vector b, realtype delta) +{ + /* local data and shortcut variables */ + realtype alpha, beta, omega, omega_denom, beta_num, beta_denom, r_norm, rho; + N_Vector r_star, r, p, q, u, Ap, vtemp; + booleantype preOnLeft, preOnRight, scale_x, scale_b, converged; + int l, l_max, ier; + void *A_data, *P_data; + N_Vector sx, sb; + ATimesFn atimes; + PSolveFn psolve; + realtype *res_norm; + int *nli; + + /* local variables for fused vector operations */ + realtype cv[3]; + N_Vector Xv[3]; + + /* Make local shorcuts to solver variables. */ + if (S == NULL) return(SUNLS_MEM_NULL); + l_max = SPBCGS_CONTENT(S)->maxl; + r_star = SPBCGS_CONTENT(S)->r_star; + r = SPBCGS_CONTENT(S)->r; + p = SPBCGS_CONTENT(S)->p; + q = SPBCGS_CONTENT(S)->q; + u = SPBCGS_CONTENT(S)->u; + Ap = SPBCGS_CONTENT(S)->Ap; + vtemp = SPBCGS_CONTENT(S)->vtemp; + sb = SPBCGS_CONTENT(S)->s1; + sx = SPBCGS_CONTENT(S)->s2; + A_data = SPBCGS_CONTENT(S)->ATData; + P_data = SPBCGS_CONTENT(S)->PData; + atimes = SPBCGS_CONTENT(S)->ATimes; + psolve = SPBCGS_CONTENT(S)->Psolve; + nli = &(SPBCGS_CONTENT(S)->numiters); + res_norm = &(SPBCGS_CONTENT(S)->resnorm); + + /* Initialize counters and convergence flag */ + *nli = 0; + converged = SUNFALSE; + + /* set booleantype flags for internal solver options */ + preOnLeft = ( (PRETYPE(S) == PREC_LEFT) || + (PRETYPE(S) == PREC_BOTH) ); + preOnRight = ( (PRETYPE(S) == PREC_RIGHT) || + (PRETYPE(S) == PREC_BOTH) ); + scale_x = (sx != NULL); + scale_b = (sb != NULL); + + /* Set r_star to initial (unscaled) residual r_0 = b - A*x_0 */ + + if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r_star); + else { + ier = atimes(A_data, x, r_star); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; + return(LASTFLAG(S)); + } + N_VLinearSum(ONE, b, -ONE, r_star, r_star); + } + + /* Apply left preconditioner and b-scaling to r_star = r_0 */ + + if (preOnLeft) { + ier = psolve(P_data, r_star, r, delta, PREC_LEFT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } + else N_VScale(ONE, r_star, r); + + if (scale_b) N_VProd(sb, r, r_star); + else N_VScale(ONE, r, r_star); + + /* Initialize beta_denom to the dot product of r0 with r0 */ + + beta_denom = N_VDotProd(r_star, r_star); + + /* Set r_norm to L2 norm of r_star = sb P1_inv r_0, and + return if small */ + + *res_norm = r_norm = rho = SUNRsqrt(beta_denom); + if (r_norm <= delta) { + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); + } + + /* Copy r_star to r and p */ + + N_VScale(ONE, r_star, r); + N_VScale(ONE, r_star, p); + + /* Begin main iteration loop */ + + for(l = 0; l < l_max; l++) { + + (*nli)++; + + /* Generate Ap = A-tilde p, where A-tilde = sb P1_inv A P2_inv sx_inv */ + + /* Apply x-scaling: vtemp = sx_inv p */ + + if (scale_x) N_VDiv(p, sx, vtemp); + else N_VScale(ONE, p, vtemp); + + /* Apply right preconditioner: vtemp = P2_inv sx_inv p */ + + if (preOnRight) { + N_VScale(ONE, vtemp, Ap); + ier = psolve(P_data, Ap, vtemp, delta, PREC_RIGHT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } + + /* Apply A: Ap = A P2_inv sx_inv p */ + + ier = atimes(A_data, vtemp, Ap ); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; + return(LASTFLAG(S)); + } + + /* Apply left preconditioner: vtemp = P1_inv A P2_inv sx_inv p */ + + if (preOnLeft) { + ier = psolve(P_data, Ap, vtemp, delta, PREC_LEFT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } + else N_VScale(ONE, Ap, vtemp); + + /* Apply b-scaling: Ap = sb P1_inv A P2_inv sx_inv p */ + + if (scale_b) N_VProd(sb, vtemp, Ap); + else N_VScale(ONE, vtemp, Ap); + + + /* Calculate alpha = / */ + + alpha = ((beta_denom / N_VDotProd(Ap, r_star))); + + /* Update q = r - alpha*Ap = r - alpha*(sb P1_inv A P2_inv sx_inv p) */ + + N_VLinearSum(ONE, r, -alpha, Ap, q); + + /* Generate u = A-tilde q */ + + /* Apply x-scaling: vtemp = sx_inv q */ + + if (scale_x) N_VDiv(q, sx, vtemp); + else N_VScale(ONE, q, vtemp); + + /* Apply right preconditioner: vtemp = P2_inv sx_inv q */ + + if (preOnRight) { + N_VScale(ONE, vtemp, u); + ier = psolve(P_data, u, vtemp, delta, PREC_RIGHT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } + + /* Apply A: u = A P2_inv sx_inv u */ + + ier = atimes(A_data, vtemp, u ); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; + return(LASTFLAG(S)); + } + + /* Apply left preconditioner: vtemp = P1_inv A P2_inv sx_inv p */ + + if (preOnLeft) { + ier = psolve(P_data, u, vtemp, delta, PREC_LEFT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } + else N_VScale(ONE, u, vtemp); + + /* Apply b-scaling: u = sb P1_inv A P2_inv sx_inv u */ + + if (scale_b) N_VProd(sb, vtemp, u); + else N_VScale(ONE, vtemp, u); + + + /* Calculate omega = / */ + + omega_denom = N_VDotProd(u, u); + if (omega_denom == ZERO) omega_denom = ONE; + omega = (N_VDotProd(u, q) / omega_denom); + + /* Update x = x + alpha*p + omega*q */ + cv[0] = ONE; + Xv[0] = x; + + cv[1] = alpha; + Xv[1] = p; + + cv[2] = omega; + Xv[2] = q; + + ier = N_VLinearCombination(3, cv, Xv, x); + if (ier != SUNLS_SUCCESS) return(SUNLS_VECTOROP_ERR); + + /* Update the residual r = q - omega*u */ + + N_VLinearSum(ONE, q, -omega, u, r); + + /* Set rho = norm(r) and check convergence */ + + *res_norm = rho = SUNRsqrt(N_VDotProd(r, r)); + if (rho <= delta) { + converged = SUNTRUE; + break; + } + + /* Not yet converged, continue iteration */ + /* Update beta = / * alpha / omega */ + + beta_num = N_VDotProd(r, r_star); + beta = ((beta_num / beta_denom) * (alpha / omega)); + + /* Update p = r + beta*(p - omega*Ap) = beta*p - beta*omega*Ap + r */ + cv[0] = beta; + Xv[0] = p; + + cv[1] = -alpha*(beta_num / beta_denom); + Xv[1] = Ap; + + cv[2] = ONE; + Xv[2] = r; + + ier = N_VLinearCombination(3, cv, Xv, p); + if (ier != SUNLS_SUCCESS) return(SUNLS_VECTOROP_ERR); + + /* udpate beta_denom for next iteration */ + beta_denom = beta_num; + } + + /* Main loop finished */ + + if ((converged == SUNTRUE) || (rho < r_norm)) { + + /* Apply the x-scaling and right preconditioner: x = P2_inv sx_inv x */ + + if (scale_x) N_VDiv(x, sx, x); + if (preOnRight) { + ier = psolve(P_data, x, vtemp, delta, PREC_RIGHT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + N_VScale(ONE, vtemp, x); + } + + if (converged == SUNTRUE) + LASTFLAG(S) = SUNLS_SUCCESS; + else + LASTFLAG(S) = SUNLS_RES_REDUCED; + return(LASTFLAG(S)); + + } + else { + LASTFLAG(S) = SUNLS_CONV_FAIL; + return(LASTFLAG(S)); + } +} + + +int SUNLinSolNumIters_SPBCGS(SUNLinearSolver S) +{ + /* return the stored 'numiters' value */ + if (S == NULL) return(-1); + return (SPBCGS_CONTENT(S)->numiters); +} + + +realtype SUNLinSolResNorm_SPBCGS(SUNLinearSolver S) +{ + /* return the stored 'resnorm' value */ + if (S == NULL) return(-ONE); + return (SPBCGS_CONTENT(S)->resnorm); +} + + +N_Vector SUNLinSolResid_SPBCGS(SUNLinearSolver S) +{ + /* return the stored 'r' vector */ + return (SPBCGS_CONTENT(S)->r); +} + + +sunindextype SUNLinSolLastFlag_SPBCGS(SUNLinearSolver S) +{ + /* return the stored 'last_flag' value */ + if (S == NULL) return(-1); + return (LASTFLAG(S)); +} + + +int SUNLinSolSpace_SPBCGS(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS) +{ + sunindextype liw1, lrw1; + if (SPBCGS_CONTENT(S)->vtemp->ops->nvspace) + N_VSpace(SPBCGS_CONTENT(S)->vtemp, &lrw1, &liw1); + else + lrw1 = liw1 = 0; + *lenrwLS = lrw1*9; + *leniwLS = liw1*9; + return(SUNLS_SUCCESS); +} + + +int SUNLinSolFree_SPBCGS(SUNLinearSolver S) +{ + if (S == NULL) return(SUNLS_SUCCESS); + + if (S->content) { + /* delete items from within the content structure */ + if (SPBCGS_CONTENT(S)->r_star) { + N_VDestroy(SPBCGS_CONTENT(S)->r_star); + SPBCGS_CONTENT(S)->r_star = NULL; + } + if (SPBCGS_CONTENT(S)->r) { + N_VDestroy(SPBCGS_CONTENT(S)->r); + SPBCGS_CONTENT(S)->r = NULL; + } + if (SPBCGS_CONTENT(S)->p) { + N_VDestroy(SPBCGS_CONTENT(S)->p); + SPBCGS_CONTENT(S)->p = NULL; + } + if (SPBCGS_CONTENT(S)->q) { + N_VDestroy(SPBCGS_CONTENT(S)->q); + SPBCGS_CONTENT(S)->q = NULL; + } + if (SPBCGS_CONTENT(S)->u) { + N_VDestroy(SPBCGS_CONTENT(S)->u); + SPBCGS_CONTENT(S)->u = NULL; + } + if (SPBCGS_CONTENT(S)->Ap) { + N_VDestroy(SPBCGS_CONTENT(S)->Ap); + SPBCGS_CONTENT(S)->Ap = NULL; + } + if (SPBCGS_CONTENT(S)->vtemp) { + N_VDestroy(SPBCGS_CONTENT(S)->vtemp); + SPBCGS_CONTENT(S)->vtemp = NULL; + } + free(S->content); S->content = NULL; + } + if (S->ops) { free(S->ops); S->ops = NULL; } + free(S); S = NULL; + return(SUNLS_SUCCESS); +} diff --git a/bazaar/plugin/sundials/src/sunlinsol/spfgmr/fmod/fsunlinsol_spfgmr_mod.c b/bazaar/plugin/sundials/src/sunlinsol/spfgmr/fmod/fsunlinsol_spfgmr_mod.c new file mode 100644 index 000000000..66276be71 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/spfgmr/fmod/fsunlinsol_spfgmr_mod.c @@ -0,0 +1,523 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ + +/* --------------------------------------------------------------- + * Programmer(s): Auto-generated by swig. + * --------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * -------------------------------------------------------------*/ + +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_linearsolver.h" + + +#include "sunlinsol/sunlinsol_spfgmr.h" + +SWIGEXPORT SUNLinearSolver _wrap_FSUNLinSol_SPFGMR(N_Vector farg1, int const *farg2, int const *farg3) { + SUNLinearSolver fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int arg3 ; + SUNLinearSolver result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + arg3 = (int)(*farg3); + result = (SUNLinearSolver)SUNLinSol_SPFGMR(arg1,arg2,arg3); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSol_SPFGMRSetPrecType(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNLinSol_SPFGMRSetPrecType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSol_SPFGMRSetGSType(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNLinSol_SPFGMRSetGSType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSol_SPFGMRSetMaxRestarts(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNLinSol_SPFGMRSetMaxRestarts(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SUNLinearSolver _wrap_FSUNSPFGMR(N_Vector farg1, int const *farg2, int const *farg3) { + SUNLinearSolver fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int arg3 ; + SUNLinearSolver result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + arg3 = (int)(*farg3); + result = (SUNLinearSolver)SUNSPFGMR(arg1,arg2,arg3); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNSPFGMRSetPrecType(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNSPFGMRSetPrecType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNSPFGMRSetGSType(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNSPFGMRSetGSType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNSPFGMRSetMaxRestarts(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNSPFGMRSetMaxRestarts(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolGetType_SPFGMR(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNLinearSolver_Type result; + + arg1 = (SUNLinearSolver)(farg1); + result = (SUNLinearSolver_Type)SUNLinSolGetType_SPFGMR(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolGetID_SPFGMR(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNLinearSolver_ID result; + + arg1 = (SUNLinearSolver)(farg1); + result = (SUNLinearSolver_ID)SUNLinSolGetID_SPFGMR(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolInitialize_SPFGMR(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolInitialize_SPFGMR(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetATimes_SPFGMR(SUNLinearSolver farg1, void *farg2, ATimesFn farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + void *arg2 = (void *) 0 ; + ATimesFn arg3 = (ATimesFn) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (void *)(farg2); + arg3 = (ATimesFn)(farg3); + result = (int)SUNLinSolSetATimes_SPFGMR(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetPreconditioner_SPFGMR(SUNLinearSolver farg1, void *farg2, PSetupFn farg3, PSolveFn farg4) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + void *arg2 = (void *) 0 ; + PSetupFn arg3 = (PSetupFn) 0 ; + PSolveFn arg4 = (PSolveFn) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (void *)(farg2); + arg3 = (PSetupFn)(farg3); + arg4 = (PSolveFn)(farg4); + result = (int)SUNLinSolSetPreconditioner_SPFGMR(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetScalingVectors_SPFGMR(SUNLinearSolver farg1, N_Vector farg2, N_Vector farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)SUNLinSolSetScalingVectors_SPFGMR(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetup_SPFGMR(SUNLinearSolver farg1, SUNMatrix farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNLinSolSetup_SPFGMR(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSolve_SPFGMR(SUNLinearSolver farg1, SUNMatrix farg2, N_Vector farg3, N_Vector farg4, double const *farg5) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + realtype arg5 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (SUNMatrix)(farg2); + arg3 = (N_Vector)(farg3); + arg4 = (N_Vector)(farg4); + arg5 = (realtype)(*farg5); + result = (int)SUNLinSolSolve_SPFGMR(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolNumIters_SPFGMR(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolNumIters_SPFGMR(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FSUNLinSolResNorm_SPFGMR(SUNLinearSolver farg1) { + double fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + realtype result; + + arg1 = (SUNLinearSolver)(farg1); + result = (realtype)SUNLinSolResNorm_SPFGMR(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT N_Vector _wrap_FSUNLinSolResid_SPFGMR(SUNLinearSolver farg1) { + N_Vector fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + N_Vector result; + + arg1 = (SUNLinearSolver)(farg1); + result = (N_Vector)SUNLinSolResid_SPFGMR(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNLinSolLastFlag_SPFGMR(SUNLinearSolver farg1) { + int64_t fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + sunindextype result; + + arg1 = (SUNLinearSolver)(farg1); + result = SUNLinSolLastFlag_SPFGMR(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSpace_SPFGMR(SUNLinearSolver farg1, long *farg2, long *farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)SUNLinSolSpace_SPFGMR(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolFree_SPFGMR(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolFree_SPFGMR(arg1); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/sunlinsol/spfgmr/fsunlinsol_spfgmr.c b/bazaar/plugin/sundials/src/sunlinsol/spfgmr/fsunlinsol_spfgmr.c new file mode 100644 index 000000000..402e4c6bb --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/spfgmr/fsunlinsol_spfgmr.c @@ -0,0 +1,241 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunlinsol_spfgmr.h) contains the + * implementation needed for the Fortran initialization of SPFGMR + * linear solver operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fsunlinsol_spfgmr.h" + +/* Define global linsol variables */ + +SUNLinearSolver F2C_CVODE_linsol; +SUNLinearSolver F2C_IDA_linsol; +SUNLinearSolver F2C_KINSOL_linsol; +SUNLinearSolver F2C_ARKODE_linsol; +SUNLinearSolver F2C_ARKODE_mass_sol; + +/* Declarations of external global variables */ + +extern SUNMatrix F2C_CVODE_matrix; +extern SUNMatrix F2C_IDA_matrix; +extern SUNMatrix F2C_KINSOL_matrix; +extern SUNMatrix F2C_ARKODE_matrix; +extern SUNMatrix F2C_ARKODE_mass_matrix; + +extern N_Vector F2C_CVODE_vec; +extern N_Vector F2C_IDA_vec; +extern N_Vector F2C_KINSOL_vec; +extern N_Vector F2C_ARKODE_vec; + +/* Fortran callable interfaces */ + +void FSUNSPFGMR_INIT(int *code, int *pretype, int *maxl, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); + F2C_CVODE_linsol = NULL; + F2C_CVODE_linsol = SUNLinSol_SPFGMR(F2C_CVODE_vec, *pretype, *maxl); + if (F2C_CVODE_linsol == NULL) *ier = -1; + break; + case FCMIX_IDA: + if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); + F2C_IDA_linsol = NULL; + F2C_IDA_linsol = SUNLinSol_SPFGMR(F2C_IDA_vec, *pretype, *maxl); + if (F2C_IDA_linsol == NULL) *ier = -1; + break; + case FCMIX_KINSOL: + if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); + F2C_KINSOL_linsol = NULL; + F2C_KINSOL_linsol = SUNLinSol_SPFGMR(F2C_KINSOL_vec, *pretype, *maxl); + if (F2C_KINSOL_linsol == NULL) *ier = -1; + break; + case FCMIX_ARKODE: + if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); + F2C_ARKODE_linsol = NULL; + F2C_ARKODE_linsol = SUNLinSol_SPFGMR(F2C_ARKODE_vec, *pretype, *maxl); + if (F2C_ARKODE_linsol == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + + +void FSUNSPFGMR_SETGSTYPE(int *code, int *gstype, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (!F2C_CVODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPFGMRSetGSType(F2C_CVODE_linsol, *gstype); + break; + case FCMIX_IDA: + if (!F2C_IDA_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPFGMRSetGSType(F2C_IDA_linsol, *gstype); + break; + case FCMIX_KINSOL: + if (!F2C_KINSOL_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPFGMRSetGSType(F2C_KINSOL_linsol, *gstype); + break; + case FCMIX_ARKODE: + if (!F2C_ARKODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPFGMRSetGSType(F2C_ARKODE_linsol, *gstype); + break; + default: + *ier = -1; + } +} + + +void FSUNSPFGMR_SETPRECTYPE(int *code, int *pretype, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (!F2C_CVODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPFGMRSetPrecType(F2C_CVODE_linsol, *pretype); + break; + case FCMIX_IDA: + if (!F2C_IDA_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPFGMRSetPrecType(F2C_IDA_linsol, *pretype); + break; + case FCMIX_KINSOL: + if (!F2C_KINSOL_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPFGMRSetPrecType(F2C_KINSOL_linsol, *pretype); + break; + case FCMIX_ARKODE: + if (!F2C_ARKODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPFGMRSetPrecType(F2C_ARKODE_linsol, *pretype); + break; + default: + *ier = -1; + } +} + + +void FSUNSPFGMR_SETMAXRS(int *code, int *maxrs, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (!F2C_CVODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPFGMRSetMaxRestarts(F2C_CVODE_linsol, *maxrs); + break; + case FCMIX_IDA: + if (!F2C_IDA_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPFGMRSetMaxRestarts(F2C_IDA_linsol, *maxrs); + break; + case FCMIX_KINSOL: + if (!F2C_KINSOL_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPFGMRSetMaxRestarts(F2C_KINSOL_linsol, *maxrs); + break; + case FCMIX_ARKODE: + if (!F2C_ARKODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPFGMRSetMaxRestarts(F2C_ARKODE_linsol, *maxrs); + break; + default: + *ier = -1; + } +} + + +void FSUNMASSSPFGMR_INIT(int *pretype, int *maxl, int *ier) +{ + *ier = 0; + if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); + F2C_ARKODE_mass_sol = NULL; + F2C_ARKODE_mass_sol = SUNLinSol_SPFGMR(F2C_ARKODE_vec, *pretype, *maxl); + if (F2C_ARKODE_mass_sol == NULL) *ier = -1; +} + + +void FSUNMASSSPFGMR_SETGSTYPE(int *gstype, int *ier) +{ + *ier = 0; + if (!F2C_ARKODE_mass_sol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPFGMRSetGSType(F2C_ARKODE_mass_sol, *gstype); +} + + +void FSUNMASSSPFGMR_SETPRECTYPE(int *pretype, int *ier) +{ + *ier = 0; + if (!F2C_ARKODE_mass_sol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPFGMRSetPrecType(F2C_ARKODE_mass_sol, *pretype); +} + + +void FSUNMASSSPFGMR_SETMAXRS(int *maxrs, int *ier) +{ + *ier = 0; + if (!F2C_ARKODE_mass_sol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPFGMRSetMaxRestarts(F2C_ARKODE_mass_sol, *maxrs); +} diff --git a/bazaar/plugin/sundials/src/sunlinsol/spfgmr/fsunlinsol_spfgmr.h b/bazaar/plugin/sundials/src/sunlinsol/spfgmr/fsunlinsol_spfgmr.h new file mode 100644 index 000000000..ef08c8acf --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/spfgmr/fsunlinsol_spfgmr.h @@ -0,0 +1,88 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunlinsol_spfgmr.c) contains the + * definitions needed for the initialization of SPFGMR + * linear solver operations in Fortran. + * ----------------------------------------------------------------- + */ + +#ifndef _FSUNLINSOL_SPFGMR_H +#define _FSUNLINSOL_SPFGMR_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#if defined(SUNDIALS_F77_FUNC) +#define FSUNSPFGMR_INIT SUNDIALS_F77_FUNC(fsunspfgmrinit, FSUNSPFGMRINIT) +#define FSUNSPFGMR_SETGSTYPE SUNDIALS_F77_FUNC(fsunspfgmrsetgstype, FSUNSPFGMRSETGSTYPE) +#define FSUNSPFGMR_SETPRECTYPE SUNDIALS_F77_FUNC(fsunspfgmrsetprectype, FSUNSPFGMRSETPRECTYPE) +#define FSUNSPFGMR_SETMAXRS SUNDIALS_F77_FUNC(fsunspfgmrsetmaxrs, FSUNSPFGMRSETMAXRS) +#define FSUNMASSSPFGMR_INIT SUNDIALS_F77_FUNC(fsunmassspfgmrinit, FSUNMASSSPFGMRINIT) +#define FSUNMASSSPFGMR_SETGSTYPE SUNDIALS_F77_FUNC(fsunmassspfgmrsetgstype, FSUNMASSSPFGMRSETGSTYPE) +#define FSUNMASSSPFGMR_SETPRECTYPE SUNDIALS_F77_FUNC(fsunmassspfgmrsetprectype, FSUNMASSSPFGMRSETPRECTYPE) +#define FSUNMASSSPFGMR_SETMAXRS SUNDIALS_F77_FUNC(fsunmassspfgmrsetmaxrs, FSUNMASSSPFGMRSETMAXRS) +#else +#define FSUNSPFGMR_INIT fsunspfgmrinit_ +#define FSUNSPFGMR_SETGSTYPE fsunspfgmrsetgstype_ +#define FSUNSPFGMR_SETPRECTYPE fsunspfgmrsetprectype_ +#define FSUNSPFGMR_SETMAXRS fsunspfgmrsetmaxrs_ +#define FSUNMASSSPFGMR_INIT fsunmassspfgmrinit_ +#define FSUNMASSSPFGMR_SETGSTYPE fsunmassspfgmrsetgstype_ +#define FSUNMASSSPFGMR_SETPRECTYPE fsunmassspfgmrsetprectype_ +#define FSUNMASSSPFGMR_SETMAXRS fsunmassspfgmrsetmaxrs_ +#endif + + +/* Declarations of global variables */ + +extern SUNLinearSolver F2C_CVODE_linsol; +extern SUNLinearSolver F2C_IDA_linsol; +extern SUNLinearSolver F2C_KINSOL_linsol; +extern SUNLinearSolver F2C_ARKODE_linsol; +extern SUNLinearSolver F2C_ARKODE_mass_sol; + +/* + * Prototypes of exported functions + * + * FSUNSPFGMR_INIT - initializes SPFGMR linear solver for main problem + * FSUNSPFGMR_SETGSTYPE - sets the Gram-Scmidt orthogonalization type for main problem + * FSUNSPFGMR_SETPRECTYPE - sets the preconditioning type for main problem + * FSUNSPFGMR_SETMAXRS - sets the maximum number of restarts to allow for main problem + * + * FSUNMASSSPFGMR_INIT - initializes SPFGMR linear solver for mass matrix solve + * FSUNMASSSPFGMR_SETGSTYPE - sets the Gram-Scmidt orthogonalization type for mass matrix solve + * FSUNMASSSPFGMR_SETPRECTYPE - sets the preconditioning type for mass matrix solve + * FSUNMASSSPFGMR_SETMAXRS - sets the maximum number of restarts to allow for mass matrix solve + */ + +void FSUNSPFGMR_INIT(int *code, int *pretype, int *maxl, int *ier); +void FSUNSPFGMR_SETGSTYPE(int *code, int *gstype, int *ier); +void FSUNSPFGMR_SETPRECTYPE(int *code, int *pretype, int *ier); +void FSUNSPFGMR_SETMAXRS(int *code, int *maxrs, int *ier); + +void FSUNMASSSPFGMR_INIT(int *pretype, int *maxl, int *ier); +void FSUNMASSSPFGMR_SETGSTYPE(int *gstype, int *ier); +void FSUNMASSSPFGMR_SETPRECTYPE(int *pretype, int *ier); +void FSUNMASSSPFGMR_SETMAXRS(int *maxrs, int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/sunlinsol/spfgmr/sunlinsol_spfgmr.c b/bazaar/plugin/sundials/src/sunlinsol/spfgmr/sunlinsol_spfgmr.c new file mode 100644 index 000000000..cbf1b81b7 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/spfgmr/sunlinsol_spfgmr.c @@ -0,0 +1,741 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * Based on sundials_spfgmr.c code, written by Daniel R. Reynolds + * and Hilari C. Tiedeman @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for the SPFGMR implementation of + * the SUNLINSOL package. + * -----------------------------------------------------------------*/ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* + * ----------------------------------------------------------------- + * SPFGMR solver structure accessibility macros: + * ----------------------------------------------------------------- + */ + +#define SPFGMR_CONTENT(S) ( (SUNLinearSolverContent_SPFGMR)(S->content) ) +#define LASTFLAG(S) ( SPFGMR_CONTENT(S)->last_flag ) + +/* + * ----------------------------------------------------------------- + * deprecated wrapper functions + * ----------------------------------------------------------------- + */ + +SUNLinearSolver SUNSPFGMR(N_Vector y, int pretype, int maxl) +{ return(SUNLinSol_SPFGMR(y, pretype, maxl)); } + +int SUNSPFGMRSetPrecType(SUNLinearSolver S, int pretype) +{ return(SUNLinSol_SPFGMRSetPrecType(S, pretype)); } + +int SUNSPFGMRSetGSType(SUNLinearSolver S, int gstype) +{ return(SUNLinSol_SPFGMRSetGSType(S, gstype)); } + +int SUNSPFGMRSetMaxRestarts(SUNLinearSolver S, int maxrs) +{ return(SUNLinSol_SPFGMRSetMaxRestarts(S, maxrs)); } + +/* + * ----------------------------------------------------------------- + * exported functions + * ----------------------------------------------------------------- + */ + +/* ---------------------------------------------------------------------------- + * Function to create a new SPFGMR linear solver + */ + +SUNLinearSolver SUNLinSol_SPFGMR(N_Vector y, int pretype, int maxl) +{ + SUNLinearSolver S; + SUNLinearSolverContent_SPFGMR content; + + /* set preconditioning flag (enabling any preconditioner implies right + preconditioning, since SPFGMR does not support left preconditioning) */ + pretype = ( (pretype == PREC_LEFT) || + (pretype == PREC_RIGHT) || + (pretype == PREC_BOTH) ) ? PREC_RIGHT : PREC_NONE; + + /* if maxl input is illegal, set to default */ + if (maxl <= 0) maxl = SUNSPFGMR_MAXL_DEFAULT; + + /* check that the supplied N_Vector supports all requisite operations */ + if ( (y->ops->nvclone == NULL) || (y->ops->nvdestroy == NULL) || + (y->ops->nvlinearsum == NULL) || (y->ops->nvconst == NULL) || + (y->ops->nvprod == NULL) || (y->ops->nvdiv == NULL) || + (y->ops->nvscale == NULL) || (y->ops->nvdotprod == NULL) ) + return(NULL); + + /* Create linear solver */ + S = NULL; + S = SUNLinSolNewEmpty(); + if (S == NULL) return(NULL); + + /* Attach operations */ + S->ops->gettype = SUNLinSolGetType_SPFGMR; + S->ops->getid = SUNLinSolGetID_SPFGMR; + S->ops->setatimes = SUNLinSolSetATimes_SPFGMR; + S->ops->setpreconditioner = SUNLinSolSetPreconditioner_SPFGMR; + S->ops->setscalingvectors = SUNLinSolSetScalingVectors_SPFGMR; + S->ops->initialize = SUNLinSolInitialize_SPFGMR; + S->ops->setup = SUNLinSolSetup_SPFGMR; + S->ops->solve = SUNLinSolSolve_SPFGMR; + S->ops->numiters = SUNLinSolNumIters_SPFGMR; + S->ops->resnorm = SUNLinSolResNorm_SPFGMR; + S->ops->resid = SUNLinSolResid_SPFGMR; + S->ops->lastflag = SUNLinSolLastFlag_SPFGMR; + S->ops->space = SUNLinSolSpace_SPFGMR; + S->ops->free = SUNLinSolFree_SPFGMR; + + /* Create content */ + content = NULL; + content = (SUNLinearSolverContent_SPFGMR) malloc(sizeof *content); + if (content == NULL) { SUNLinSolFree(S); return(NULL); } + + /* Attach content */ + S->content = content; + + /* Fill content */ + content->last_flag = 0; + content->maxl = maxl; + content->pretype = pretype; + content->gstype = SUNSPFGMR_GSTYPE_DEFAULT; + content->max_restarts = SUNSPFGMR_MAXRS_DEFAULT; + content->numiters = 0; + content->resnorm = ZERO; + content->xcor = NULL; + content->vtemp = NULL; + content->s1 = NULL; + content->s2 = NULL; + content->ATimes = NULL; + content->ATData = NULL; + content->Psetup = NULL; + content->Psolve = NULL; + content->PData = NULL; + content->V = NULL; + content->Z = NULL; + content->Hes = NULL; + content->givens = NULL; + content->yg = NULL; + content->cv = NULL; + content->Xv = NULL; + + /* Allocate content */ + content->xcor = N_VClone(y); + if (content->xcor == NULL) { SUNLinSolFree(S); return(NULL); } + + content->vtemp = N_VClone(y); + if (content->vtemp == NULL) { SUNLinSolFree(S); return(NULL); } + + return(S); +} + + +/* ---------------------------------------------------------------------------- + * Function to toggle preconditioning on/off -- turns on if pretype is any + * one of PREC_LEFT, PREC_RIGHT or PREC_BOTH; otherwise turns off + */ + +SUNDIALS_EXPORT int SUNLinSol_SPFGMRSetPrecType(SUNLinearSolver S, int pretype) +{ + /* Check for legal pretype */ + pretype = ( (pretype == PREC_LEFT) || + (pretype == PREC_RIGHT) || + (pretype == PREC_BOTH) ) ? PREC_RIGHT : PREC_NONE; + + /* Check for non-NULL SUNLinearSolver */ + if (S == NULL) return(SUNLS_MEM_NULL); + + /* Set pretype */ + SPFGMR_CONTENT(S)->pretype = pretype; + return(SUNLS_SUCCESS); +} + + +/* ---------------------------------------------------------------------------- + * Function to set the type of Gram-Schmidt orthogonalization for SPFGMR to use + */ + +SUNDIALS_EXPORT int SUNLinSol_SPFGMRSetGSType(SUNLinearSolver S, int gstype) +{ + /* Check for legal gstype */ + if ((gstype != MODIFIED_GS) && (gstype != CLASSICAL_GS)) { + return(SUNLS_ILL_INPUT); + } + + /* Check for non-NULL SUNLinearSolver */ + if (S == NULL) return(SUNLS_MEM_NULL); + + /* Set pretype */ + SPFGMR_CONTENT(S)->gstype = gstype; + return(SUNLS_SUCCESS); +} + + +/* ---------------------------------------------------------------------------- + * Function to set the maximum number of FGMRES restarts to allow + */ + +SUNDIALS_EXPORT int SUNLinSol_SPFGMRSetMaxRestarts(SUNLinearSolver S, int maxrs) +{ + /* Illegal maxrs implies use of default value */ + if (maxrs < 0) + maxrs = SUNSPFGMR_MAXRS_DEFAULT; + + /* Check for non-NULL SUNLinearSolver */ + if (S == NULL) return(SUNLS_MEM_NULL); + + /* Set max_restarts */ + SPFGMR_CONTENT(S)->max_restarts = maxrs; + return(SUNLS_SUCCESS); +} + + +/* + * ----------------------------------------------------------------- + * implementation of linear solver operations + * ----------------------------------------------------------------- + */ + +SUNLinearSolver_Type SUNLinSolGetType_SPFGMR(SUNLinearSolver S) +{ + return(SUNLINEARSOLVER_ITERATIVE); +} + + +SUNLinearSolver_ID SUNLinSolGetID_SPFGMR(SUNLinearSolver S) +{ + return(SUNLINEARSOLVER_SPFGMR); +} + + +int SUNLinSolInitialize_SPFGMR(SUNLinearSolver S) +{ + int k; + SUNLinearSolverContent_SPFGMR content; + + /* set shortcut to SPFGMR memory structure */ + if (S == NULL) return(SUNLS_MEM_NULL); + content = SPFGMR_CONTENT(S); + + /* ensure valid options */ + if (content->max_restarts < 0) + content->max_restarts = SUNSPFGMR_MAXRS_DEFAULT; + if ( (content->pretype != PREC_LEFT) && + (content->pretype != PREC_RIGHT) && + (content->pretype != PREC_BOTH) ) + content->pretype = PREC_NONE; + + + /* allocate solver-specific memory (where the size depends on the + choice of maxl) here */ + + /* Krylov subspace vectors */ + if (content->V == NULL) { + content->V = N_VCloneVectorArray(content->maxl+1, content->vtemp); + if (content->V == NULL) { + SUNLinSolFree(S); + content->last_flag = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + } + + /* Preconditioned basis vectors */ + if (content->Z == NULL) { + content->Z = N_VCloneVectorArray(content->maxl+1, content->vtemp); + if (content->Z == NULL) { + SUNLinSolFree(S); + content->last_flag = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + } + + /* Hessenberg matrix Hes */ + if (content->Hes == NULL) { + content->Hes = (realtype **) malloc((content->maxl+1)*sizeof(realtype *)); + if (content->Hes == NULL) { + SUNLinSolFree(S); + content->last_flag = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + + for (k=0; k<=content->maxl; k++) { + content->Hes[k] = NULL; + content->Hes[k] = (realtype *) malloc(content->maxl*sizeof(realtype)); + if (content->Hes[k] == NULL) { + SUNLinSolFree(S); + content->last_flag = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + } + } + + /* Givens rotation components */ + if (content->givens == NULL) { + content->givens = (realtype *) malloc(2*content->maxl*sizeof(realtype)); + if (content->givens == NULL) { + SUNLinSolFree(S); + content->last_flag = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + } + + /* y and g vectors */ + if (content->yg == NULL) { + content->yg = (realtype *) malloc((content->maxl+1)*sizeof(realtype)); + if (content->yg == NULL) { + SUNLinSolFree(S); + content->last_flag = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + } + + /* cv vector for fused vector ops */ + if (content->cv == NULL) { + content->cv = (realtype *) malloc((content->maxl+1)*sizeof(realtype)); + if (content->cv == NULL) { + SUNLinSolFree(S); + content->last_flag = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + } + + /* Xv vector for fused vector ops */ + if (content->Xv == NULL) { + content->Xv = (N_Vector *) malloc((content->maxl+1)*sizeof(N_Vector)); + if (content->Xv == NULL) { + SUNLinSolFree(S); + content->last_flag = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + } + + /* return with success */ + content->last_flag = SUNLS_SUCCESS; + return(SUNLS_SUCCESS); +} + + +int SUNLinSolSetATimes_SPFGMR(SUNLinearSolver S, void* ATData, + ATimesFn ATimes) +{ + /* set function pointers to integrator-supplied ATimes routine + and data, and return with success */ + if (S == NULL) return(SUNLS_MEM_NULL); + SPFGMR_CONTENT(S)->ATimes = ATimes; + SPFGMR_CONTENT(S)->ATData = ATData; + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetPreconditioner_SPFGMR(SUNLinearSolver S, void* PData, + PSetupFn Psetup, PSolveFn Psolve) +{ + /* set function pointers to integrator-supplied Psetup and PSolve + routines and data, and return with success */ + if (S == NULL) return(SUNLS_MEM_NULL); + SPFGMR_CONTENT(S)->Psetup = Psetup; + SPFGMR_CONTENT(S)->Psolve = Psolve; + SPFGMR_CONTENT(S)->PData = PData; + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetScalingVectors_SPFGMR(SUNLinearSolver S, N_Vector s1, + N_Vector s2) +{ + /* set N_Vector pointers to integrator-supplied scaling vectors, + and return with success */ + if (S == NULL) return(SUNLS_MEM_NULL); + SPFGMR_CONTENT(S)->s1 = s1; + SPFGMR_CONTENT(S)->s2 = s2; + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetup_SPFGMR(SUNLinearSolver S, SUNMatrix A) +{ + int ier; + PSetupFn Psetup; + void* PData; + + /* Set shortcuts to SPFGMR memory structures */ + if (S == NULL) return(SUNLS_MEM_NULL); + Psetup = SPFGMR_CONTENT(S)->Psetup; + PData = SPFGMR_CONTENT(S)->PData; + + /* no solver-specific setup is required, but if user-supplied + Psetup routine exists, call that here */ + if (Psetup != NULL) { + ier = Psetup(PData); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSET_FAIL_UNREC : SUNLS_PSET_FAIL_REC; + return(LASTFLAG(S)); + } + } + + /* return with success */ + return(SUNLS_SUCCESS); +} + + +int SUNLinSolSolve_SPFGMR(SUNLinearSolver S, SUNMatrix A, N_Vector x, + N_Vector b, realtype delta) +{ + /* local data and shortcut variables */ + N_Vector *V, *Z, xcor, vtemp, s1, s2; + realtype **Hes, *givens, *yg, *res_norm; + realtype beta, rotation_product, r_norm, s_product, rho; + booleantype preOnRight, scale1, scale2, converged; + int i, j, k, l, l_max, krydim, ier, ntries, max_restarts, gstype; + int *nli; + void *A_data, *P_data; + ATimesFn atimes; + PSolveFn psolve; + + /* local shortcuts for fused vector operations */ + realtype* cv; + N_Vector* Xv; + + /* Initialize some variables */ + krydim = 0; + + /* Make local shorcuts to solver variables. */ + if (S == NULL) return(SUNLS_MEM_NULL); + l_max = SPFGMR_CONTENT(S)->maxl; + max_restarts = SPFGMR_CONTENT(S)->max_restarts; + gstype = SPFGMR_CONTENT(S)->gstype; + V = SPFGMR_CONTENT(S)->V; + Z = SPFGMR_CONTENT(S)->Z; + Hes = SPFGMR_CONTENT(S)->Hes; + givens = SPFGMR_CONTENT(S)->givens; + xcor = SPFGMR_CONTENT(S)->xcor; + yg = SPFGMR_CONTENT(S)->yg; + vtemp = SPFGMR_CONTENT(S)->vtemp; + s1 = SPFGMR_CONTENT(S)->s1; + s2 = SPFGMR_CONTENT(S)->s2; + A_data = SPFGMR_CONTENT(S)->ATData; + P_data = SPFGMR_CONTENT(S)->PData; + atimes = SPFGMR_CONTENT(S)->ATimes; + psolve = SPFGMR_CONTENT(S)->Psolve; + nli = &(SPFGMR_CONTENT(S)->numiters); + res_norm = &(SPFGMR_CONTENT(S)->resnorm); + cv = SPFGMR_CONTENT(S)->cv; + Xv = SPFGMR_CONTENT(S)->Xv; + + /* Initialize counters and convergence flag */ + *nli = 0; + converged = SUNFALSE; + + /* set booleantype flags for internal solver options */ + preOnRight = ( (SPFGMR_CONTENT(S)->pretype == PREC_LEFT) || + (SPFGMR_CONTENT(S)->pretype == PREC_RIGHT) || + (SPFGMR_CONTENT(S)->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 { + ier = atimes(A_data, x, vtemp); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; + return(LASTFLAG(S)); + } + N_VLinearSum(ONE, b, -ONE, vtemp, vtemp); + } + + /* Apply left scaling to vtemp = r_0 to fill V[0]. */ + 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 r_0, and return if small */ + *res_norm = r_norm = beta = SUNRsqrt(N_VDotProd(V[0], V[0])); + if (r_norm <= delta) { + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); + } + + /* Initialize rho to avoid compiler warning message */ + rho = beta; + + /* 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; j0; 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 = SUNRabs(r_norm); + + /* Multiply yg by V_(krydim+1) to get last residual vector; restart. */ + for (k=0; k<=krydim; k++) { + cv[k] = yg[k]; + Xv[k] = V[k]; + } + ier = N_VLinearCombination(krydim+1, cv, Xv, V[0]); + if (ier != SUNLS_SUCCESS) return(SUNLS_VECTOROP_ERR); + + } + + /* 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) { + N_VLinearSum(ONE, x, ONE, xcor, x); { + LASTFLAG(S) = SUNLS_RES_REDUCED; + return(LASTFLAG(S)); + } + } + + LASTFLAG(S) = SUNLS_CONV_FAIL; + return(LASTFLAG(S)); +} + + +int SUNLinSolNumIters_SPFGMR(SUNLinearSolver S) +{ + /* return the stored 'numiters' value */ + if (S == NULL) return(-1); + return (SPFGMR_CONTENT(S)->numiters); +} + + +realtype SUNLinSolResNorm_SPFGMR(SUNLinearSolver S) +{ + /* return the stored 'resnorm' value */ + if (S == NULL) return(-ONE); + return (SPFGMR_CONTENT(S)->resnorm); +} + + +N_Vector SUNLinSolResid_SPFGMR(SUNLinearSolver S) +{ + /* return the stored 'vtemp' vector */ + return (SPFGMR_CONTENT(S)->vtemp); +} + + +sunindextype SUNLinSolLastFlag_SPFGMR(SUNLinearSolver S) +{ + /* return the stored 'last_flag' value */ + if (S == NULL) return(-1); + return (LASTFLAG(S)); +} + + +int SUNLinSolSpace_SPFGMR(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS) +{ + int maxl; + sunindextype liw1, lrw1; + maxl = SPFGMR_CONTENT(S)->maxl; + if (SPFGMR_CONTENT(S)->vtemp->ops->nvspace) + N_VSpace(SPFGMR_CONTENT(S)->vtemp, &lrw1, &liw1); + else + lrw1 = liw1 = 0; + *lenrwLS = lrw1*(2*maxl + 4) + maxl*(maxl + 5) + 2; + *leniwLS = liw1*(2*maxl + 4); + return(SUNLS_SUCCESS); +} + +int SUNLinSolFree_SPFGMR(SUNLinearSolver S) +{ + int k; + + if (S == NULL) return(SUNLS_SUCCESS); + + if (S->content) { + /* delete items from within the content structure */ + if (SPFGMR_CONTENT(S)->xcor) { + N_VDestroy(SPFGMR_CONTENT(S)->xcor); + SPFGMR_CONTENT(S)->xcor = NULL; + } + if (SPFGMR_CONTENT(S)->vtemp) { + N_VDestroy(SPFGMR_CONTENT(S)->vtemp); + SPFGMR_CONTENT(S)->vtemp = NULL; + } + if (SPFGMR_CONTENT(S)->V) { + N_VDestroyVectorArray(SPFGMR_CONTENT(S)->V, + SPFGMR_CONTENT(S)->maxl+1); + SPFGMR_CONTENT(S)->V = NULL; + } + if (SPFGMR_CONTENT(S)->Z) { + N_VDestroyVectorArray(SPFGMR_CONTENT(S)->Z, + SPFGMR_CONTENT(S)->maxl+1); + SPFGMR_CONTENT(S)->Z = NULL; + } + if (SPFGMR_CONTENT(S)->Hes) { + for (k=0; k<=SPFGMR_CONTENT(S)->maxl; k++) + if (SPFGMR_CONTENT(S)->Hes[k]) { + free(SPFGMR_CONTENT(S)->Hes[k]); + SPFGMR_CONTENT(S)->Hes[k] = NULL; + } + free(SPFGMR_CONTENT(S)->Hes); + SPFGMR_CONTENT(S)->Hes = NULL; + } + if (SPFGMR_CONTENT(S)->givens) { + free(SPFGMR_CONTENT(S)->givens); + SPFGMR_CONTENT(S)->givens = NULL; + } + if (SPFGMR_CONTENT(S)->yg) { + free(SPFGMR_CONTENT(S)->yg); + SPFGMR_CONTENT(S)->yg = NULL; + } + if (SPFGMR_CONTENT(S)->cv) { + free(SPFGMR_CONTENT(S)->cv); + SPFGMR_CONTENT(S)->cv = NULL; + } + if (SPFGMR_CONTENT(S)->Xv) { + free(SPFGMR_CONTENT(S)->Xv); + SPFGMR_CONTENT(S)->Xv = NULL; + } + free(S->content); S->content = NULL; + } + if (S->ops) { free(S->ops); S->ops = NULL; } + free(S); S = NULL; + return(SUNLS_SUCCESS); +} diff --git a/bazaar/plugin/sundials/src/sunlinsol/spgmr/fmod/fsunlinsol_spgmr_mod.c b/bazaar/plugin/sundials/src/sunlinsol/spgmr/fmod/fsunlinsol_spgmr_mod.c new file mode 100644 index 000000000..00d334c5a --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/spgmr/fmod/fsunlinsol_spgmr_mod.c @@ -0,0 +1,523 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ + +/* --------------------------------------------------------------- + * Programmer(s): Auto-generated by swig. + * --------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * -------------------------------------------------------------*/ + +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_linearsolver.h" + + +#include "sunlinsol/sunlinsol_spgmr.h" + +SWIGEXPORT SUNLinearSolver _wrap_FSUNLinSol_SPGMR(N_Vector farg1, int const *farg2, int const *farg3) { + SUNLinearSolver fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int arg3 ; + SUNLinearSolver result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + arg3 = (int)(*farg3); + result = (SUNLinearSolver)SUNLinSol_SPGMR(arg1,arg2,arg3); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSol_SPGMRSetPrecType(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNLinSol_SPGMRSetPrecType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSol_SPGMRSetGSType(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNLinSol_SPGMRSetGSType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSol_SPGMRSetMaxRestarts(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNLinSol_SPGMRSetMaxRestarts(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SUNLinearSolver _wrap_FSUNSPGMR(N_Vector farg1, int const *farg2, int const *farg3) { + SUNLinearSolver fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int arg3 ; + SUNLinearSolver result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + arg3 = (int)(*farg3); + result = (SUNLinearSolver)SUNSPGMR(arg1,arg2,arg3); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNSPGMRSetPrecType(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNSPGMRSetPrecType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNSPGMRSetGSType(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNSPGMRSetGSType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNSPGMRSetMaxRestarts(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNSPGMRSetMaxRestarts(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolGetType_SPGMR(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNLinearSolver_Type result; + + arg1 = (SUNLinearSolver)(farg1); + result = (SUNLinearSolver_Type)SUNLinSolGetType_SPGMR(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolGetID_SPGMR(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNLinearSolver_ID result; + + arg1 = (SUNLinearSolver)(farg1); + result = (SUNLinearSolver_ID)SUNLinSolGetID_SPGMR(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolInitialize_SPGMR(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolInitialize_SPGMR(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetATimes_SPGMR(SUNLinearSolver farg1, void *farg2, ATimesFn farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + void *arg2 = (void *) 0 ; + ATimesFn arg3 = (ATimesFn) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (void *)(farg2); + arg3 = (ATimesFn)(farg3); + result = (int)SUNLinSolSetATimes_SPGMR(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetPreconditioner_SPGMR(SUNLinearSolver farg1, void *farg2, PSetupFn farg3, PSolveFn farg4) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + void *arg2 = (void *) 0 ; + PSetupFn arg3 = (PSetupFn) 0 ; + PSolveFn arg4 = (PSolveFn) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (void *)(farg2); + arg3 = (PSetupFn)(farg3); + arg4 = (PSolveFn)(farg4); + result = (int)SUNLinSolSetPreconditioner_SPGMR(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetScalingVectors_SPGMR(SUNLinearSolver farg1, N_Vector farg2, N_Vector farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)SUNLinSolSetScalingVectors_SPGMR(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetup_SPGMR(SUNLinearSolver farg1, SUNMatrix farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNLinSolSetup_SPGMR(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSolve_SPGMR(SUNLinearSolver farg1, SUNMatrix farg2, N_Vector farg3, N_Vector farg4, double const *farg5) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + realtype arg5 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (SUNMatrix)(farg2); + arg3 = (N_Vector)(farg3); + arg4 = (N_Vector)(farg4); + arg5 = (realtype)(*farg5); + result = (int)SUNLinSolSolve_SPGMR(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolNumIters_SPGMR(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolNumIters_SPGMR(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FSUNLinSolResNorm_SPGMR(SUNLinearSolver farg1) { + double fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + realtype result; + + arg1 = (SUNLinearSolver)(farg1); + result = (realtype)SUNLinSolResNorm_SPGMR(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT N_Vector _wrap_FSUNLinSolResid_SPGMR(SUNLinearSolver farg1) { + N_Vector fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + N_Vector result; + + arg1 = (SUNLinearSolver)(farg1); + result = (N_Vector)SUNLinSolResid_SPGMR(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNLinSolLastFlag_SPGMR(SUNLinearSolver farg1) { + int64_t fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + sunindextype result; + + arg1 = (SUNLinearSolver)(farg1); + result = SUNLinSolLastFlag_SPGMR(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSpace_SPGMR(SUNLinearSolver farg1, long *farg2, long *farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)SUNLinSolSpace_SPGMR(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolFree_SPGMR(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolFree_SPGMR(arg1); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/sunlinsol/spgmr/fsunlinsol_spgmr.c b/bazaar/plugin/sundials/src/sunlinsol/spgmr/fsunlinsol_spgmr.c new file mode 100644 index 000000000..66f5a3962 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/spgmr/fsunlinsol_spgmr.c @@ -0,0 +1,241 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunlinsol_spgmr.h) contains the + * implementation needed for the Fortran initialization of SPGMR + * linear solver operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fsunlinsol_spgmr.h" + +/* Define global linsol variables */ + +SUNLinearSolver F2C_CVODE_linsol; +SUNLinearSolver F2C_IDA_linsol; +SUNLinearSolver F2C_KINSOL_linsol; +SUNLinearSolver F2C_ARKODE_linsol; +SUNLinearSolver F2C_ARKODE_mass_sol; + +/* Declarations of external global variables */ + +extern SUNMatrix F2C_CVODE_matrix; +extern SUNMatrix F2C_IDA_matrix; +extern SUNMatrix F2C_KINSOL_matrix; +extern SUNMatrix F2C_ARKODE_matrix; +extern SUNMatrix F2C_ARKODE_mass_matrix; + +extern N_Vector F2C_CVODE_vec; +extern N_Vector F2C_IDA_vec; +extern N_Vector F2C_KINSOL_vec; +extern N_Vector F2C_ARKODE_vec; + +/* Fortran callable interfaces */ + +void FSUNSPGMR_INIT(int *code, int *pretype, int *maxl, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); + F2C_CVODE_linsol = NULL; + F2C_CVODE_linsol = SUNLinSol_SPGMR(F2C_CVODE_vec, *pretype, *maxl); + if (F2C_CVODE_linsol == NULL) *ier = -1; + break; + case FCMIX_IDA: + if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); + F2C_IDA_linsol = NULL; + F2C_IDA_linsol = SUNLinSol_SPGMR(F2C_IDA_vec, *pretype, *maxl); + if (F2C_IDA_linsol == NULL) *ier = -1; + break; + case FCMIX_KINSOL: + if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); + F2C_KINSOL_linsol = NULL; + F2C_KINSOL_linsol = SUNLinSol_SPGMR(F2C_KINSOL_vec, *pretype, *maxl); + if (F2C_KINSOL_linsol == NULL) *ier = -1; + break; + case FCMIX_ARKODE: + if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); + F2C_ARKODE_linsol = NULL; + F2C_ARKODE_linsol = SUNLinSol_SPGMR(F2C_ARKODE_vec, *pretype, *maxl); + if (F2C_ARKODE_linsol == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + + +void FSUNSPGMR_SETGSTYPE(int *code, int *gstype, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (!F2C_CVODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPGMRSetGSType(F2C_CVODE_linsol, *gstype); + break; + case FCMIX_IDA: + if (!F2C_IDA_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPGMRSetGSType(F2C_IDA_linsol, *gstype); + break; + case FCMIX_KINSOL: + if (!F2C_KINSOL_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPGMRSetGSType(F2C_KINSOL_linsol, *gstype); + break; + case FCMIX_ARKODE: + if (!F2C_ARKODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPGMRSetGSType(F2C_ARKODE_linsol, *gstype); + break; + default: + *ier = -1; + } +} + + +void FSUNSPGMR_SETPRECTYPE(int *code, int *pretype, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (!F2C_CVODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPGMRSetPrecType(F2C_CVODE_linsol, *pretype); + break; + case FCMIX_IDA: + if (!F2C_IDA_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPGMRSetPrecType(F2C_IDA_linsol, *pretype); + break; + case FCMIX_KINSOL: + if (!F2C_KINSOL_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPGMRSetPrecType(F2C_KINSOL_linsol, *pretype); + break; + case FCMIX_ARKODE: + if (!F2C_ARKODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPGMRSetPrecType(F2C_ARKODE_linsol, *pretype); + break; + default: + *ier = -1; + } +} + + +void FSUNSPGMR_SETMAXRS(int *code, int *maxrs, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (!F2C_CVODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPGMRSetMaxRestarts(F2C_CVODE_linsol, *maxrs); + break; + case FCMIX_IDA: + if (!F2C_IDA_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPGMRSetMaxRestarts(F2C_IDA_linsol, *maxrs); + break; + case FCMIX_KINSOL: + if (!F2C_KINSOL_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPGMRSetMaxRestarts(F2C_KINSOL_linsol, *maxrs); + break; + case FCMIX_ARKODE: + if (!F2C_ARKODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPGMRSetMaxRestarts(F2C_ARKODE_linsol, *maxrs); + break; + default: + *ier = -1; + } +} + + +void FSUNMASSSPGMR_INIT(int *pretype, int *maxl, int *ier) +{ + *ier = 0; + if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); + F2C_ARKODE_mass_sol = NULL; + F2C_ARKODE_mass_sol = SUNLinSol_SPGMR(F2C_ARKODE_vec, *pretype, *maxl); + if (F2C_ARKODE_mass_sol == NULL) *ier = -1; +} + + +void FSUNMASSSPGMR_SETGSTYPE(int *gstype, int *ier) +{ + *ier = 0; + if (!F2C_ARKODE_mass_sol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPGMRSetGSType(F2C_ARKODE_mass_sol, *gstype); +} + + +void FSUNMASSSPGMR_SETPRECTYPE(int *pretype, int *ier) +{ + *ier = 0; + if (!F2C_ARKODE_mass_sol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPGMRSetPrecType(F2C_ARKODE_mass_sol, *pretype); +} + + +void FSUNMASSSPGMR_SETMAXRS(int *maxrs, int *ier) +{ + *ier = 0; + if (!F2C_ARKODE_mass_sol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPGMRSetMaxRestarts(F2C_ARKODE_mass_sol, *maxrs); +} diff --git a/bazaar/plugin/sundials/src/sunlinsol/spgmr/fsunlinsol_spgmr.h b/bazaar/plugin/sundials/src/sunlinsol/spgmr/fsunlinsol_spgmr.h new file mode 100644 index 000000000..16ecf1c0e --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/spgmr/fsunlinsol_spgmr.h @@ -0,0 +1,88 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunlinsol_spgmr.c) contains the + * definitions needed for the initialization of SPGMR + * linear solver operations in Fortran. + * ----------------------------------------------------------------- + */ + +#ifndef _FSUNLINSOL_SPGMR_H +#define _FSUNLINSOL_SPGMR_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#if defined(SUNDIALS_F77_FUNC) +#define FSUNSPGMR_INIT SUNDIALS_F77_FUNC(fsunspgmrinit, FSUNSPGMRINIT) +#define FSUNSPGMR_SETGSTYPE SUNDIALS_F77_FUNC(fsunspgmrsetgstype, FSUNSPGMRSETGSTYPE) +#define FSUNSPGMR_SETPRECTYPE SUNDIALS_F77_FUNC(fsunspgmrsetprectype, FSUNSPGMRSETPRECTYPE) +#define FSUNSPGMR_SETMAXRS SUNDIALS_F77_FUNC(fsunspgmrsetmaxrs, FSUNSPGMRSETMAXRS) +#define FSUNMASSSPGMR_INIT SUNDIALS_F77_FUNC(fsunmassspgmrinit, FSUNMASSSPGMRINIT) +#define FSUNMASSSPGMR_SETGSTYPE SUNDIALS_F77_FUNC(fsunmassspgmrsetgstype, FSUNMASSSPGMRSETGSTYPE) +#define FSUNMASSSPGMR_SETPRECTYPE SUNDIALS_F77_FUNC(fsunmassspgmrsetprectype, FSUNMASSSPGMRSETPRECTYPE) +#define FSUNMASSSPGMR_SETMAXRS SUNDIALS_F77_FUNC(fsunmassspgmrsetmaxrs, FSUNMASSSPGMRSETMAXRS) +#else +#define FSUNSPGMR_INIT fsunspgmrinit_ +#define FSUNSPGMR_SETGSTYPE fsunspgmrsetgstype_ +#define FSUNSPGMR_SETPRECTYPE fsunspgmrsetprectype_ +#define FSUNSPGMR_SETMAXRS fsunspgmrsetmaxrs_ +#define FSUNMASSSPGMR_INIT fsunmassspgmrinit_ +#define FSUNMASSSPGMR_SETGSTYPE fsunmassspgmrsetgstype_ +#define FSUNMASSSPGMR_SETPRECTYPE fsunmassspgmrsetprectype_ +#define FSUNMASSSPGMR_SETMAXRS fsunmassspgmrsetmaxrs_ +#endif + + +/* Declarations of global variables */ + +extern SUNLinearSolver F2C_CVODE_linsol; +extern SUNLinearSolver F2C_IDA_linsol; +extern SUNLinearSolver F2C_KINSOL_linsol; +extern SUNLinearSolver F2C_ARKODE_linsol; +extern SUNLinearSolver F2C_ARKODE_mass_sol; + +/* + * Prototypes of exported functions + * + * FSUNSPGMR_INIT - initializes SPGMR linear solver for main problem + * FSUNSPGMR_SETGSTYPE - sets the Gram-Scmidt orthogonalization type for main problem + * FSUNSPGMR_SETPRECTYPE - sets the preconditioning type for main problem + * FSUNSPGMR_SETMAXRS - sets the maximum number of restarts to allow for main problem + * + * FSUNMASSSPGMR_INIT - initializes SPGMR linear solver for mass matrix solve + * FSUNMASSSPGMR_SETGSTYPE - sets the Gram-Scmidt orthogonalization type for mass matrix solve + * FSUNMASSSPGMR_SETPRECTYPE - sets the preconditioning type for mass matrix solve + * FSUNMASSSPGMR_SETMAXRS - sets the maximum number of restarts to allow for mass matrix solve + */ + +void FSUNSPGMR_INIT(int *code, int *pretype, int *maxl, int *ier); +void FSUNSPGMR_SETGSTYPE(int *code, int *gstype, int *ier); +void FSUNSPGMR_SETPRECTYPE(int *code, int *pretype, int *ier); +void FSUNSPGMR_SETMAXRS(int *code, int *maxrs, int *ier); + +void FSUNMASSSPGMR_INIT(int *pretype, int *maxl, int *ier); +void FSUNMASSSPGMR_SETGSTYPE(int *gstype, int *ier); +void FSUNMASSSPGMR_SETPRECTYPE(int *pretype, int *ier); +void FSUNMASSSPGMR_SETMAXRS(int *maxrs, int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/sunlinsol/spgmr/sunlinsol_spgmr.c b/bazaar/plugin/sundials/src/sunlinsol/spgmr/sunlinsol_spgmr.c new file mode 100644 index 000000000..5ae129dbd --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/spgmr/sunlinsol_spgmr.c @@ -0,0 +1,783 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * Based on sundials_spgmr.c code, written by Scott D. Cohen, + * Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for the SPGMR implementation of + * the SUNLINSOL package. + * -----------------------------------------------------------------*/ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* + * ----------------------------------------------------------------- + * SPGMR solver structure accessibility macros: + * ----------------------------------------------------------------- + */ + +#define SPGMR_CONTENT(S) ( (SUNLinearSolverContent_SPGMR)(S->content) ) +#define LASTFLAG(S) ( SPGMR_CONTENT(S)->last_flag ) + +/* + * ----------------------------------------------------------------- + * deprecated wrapper functions + * ----------------------------------------------------------------- + */ +SUNLinearSolver SUNSPGMR(N_Vector y, int pretype, int maxl) +{ return(SUNLinSol_SPGMR(y, pretype, maxl)); } + +int SUNSPGMRSetPrecType(SUNLinearSolver S, int pretype) +{ return(SUNLinSol_SPGMRSetPrecType(S, pretype)); } + +int SUNSPGMRSetGSType(SUNLinearSolver S, int gstype) +{ return(SUNLinSol_SPGMRSetGSType(S, gstype)); } + +int SUNSPGMRSetMaxRestarts(SUNLinearSolver S, int maxrs) +{ return(SUNLinSol_SPGMRSetMaxRestarts(S, maxrs)); } + +/* + * ----------------------------------------------------------------- + * exported functions + * ----------------------------------------------------------------- + */ + +/* ---------------------------------------------------------------------------- + * Function to create a new SPGMR linear solver + */ + +SUNLinearSolver SUNLinSol_SPGMR(N_Vector y, int pretype, int maxl) +{ + SUNLinearSolver S; + SUNLinearSolverContent_SPGMR content; + + /* check for legal pretype and maxl values; if illegal use defaults */ + if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && + (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) + pretype = PREC_NONE; + if (maxl <= 0) + maxl = SUNSPGMR_MAXL_DEFAULT; + + /* check that the supplied N_Vector supports all requisite operations */ + if ( (y->ops->nvclone == NULL) || (y->ops->nvdestroy == NULL) || + (y->ops->nvlinearsum == NULL) || (y->ops->nvconst == NULL) || + (y->ops->nvprod == NULL) || (y->ops->nvdiv == NULL) || + (y->ops->nvscale == NULL) || (y->ops->nvdotprod == NULL) ) + return(NULL); + + /* Create linear solver */ + S = NULL; + S = SUNLinSolNewEmpty(); + if (S == NULL) return(NULL); + + /* Attach operations */ + S->ops->gettype = SUNLinSolGetType_SPGMR; + S->ops->getid = SUNLinSolGetID_SPGMR; + S->ops->setatimes = SUNLinSolSetATimes_SPGMR; + S->ops->setpreconditioner = SUNLinSolSetPreconditioner_SPGMR; + S->ops->setscalingvectors = SUNLinSolSetScalingVectors_SPGMR; + S->ops->initialize = SUNLinSolInitialize_SPGMR; + S->ops->setup = SUNLinSolSetup_SPGMR; + S->ops->solve = SUNLinSolSolve_SPGMR; + S->ops->numiters = SUNLinSolNumIters_SPGMR; + S->ops->resnorm = SUNLinSolResNorm_SPGMR; + S->ops->resid = SUNLinSolResid_SPGMR; + S->ops->lastflag = SUNLinSolLastFlag_SPGMR; + S->ops->space = SUNLinSolSpace_SPGMR; + S->ops->free = SUNLinSolFree_SPGMR; + + /* Create content */ + content = NULL; + content = (SUNLinearSolverContent_SPGMR) malloc(sizeof *content); + if (content == NULL) { SUNLinSolFree(S); return(NULL); } + + /* Attach content */ + S->content = content; + + /* Fill content */ + content->last_flag = 0; + content->maxl = maxl; + content->pretype = pretype; + content->gstype = SUNSPGMR_GSTYPE_DEFAULT; + content->max_restarts = SUNSPGMR_MAXRS_DEFAULT; + content->numiters = 0; + content->resnorm = ZERO; + content->xcor = NULL; + content->vtemp = NULL; + content->s1 = NULL; + content->s2 = NULL; + content->ATimes = NULL; + content->ATData = NULL; + content->Psetup = NULL; + content->Psolve = NULL; + content->PData = NULL; + content->V = NULL; + content->Hes = NULL; + content->givens = NULL; + content->yg = NULL; + content->cv = NULL; + content->Xv = NULL; + + /* Allocate content */ + content->xcor = N_VClone(y); + if (content->xcor == NULL) { SUNLinSolFree(S); return(NULL); } + + content->vtemp = N_VClone(y); + if (content->vtemp == NULL) { SUNLinSolFree(S); return(NULL); } + + return(S); +} + + +/* ---------------------------------------------------------------------------- + * Function to set the type of preconditioning for SPGMR to use + */ + +SUNDIALS_EXPORT int SUNLinSol_SPGMRSetPrecType(SUNLinearSolver S, int pretype) +{ + /* Check for legal pretype */ + if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && + (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { + return(SUNLS_ILL_INPUT); + } + + /* Check for non-NULL SUNLinearSolver */ + if (S == NULL) return(SUNLS_MEM_NULL); + + /* Set pretype */ + SPGMR_CONTENT(S)->pretype = pretype; + return(SUNLS_SUCCESS); +} + + +/* ---------------------------------------------------------------------------- + * Function to set the type of Gram-Schmidt orthogonalization for SPGMR to use + */ + +SUNDIALS_EXPORT int SUNLinSol_SPGMRSetGSType(SUNLinearSolver S, int gstype) +{ + /* Check for legal gstype */ + if ((gstype != MODIFIED_GS) && (gstype != CLASSICAL_GS)) { + return(SUNLS_ILL_INPUT); + } + + /* Check for non-NULL SUNLinearSolver */ + if (S == NULL) return(SUNLS_MEM_NULL); + + /* Set pretype */ + SPGMR_CONTENT(S)->gstype = gstype; + return(SUNLS_SUCCESS); +} + + +/* ---------------------------------------------------------------------------- + * Function to set the maximum number of GMRES restarts to allow + */ + +SUNDIALS_EXPORT int SUNLinSol_SPGMRSetMaxRestarts(SUNLinearSolver S, int maxrs) +{ + /* Illegal maxrs implies use of default value */ + if (maxrs < 0) + maxrs = SUNSPGMR_MAXRS_DEFAULT; + + /* Check for non-NULL SUNLinearSolver */ + if (S == NULL) return(SUNLS_MEM_NULL); + + /* Set max_restarts */ + SPGMR_CONTENT(S)->max_restarts = maxrs; + return(SUNLS_SUCCESS); +} + + +/* + * ----------------------------------------------------------------- + * implementation of linear solver operations + * ----------------------------------------------------------------- + */ + +SUNLinearSolver_Type SUNLinSolGetType_SPGMR(SUNLinearSolver S) +{ + return(SUNLINEARSOLVER_ITERATIVE); +} + + +SUNLinearSolver_ID SUNLinSolGetID_SPGMR(SUNLinearSolver S) +{ + return(SUNLINEARSOLVER_SPGMR); +} + + +int SUNLinSolInitialize_SPGMR(SUNLinearSolver S) +{ + int k; + SUNLinearSolverContent_SPGMR content; + + /* set shortcut to SPGMR memory structure */ + if (S == NULL) return(SUNLS_MEM_NULL); + content = SPGMR_CONTENT(S); + + /* ensure valid options */ + if (content->max_restarts < 0) + content->max_restarts = SUNSPGMR_MAXRS_DEFAULT; + if ( (content->pretype != PREC_LEFT) && + (content->pretype != PREC_RIGHT) && + (content->pretype != PREC_BOTH) ) + content->pretype = PREC_NONE; + + + /* allocate solver-specific memory (where the size depends on the + choice of maxl) here */ + + /* Krylov subspace vectors */ + if (content->V == NULL) { + content->V = N_VCloneVectorArray(content->maxl+1, content->vtemp); + if (content->V == NULL) { + SUNLinSolFree(S); + content->last_flag = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + } + + /* Hessenberg matrix Hes */ + if (content->Hes == NULL) { + content->Hes = (realtype **) malloc((content->maxl+1)*sizeof(realtype *)); + if (content->Hes == NULL) { + SUNLinSolFree(S); + content->last_flag = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + + for (k=0; k<=content->maxl; k++) { + content->Hes[k] = NULL; + content->Hes[k] = (realtype *) malloc(content->maxl*sizeof(realtype)); + if (content->Hes[k] == NULL) { + SUNLinSolFree(S); + content->last_flag = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + } + } + + /* Givens rotation components */ + if (content->givens == NULL) { + content->givens = (realtype *) malloc(2*content->maxl*sizeof(realtype)); + if (content->givens == NULL) { + SUNLinSolFree(S); + content->last_flag = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + } + + /* y and g vectors */ + if (content->yg == NULL) { + content->yg = (realtype *) malloc((content->maxl+1)*sizeof(realtype)); + if (content->yg == NULL) { + SUNLinSolFree(S); + content->last_flag = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + } + + /* cv vector for fused vector ops */ + if (content->cv == NULL) { + content->cv = (realtype *) malloc((content->maxl+1)*sizeof(realtype)); + if (content->cv == NULL) { + SUNLinSolFree(S); + content->last_flag = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + } + + /* Xv vector for fused vector ops */ + if (content->Xv == NULL) { + content->Xv = (N_Vector *) malloc((content->maxl+1)*sizeof(N_Vector)); + if (content->Xv == NULL) { + SUNLinSolFree(S); + content->last_flag = SUNLS_MEM_FAIL; + return(SUNLS_MEM_FAIL); + } + } + + /* return with success */ + content->last_flag = SUNLS_SUCCESS; + return(SUNLS_SUCCESS); +} + + +int SUNLinSolSetATimes_SPGMR(SUNLinearSolver S, void* ATData, + ATimesFn ATimes) +{ + /* set function pointers to integrator-supplied ATimes routine + and data, and return with success */ + if (S == NULL) return(SUNLS_MEM_NULL); + SPGMR_CONTENT(S)->ATimes = ATimes; + SPGMR_CONTENT(S)->ATData = ATData; + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetPreconditioner_SPGMR(SUNLinearSolver S, void* PData, + PSetupFn Psetup, PSolveFn Psolve) +{ + /* set function pointers to integrator-supplied Psetup and PSolve + routines and data, and return with success */ + if (S == NULL) return(SUNLS_MEM_NULL); + SPGMR_CONTENT(S)->Psetup = Psetup; + SPGMR_CONTENT(S)->Psolve = Psolve; + SPGMR_CONTENT(S)->PData = PData; + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetScalingVectors_SPGMR(SUNLinearSolver S, N_Vector s1, + N_Vector s2) +{ + /* set N_Vector pointers to integrator-supplied scaling vectors, + and return with success */ + if (S == NULL) return(SUNLS_MEM_NULL); + SPGMR_CONTENT(S)->s1 = s1; + SPGMR_CONTENT(S)->s2 = s2; + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetup_SPGMR(SUNLinearSolver S, SUNMatrix A) +{ + int ier; + PSetupFn Psetup; + void* PData; + + /* Set shortcuts to SPGMR memory structures */ + if (S == NULL) return(SUNLS_MEM_NULL); + Psetup = SPGMR_CONTENT(S)->Psetup; + PData = SPGMR_CONTENT(S)->PData; + + /* no solver-specific setup is required, but if user-supplied + Psetup routine exists, call that here */ + if (Psetup != NULL) { + ier = Psetup(PData); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSET_FAIL_UNREC : SUNLS_PSET_FAIL_REC; + return(LASTFLAG(S)); + } + } + + /* return with success */ + return(SUNLS_SUCCESS); +} + + +int SUNLinSolSolve_SPGMR(SUNLinearSolver S, SUNMatrix A, N_Vector x, + N_Vector b, realtype delta) +{ + /* local data and shortcut variables */ + N_Vector *V, xcor, vtemp, s1, s2; + realtype **Hes, *givens, *yg, *res_norm; + realtype beta, rotation_product, r_norm, s_product, rho; + booleantype preOnLeft, preOnRight, scale2, scale1, converged; + int i, j, k, l, l_plus_1, l_max, krydim, ier, ntries, max_restarts, gstype; + int *nli; + void *A_data, *P_data; + ATimesFn atimes; + PSolveFn psolve; + + /* local shortcuts for fused vector operations */ + realtype* cv; + N_Vector* Xv; + + /* Initialize some variables */ + l_plus_1 = 0; + krydim = 0; + + /* Make local shorcuts to solver variables. */ + if (S == NULL) return(SUNLS_MEM_NULL); + l_max = SPGMR_CONTENT(S)->maxl; + max_restarts = SPGMR_CONTENT(S)->max_restarts; + gstype = SPGMR_CONTENT(S)->gstype; + V = SPGMR_CONTENT(S)->V; + Hes = SPGMR_CONTENT(S)->Hes; + givens = SPGMR_CONTENT(S)->givens; + xcor = SPGMR_CONTENT(S)->xcor; + yg = SPGMR_CONTENT(S)->yg; + vtemp = SPGMR_CONTENT(S)->vtemp; + s1 = SPGMR_CONTENT(S)->s1; + s2 = SPGMR_CONTENT(S)->s2; + A_data = SPGMR_CONTENT(S)->ATData; + P_data = SPGMR_CONTENT(S)->PData; + atimes = SPGMR_CONTENT(S)->ATimes; + psolve = SPGMR_CONTENT(S)->Psolve; + nli = &(SPGMR_CONTENT(S)->numiters); + res_norm = &(SPGMR_CONTENT(S)->resnorm); + cv = SPGMR_CONTENT(S)->cv; + Xv = SPGMR_CONTENT(S)->Xv; + + /* Initialize counters and convergence flag */ + *nli = 0; + converged = SUNFALSE; + + /* set booleantype flags for internal solver options */ + preOnLeft = ( (SPGMR_CONTENT(S)->pretype == PREC_LEFT) || + (SPGMR_CONTENT(S)->pretype == PREC_BOTH) ); + preOnRight = ( (SPGMR_CONTENT(S)->pretype == PREC_RIGHT) || + (SPGMR_CONTENT(S)->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 { + ier = atimes(A_data, x, vtemp); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; + return(LASTFLAG(S)); + } + 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, delta, PREC_LEFT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } 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 = SUNRsqrt(N_VDotProd(V[0], V[0])); + if (r_norm <= delta) { + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); + } + + /* Initialize rho to avoid compiler warning message */ + rho = beta; + + /* 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; j0; 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 = SUNRabs(r_norm); + + /* Multiply yg by V_(krydim+1) to get last residual vector; restart */ + for (k=0; k<=krydim; k++) { + cv[k] = yg[k]; + Xv[k] = V[k]; + } + ier = N_VLinearCombination(krydim+1, cv, Xv, V[0]); + if (ier != SUNLS_SUCCESS) return(SUNLS_VECTOROP_ERR); + + } + + /* 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, delta, PREC_RIGHT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } 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); + + LASTFLAG(S) = SUNLS_RES_REDUCED; + return(LASTFLAG(S)); + } + + LASTFLAG(S) = SUNLS_CONV_FAIL; + return(LASTFLAG(S)); +} + + +int SUNLinSolNumIters_SPGMR(SUNLinearSolver S) +{ + /* return the stored 'numiters' value */ + if (S == NULL) return(-1); + return (SPGMR_CONTENT(S)->numiters); +} + + +realtype SUNLinSolResNorm_SPGMR(SUNLinearSolver S) +{ + /* return the stored 'resnorm' value */ + if (S == NULL) return(-ONE); + return (SPGMR_CONTENT(S)->resnorm); +} + + +N_Vector SUNLinSolResid_SPGMR(SUNLinearSolver S) +{ + /* return the stored 'vtemp' vector */ + return (SPGMR_CONTENT(S)->vtemp); +} + + +sunindextype SUNLinSolLastFlag_SPGMR(SUNLinearSolver S) +{ + /* return the stored 'last_flag' value */ + if (S == NULL) return(-1); + return (LASTFLAG(S)); +} + + +int SUNLinSolSpace_SPGMR(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS) +{ + int maxl; + sunindextype liw1, lrw1; + maxl = SPGMR_CONTENT(S)->maxl; + if (SPGMR_CONTENT(S)->vtemp->ops->nvspace) + N_VSpace(SPGMR_CONTENT(S)->vtemp, &lrw1, &liw1); + else + lrw1 = liw1 = 0; + *lenrwLS = lrw1*(maxl + 5) + maxl*(maxl + 5) + 2; + *leniwLS = liw1*(maxl + 5); + return(SUNLS_SUCCESS); +} + + +int SUNLinSolFree_SPGMR(SUNLinearSolver S) +{ + int k; + + if (S == NULL) return(SUNLS_SUCCESS); + + if (S->content) { + /* delete items from within the content structure */ + if (SPGMR_CONTENT(S)->xcor) { + N_VDestroy(SPGMR_CONTENT(S)->xcor); + SPGMR_CONTENT(S)->xcor = NULL; + } + if (SPGMR_CONTENT(S)->vtemp) { + N_VDestroy(SPGMR_CONTENT(S)->vtemp); + SPGMR_CONTENT(S)->vtemp = NULL; + } + if (SPGMR_CONTENT(S)->V) { + N_VDestroyVectorArray(SPGMR_CONTENT(S)->V, + SPGMR_CONTENT(S)->maxl+1); + SPGMR_CONTENT(S)->V = NULL; + } + if (SPGMR_CONTENT(S)->Hes) { + for (k=0; k<=SPGMR_CONTENT(S)->maxl; k++) + if (SPGMR_CONTENT(S)->Hes[k]) { + free(SPGMR_CONTENT(S)->Hes[k]); + SPGMR_CONTENT(S)->Hes[k] = NULL; + } + free(SPGMR_CONTENT(S)->Hes); + SPGMR_CONTENT(S)->Hes = NULL; + } + if (SPGMR_CONTENT(S)->givens) { + free(SPGMR_CONTENT(S)->givens); + SPGMR_CONTENT(S)->givens = NULL; + } + if (SPGMR_CONTENT(S)->yg) { + free(SPGMR_CONTENT(S)->yg); + SPGMR_CONTENT(S)->yg = NULL; + } + if (SPGMR_CONTENT(S)->cv) { + free(SPGMR_CONTENT(S)->cv); + SPGMR_CONTENT(S)->cv = NULL; + } + if (SPGMR_CONTENT(S)->Xv) { + free(SPGMR_CONTENT(S)->Xv); + SPGMR_CONTENT(S)->Xv = NULL; + } + free(S->content); S->content = NULL; + } + if (S->ops) { free(S->ops); S->ops = NULL; } + free(S); S = NULL; + return(SUNLS_SUCCESS); +} diff --git a/bazaar/plugin/sundials/src/sunlinsol/sptfqmr/fmod/fsunlinsol_sptfqmr_mod.c b/bazaar/plugin/sundials/src/sunlinsol/sptfqmr/fmod/fsunlinsol_sptfqmr_mod.c new file mode 100644 index 000000000..a48255e91 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/sptfqmr/fmod/fsunlinsol_sptfqmr_mod.c @@ -0,0 +1,495 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ + +/* --------------------------------------------------------------- + * Programmer(s): Auto-generated by swig. + * --------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * -------------------------------------------------------------*/ + +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_linearsolver.h" + + +#include "sunlinsol/sunlinsol_sptfqmr.h" + +SWIGEXPORT SUNLinearSolver _wrap_FSUNLinSol_SPTFQMR(N_Vector farg1, int const *farg2, int const *farg3) { + SUNLinearSolver fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int arg3 ; + SUNLinearSolver result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + arg3 = (int)(*farg3); + result = (SUNLinearSolver)SUNLinSol_SPTFQMR(arg1,arg2,arg3); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSol_SPTFQMRSetPrecType(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNLinSol_SPTFQMRSetPrecType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSol_SPTFQMRSetMaxl(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNLinSol_SPTFQMRSetMaxl(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SUNLinearSolver _wrap_FSUNSPTFQMR(N_Vector farg1, int const *farg2, int const *farg3) { + SUNLinearSolver fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + int arg3 ; + SUNLinearSolver result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + arg3 = (int)(*farg3); + result = (SUNLinearSolver)SUNSPTFQMR(arg1,arg2,arg3); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNSPTFQMRSetPrecType(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNSPTFQMRSetPrecType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNSPTFQMRSetMaxl(SUNLinearSolver farg1, int const *farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNSPTFQMRSetMaxl(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolGetType_SPTFQMR(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNLinearSolver_Type result; + + arg1 = (SUNLinearSolver)(farg1); + result = (SUNLinearSolver_Type)SUNLinSolGetType_SPTFQMR(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolGetID_SPTFQMR(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNLinearSolver_ID result; + + arg1 = (SUNLinearSolver)(farg1); + result = (SUNLinearSolver_ID)SUNLinSolGetID_SPTFQMR(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolInitialize_SPTFQMR(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolInitialize_SPTFQMR(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetATimes_SPTFQMR(SUNLinearSolver farg1, void *farg2, ATimesFn farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + void *arg2 = (void *) 0 ; + ATimesFn arg3 = (ATimesFn) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (void *)(farg2); + arg3 = (ATimesFn)(farg3); + result = (int)SUNLinSolSetATimes_SPTFQMR(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetPreconditioner_SPTFQMR(SUNLinearSolver farg1, void *farg2, PSetupFn farg3, PSolveFn farg4) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + void *arg2 = (void *) 0 ; + PSetupFn arg3 = (PSetupFn) 0 ; + PSolveFn arg4 = (PSolveFn) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (void *)(farg2); + arg3 = (PSetupFn)(farg3); + arg4 = (PSolveFn)(farg4); + result = (int)SUNLinSolSetPreconditioner_SPTFQMR(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetScalingVectors_SPTFQMR(SUNLinearSolver farg1, N_Vector farg2, N_Vector farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)SUNLinSolSetScalingVectors_SPTFQMR(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSetup_SPTFQMR(SUNLinearSolver farg1, SUNMatrix farg2) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNLinSolSetup_SPTFQMR(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSolve_SPTFQMR(SUNLinearSolver farg1, SUNMatrix farg2, N_Vector farg3, N_Vector farg4, double const *farg5) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + realtype arg5 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (SUNMatrix)(farg2); + arg3 = (N_Vector)(farg3); + arg4 = (N_Vector)(farg4); + arg5 = (realtype)(*farg5); + result = (int)SUNLinSolSolve_SPTFQMR(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolNumIters_SPTFQMR(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolNumIters_SPTFQMR(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT double _wrap_FSUNLinSolResNorm_SPTFQMR(SUNLinearSolver farg1) { + double fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + realtype result; + + arg1 = (SUNLinearSolver)(farg1); + result = (realtype)SUNLinSolResNorm_SPTFQMR(arg1); + fresult = (realtype)(result); + return fresult; +} + + +SWIGEXPORT N_Vector _wrap_FSUNLinSolResid_SPTFQMR(SUNLinearSolver farg1) { + N_Vector fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + N_Vector result; + + arg1 = (SUNLinearSolver)(farg1); + result = (N_Vector)SUNLinSolResid_SPTFQMR(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNLinSolLastFlag_SPTFQMR(SUNLinearSolver farg1) { + int64_t fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + sunindextype result; + + arg1 = (SUNLinearSolver)(farg1); + result = SUNLinSolLastFlag_SPTFQMR(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolSpace_SPTFQMR(SUNLinearSolver farg1, long *farg2, long *farg3) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)SUNLinSolSpace_SPTFQMR(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNLinSolFree_SPTFQMR(SUNLinearSolver farg1) { + int fresult ; + SUNLinearSolver arg1 = (SUNLinearSolver) 0 ; + int result; + + arg1 = (SUNLinearSolver)(farg1); + result = (int)SUNLinSolFree_SPTFQMR(arg1); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/sunlinsol/sptfqmr/fsunlinsol_sptfqmr.c b/bazaar/plugin/sundials/src/sunlinsol/sptfqmr/fsunlinsol_sptfqmr.c new file mode 100644 index 000000000..828cd7c27 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/sptfqmr/fsunlinsol_sptfqmr.c @@ -0,0 +1,191 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunlinsol_sptfqmr.h) contains the + * implementation needed for the Fortran initialization of SPTFQMR + * linear solver operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fsunlinsol_sptfqmr.h" + +/* Define global linsol variables */ + +SUNLinearSolver F2C_CVODE_linsol; +SUNLinearSolver F2C_IDA_linsol; +SUNLinearSolver F2C_KINSOL_linsol; +SUNLinearSolver F2C_ARKODE_linsol; +SUNLinearSolver F2C_ARKODE_mass_sol; + +/* Declarations of external global variables */ + +extern SUNMatrix F2C_CVODE_matrix; +extern SUNMatrix F2C_IDA_matrix; +extern SUNMatrix F2C_KINSOL_matrix; +extern SUNMatrix F2C_ARKODE_matrix; +extern SUNMatrix F2C_ARKODE_mass_matrix; + +extern N_Vector F2C_CVODE_vec; +extern N_Vector F2C_IDA_vec; +extern N_Vector F2C_KINSOL_vec; +extern N_Vector F2C_ARKODE_vec; + +/* Fortran callable interfaces */ + +void FSUNSPTFQMR_INIT(int *code, int *pretype, int *maxl, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); + F2C_CVODE_linsol = NULL; + F2C_CVODE_linsol = SUNLinSol_SPTFQMR(F2C_CVODE_vec, *pretype, *maxl); + if (F2C_CVODE_linsol == NULL) *ier = -1; + break; + case FCMIX_IDA: + if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); + F2C_IDA_linsol = NULL; + F2C_IDA_linsol = SUNLinSol_SPTFQMR(F2C_IDA_vec, *pretype, *maxl); + if (F2C_IDA_linsol == NULL) *ier = -1; + break; + case FCMIX_KINSOL: + if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); + F2C_KINSOL_linsol = NULL; + F2C_KINSOL_linsol = SUNLinSol_SPTFQMR(F2C_KINSOL_vec, *pretype, *maxl); + if (F2C_KINSOL_linsol == NULL) *ier = -1; + break; + case FCMIX_ARKODE: + if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); + F2C_ARKODE_linsol = NULL; + F2C_ARKODE_linsol = SUNLinSol_SPTFQMR(F2C_ARKODE_vec, *pretype, *maxl); + if (F2C_ARKODE_linsol == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + + +void FSUNSPTFQMR_SETPRECTYPE(int *code, int *pretype, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (!F2C_CVODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPTFQMRSetPrecType(F2C_CVODE_linsol, *pretype); + break; + case FCMIX_IDA: + if (!F2C_IDA_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPTFQMRSetPrecType(F2C_IDA_linsol, *pretype); + break; + case FCMIX_KINSOL: + if (!F2C_KINSOL_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPTFQMRSetPrecType(F2C_KINSOL_linsol, *pretype); + break; + case FCMIX_ARKODE: + if (!F2C_ARKODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPTFQMRSetPrecType(F2C_ARKODE_linsol, *pretype); + break; + default: + *ier = -1; + } +} + + +void FSUNSPTFQMR_SETMAXL(int *code, int *maxl, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (!F2C_CVODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPTFQMRSetMaxl(F2C_CVODE_linsol, *maxl); + break; + case FCMIX_IDA: + if (!F2C_IDA_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPTFQMRSetMaxl(F2C_IDA_linsol, *maxl); + break; + case FCMIX_KINSOL: + if (!F2C_KINSOL_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPTFQMRSetMaxl(F2C_KINSOL_linsol, *maxl); + break; + case FCMIX_ARKODE: + if (!F2C_ARKODE_linsol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPTFQMRSetMaxl(F2C_ARKODE_linsol, *maxl); + break; + default: + *ier = -1; + } +} + + +void FSUNMASSSPTFQMR_INIT(int *pretype, int *maxl, int *ier) +{ + *ier = 0; + if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); + F2C_ARKODE_mass_sol = NULL; + F2C_ARKODE_mass_sol = SUNLinSol_SPTFQMR(F2C_ARKODE_vec, *pretype, *maxl); + if (F2C_ARKODE_mass_sol == NULL) *ier = -1; +} + + +void FSUNMASSSPTFQMR_SETPRECTYPE(int *pretype, int *ier) +{ + *ier = 0; + if (!F2C_ARKODE_mass_sol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPTFQMRSetPrecType(F2C_ARKODE_mass_sol, *pretype); +} + + +void FSUNMASSSPTFQMR_SETMAXL(int *maxl, int *ier) +{ + *ier = 0; + if (!F2C_ARKODE_mass_sol) { + *ier = -1; + return; + } + *ier = SUNLinSol_SPTFQMRSetMaxl(F2C_ARKODE_mass_sol, *maxl); +} diff --git a/bazaar/plugin/sundials/src/sunlinsol/sptfqmr/fsunlinsol_sptfqmr.h b/bazaar/plugin/sundials/src/sunlinsol/sptfqmr/fsunlinsol_sptfqmr.h new file mode 100644 index 000000000..64ade540f --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/sptfqmr/fsunlinsol_sptfqmr.h @@ -0,0 +1,80 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunlinsol_sptfqmr.c) contains the + * definitions needed for the initialization of SPTFQMR + * linear solver operations in Fortran. + * ----------------------------------------------------------------- + */ + +#ifndef _FSUNLINSOL_SPTFQMR_H +#define _FSUNLINSOL_SPTFQMR_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#if defined(SUNDIALS_F77_FUNC) +#define FSUNSPTFQMR_INIT SUNDIALS_F77_FUNC(fsunsptfqmrinit, FSUNSPTFQMRINIT) +#define FSUNSPTFQMR_SETPRECTYPE SUNDIALS_F77_FUNC(fsunsptfqmrsetprectype, FSUNSPTFQMRSETPRECTYPE) +#define FSUNSPTFQMR_SETMAXL SUNDIALS_F77_FUNC(fsunsptfqmrsetmaxl, FSUNSPTFQMRSETMAXL) +#define FSUNMASSSPTFQMR_INIT SUNDIALS_F77_FUNC(fsunmasssptfqmrinit, FSUNMASSSPTFQMRINIT) +#define FSUNMASSSPTFQMR_SETPRECTYPE SUNDIALS_F77_FUNC(fsunmasssptfqmrsetprectype, FSUNMASSSPTFQMRSETPRECTYPE) +#define FSUNMASSSPTFQMR_SETMAXL SUNDIALS_F77_FUNC(fsunmasssptfqmrsetmaxl, FSUNMASSSPTFQMRSETMAXL) +#else +#define FSUNSPTFQMR_INIT fsunsptfqmrinit_ +#define FSUNSPTFQMR_SETPRECTYPE fsunsptfqmrsetprectype_ +#define FSUNSPTFQMR_SETMAXL fsunsptfqmrsetmaxl_ +#define FSUNMASSSPTFQMR_INIT fsunmasssptfqmrinit_ +#define FSUNMASSSPTFQMR_SETPRECTYPE fsunmasssptfqmrsetprectype_ +#define FSUNMASSSPTFQMR_SETMAXL fsunmasssptfqmrsetmaxl_ +#endif + + +/* Declarations of global variables */ + +extern SUNLinearSolver F2C_CVODE_linsol; +extern SUNLinearSolver F2C_IDA_linsol; +extern SUNLinearSolver F2C_KINSOL_linsol; +extern SUNLinearSolver F2C_ARKODE_linsol; +extern SUNLinearSolver F2C_ARKODE_mass_sol; + +/* + * Prototypes of exported functions + * + * FSUNSPTFQMR_INIT - initializes SPTFQMR linear solver for main problem + * FSUNSPTFQMR_SETPRECTYPE - sets the preconditioning type for main problem + * FSUNSPTFQMR_SETMAXL - sets the max number of iterations for main problem + * + * FSUNMASSSPTFQMR_INIT - initializes SPTFQMR linear solver for mass matrix solve + * FSUNMASSSPTFQMR_SETPRECTYPE - sets the preconditioning type for mass matrix solve + * FSUNMASSSPTFQMR_SETMAXL - sets the max number of iterations for mass matrix solve + */ + +void FSUNSPTFQMR_INIT(int *code, int *pretype, int *maxl, int *ier); +void FSUNSPTFQMR_SETPRECTYPE(int *code, int *pretype, int *ier); +void FSUNSPTFQMR_SETMAXL(int *code, int *maxl, int *ier); + +void FSUNMASSSPTFQMR_INIT(int *pretype, int *maxl, int *ier); +void FSUNMASSSPTFQMR_SETPRECTYPE(int *pretype, int *ier); +void FSUNMASSSPTFQMR_SETMAXL(int *maxl, int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/sunlinsol/sptfqmr/sunlinsol_sptfqmr.c b/bazaar/plugin/sundials/src/sunlinsol/sptfqmr/sunlinsol_sptfqmr.c new file mode 100644 index 000000000..4b64b2e4e --- /dev/null +++ b/bazaar/plugin/sundials/src/sunlinsol/sptfqmr/sunlinsol_sptfqmr.c @@ -0,0 +1,804 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * Based on sundials_sptfqmr.c code, written by Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for the SPTFQMR implementation of + * the SUNLINSOL package. + * -----------------------------------------------------------------*/ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* + * ----------------------------------------------------------------- + * SPTFQMR solver structure accessibility macros: + * ----------------------------------------------------------------- + */ + +#define SPTFQMR_CONTENT(S) ( (SUNLinearSolverContent_SPTFQMR)(S->content) ) +#define LASTFLAG(S) ( SPTFQMR_CONTENT(S)->last_flag ) + +/* + * ----------------------------------------------------------------- + * deprecated wrapper functions + * ----------------------------------------------------------------- + */ + +SUNLinearSolver SUNSPTFQMR(N_Vector y, int pretype, int maxl) +{ return(SUNLinSol_SPTFQMR(y, pretype, maxl)); } + +int SUNSPTFQMRSetPrecType(SUNLinearSolver S, int pretype) +{ return(SUNLinSol_SPTFQMRSetPrecType(S, pretype)); } + +int SUNSPTFQMRSetMaxl(SUNLinearSolver S, int maxl) +{ return(SUNLinSol_SPTFQMRSetMaxl(S, maxl)); } + +/* + * ----------------------------------------------------------------- + * exported functions + * ----------------------------------------------------------------- + */ + +/* ---------------------------------------------------------------------------- + * Function to create a new SPTFQMR linear solver + */ + +SUNLinearSolver SUNLinSol_SPTFQMR(N_Vector y, int pretype, int maxl) +{ + SUNLinearSolver S; + SUNLinearSolverContent_SPTFQMR content; + + /* check for legal pretype and maxl values; if illegal use defaults */ + if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && + (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) + pretype = PREC_NONE; + if (maxl <= 0) + maxl = SUNSPTFQMR_MAXL_DEFAULT; + + /* check that the supplied N_Vector supports all requisite operations */ + if ( (y->ops->nvclone == NULL) || (y->ops->nvdestroy == NULL) || + (y->ops->nvlinearsum == NULL) || (y->ops->nvconst == NULL) || + (y->ops->nvprod == NULL) || (y->ops->nvdiv == NULL) || + (y->ops->nvscale == NULL) || (y->ops->nvdotprod == NULL) ) + return(NULL); + + /* Create linear solver */ + S = NULL; + S = SUNLinSolNewEmpty(); + if (S == NULL) return(NULL); + + /* Attach operations */ + S->ops->gettype = SUNLinSolGetType_SPTFQMR; + S->ops->getid = SUNLinSolGetID_SPTFQMR; + S->ops->setatimes = SUNLinSolSetATimes_SPTFQMR; + S->ops->setpreconditioner = SUNLinSolSetPreconditioner_SPTFQMR; + S->ops->setscalingvectors = SUNLinSolSetScalingVectors_SPTFQMR; + S->ops->initialize = SUNLinSolInitialize_SPTFQMR; + S->ops->setup = SUNLinSolSetup_SPTFQMR; + S->ops->solve = SUNLinSolSolve_SPTFQMR; + S->ops->numiters = SUNLinSolNumIters_SPTFQMR; + S->ops->resnorm = SUNLinSolResNorm_SPTFQMR; + S->ops->resid = SUNLinSolResid_SPTFQMR; + S->ops->lastflag = SUNLinSolLastFlag_SPTFQMR; + S->ops->space = SUNLinSolSpace_SPTFQMR; + S->ops->free = SUNLinSolFree_SPTFQMR; + + /* Create content */ + content = NULL; + content = (SUNLinearSolverContent_SPTFQMR) malloc(sizeof *content); + if (content == NULL) { SUNLinSolFree(S); return(NULL); } + + /* Attach content */ + S->content = content; + + /* Fill content */ + content->last_flag = 0; + content->maxl = maxl; + content->pretype = pretype; + content->numiters = 0; + content->resnorm = ZERO; + content->r_star = NULL; + content->q = NULL; + content->d = NULL; + content->v = NULL; + content->p = NULL; + content->r = NULL; + content->u = NULL; + content->vtemp1 = NULL; + content->vtemp2 = NULL; + content->vtemp3 = NULL; + content->s1 = NULL; + content->s2 = NULL; + content->ATimes = NULL; + content->ATData = NULL; + content->Psetup = NULL; + content->Psolve = NULL; + content->PData = NULL; + + /* Allocate content */ + content->r_star = N_VClone(y); + if (content->r_star == NULL) { SUNLinSolFree(S); return(NULL); } + + content->q = N_VClone(y); + if (content->q == NULL) { SUNLinSolFree(S); return(NULL); } + + content->d = N_VClone(y); + if (content->d == NULL) { SUNLinSolFree(S); return(NULL); } + + content->v = N_VClone(y); + if (content->v == NULL) { SUNLinSolFree(S); return(NULL); } + + content->p = N_VClone(y); + if (content->p == NULL) { SUNLinSolFree(S); return(NULL); } + + content->r = N_VCloneVectorArray(2, y); + if (content->r == NULL) { SUNLinSolFree(S); return(NULL); } + + content->u = N_VClone(y); + if (content->u == NULL) { SUNLinSolFree(S); return(NULL); } + + content->vtemp1 = N_VClone(y); + if (content->vtemp1 == NULL) { SUNLinSolFree(S); return(NULL); } + + content->vtemp2 = N_VClone(y); + if (content->vtemp2 == NULL) { SUNLinSolFree(S); return(NULL); } + + content->vtemp3 = N_VClone(y); + if (content->vtemp3 == NULL) { SUNLinSolFree(S); return(NULL); } + + return(S); +} + + +/* ---------------------------------------------------------------------------- + * Function to set the type of preconditioning for SPTFQMR to use + */ + +SUNDIALS_EXPORT int SUNLinSol_SPTFQMRSetPrecType(SUNLinearSolver S, int pretype) +{ + /* Check for legal pretype */ + if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && + (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { + return(SUNLS_ILL_INPUT); + } + + /* Check for non-NULL SUNLinearSolver */ + if (S == NULL) return(SUNLS_MEM_NULL); + + /* Set pretype */ + SPTFQMR_CONTENT(S)->pretype = pretype; + return(SUNLS_SUCCESS); +} + + +/* ---------------------------------------------------------------------------- + * Function to set the maximum number of iterations for SPTFQMR to use + */ + +SUNDIALS_EXPORT int SUNLinSol_SPTFQMRSetMaxl(SUNLinearSolver S, int maxl) +{ + /* Check for non-NULL SUNLinearSolver */ + if (S == NULL) return(SUNLS_MEM_NULL); + + /* Check for legal pretype */ + if (maxl <= 0) + maxl = SUNSPTFQMR_MAXL_DEFAULT; + + /* Set pretype */ + SPTFQMR_CONTENT(S)->maxl = maxl; + return(SUNLS_SUCCESS); +} + + +/* + * ----------------------------------------------------------------- + * implementation of linear solver operations + * ----------------------------------------------------------------- + */ + +SUNLinearSolver_Type SUNLinSolGetType_SPTFQMR(SUNLinearSolver S) +{ + return(SUNLINEARSOLVER_ITERATIVE); +} + + +SUNLinearSolver_ID SUNLinSolGetID_SPTFQMR(SUNLinearSolver S) +{ + return(SUNLINEARSOLVER_SPTFQMR); +} + + +int SUNLinSolInitialize_SPTFQMR(SUNLinearSolver S) +{ + SUNLinearSolverContent_SPTFQMR content; + + /* set shortcut to SPTFQMR memory structure */ + if (S == NULL) return(SUNLS_MEM_NULL); + content = SPTFQMR_CONTENT(S); + + /* ensure valid options */ + if ( (content->pretype != PREC_LEFT) && + (content->pretype != PREC_RIGHT) && + (content->pretype != PREC_BOTH) ) + content->pretype = PREC_NONE; + if (content->maxl <= 0) + content->maxl = SUNSPTFQMR_MAXL_DEFAULT; + + /* no additional memory to allocate */ + + /* return with success */ + content->last_flag = SUNLS_SUCCESS; + return(SUNLS_SUCCESS); +} + + +int SUNLinSolSetATimes_SPTFQMR(SUNLinearSolver S, void* ATData, + ATimesFn ATimes) +{ + /* set function pointers to integrator-supplied ATimes routine + and data, and return with success */ + if (S == NULL) return(SUNLS_MEM_NULL); + SPTFQMR_CONTENT(S)->ATimes = ATimes; + SPTFQMR_CONTENT(S)->ATData = ATData; + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetPreconditioner_SPTFQMR(SUNLinearSolver S, void* PData, + PSetupFn Psetup, PSolveFn Psolve) +{ + /* set function pointers to integrator-supplied Psetup and PSolve + routines and data, and return with success */ + if (S == NULL) return(SUNLS_MEM_NULL); + SPTFQMR_CONTENT(S)->Psetup = Psetup; + SPTFQMR_CONTENT(S)->Psolve = Psolve; + SPTFQMR_CONTENT(S)->PData = PData; + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetScalingVectors_SPTFQMR(SUNLinearSolver S, + N_Vector s1, + N_Vector s2) +{ + /* set N_Vector pointers to integrator-supplied scaling vectors, + and return with success */ + if (S == NULL) return(SUNLS_MEM_NULL); + SPTFQMR_CONTENT(S)->s1 = s1; + SPTFQMR_CONTENT(S)->s2 = s2; + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); +} + + +int SUNLinSolSetup_SPTFQMR(SUNLinearSolver S, SUNMatrix A) +{ + int ier; + PSetupFn Psetup; + void* PData; + + /* Set shortcuts to SPTFQMR memory structures */ + if (S == NULL) return(SUNLS_MEM_NULL); + Psetup = SPTFQMR_CONTENT(S)->Psetup; + PData = SPTFQMR_CONTENT(S)->PData; + + /* no solver-specific setup is required, but if user-supplied + Psetup routine exists, call that here */ + if (Psetup != NULL) { + ier = Psetup(PData); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSET_FAIL_UNREC : SUNLS_PSET_FAIL_REC; + return(LASTFLAG(S)); + } + } + + /* return with success */ + return(SUNLS_SUCCESS); +} + + +int SUNLinSolSolve_SPTFQMR(SUNLinearSolver S, SUNMatrix A, N_Vector x, + N_Vector b, realtype delta) +{ + /* local data and shortcut variables */ + realtype alpha, tau, eta, beta, c, sigma, v_bar, omega; + realtype rho[2]; + realtype r_init_norm, r_curr_norm; + realtype temp_val; + booleantype preOnLeft, preOnRight, scale_x, scale_b, converged; + booleantype b_ok; + int n, m, ier, l_max; + void *A_data, *P_data; + ATimesFn atimes; + PSolveFn psolve; + realtype *res_norm; + int *nli; + N_Vector sx, sb, r_star, q, d, v, p, *r, u, vtemp1, vtemp2, vtemp3; + + /* local variables for fused vector operations */ + realtype cv[3]; + N_Vector Xv[3]; + + /* Make local shorcuts to solver variables. */ + if (S == NULL) return(SUNLS_MEM_NULL); + l_max = SPTFQMR_CONTENT(S)->maxl; + r_star = SPTFQMR_CONTENT(S)->r_star; + q = SPTFQMR_CONTENT(S)->q; + d = SPTFQMR_CONTENT(S)->d; + v = SPTFQMR_CONTENT(S)->v; + p = SPTFQMR_CONTENT(S)->p; + r = SPTFQMR_CONTENT(S)->r; + u = SPTFQMR_CONTENT(S)->u; + vtemp1 = SPTFQMR_CONTENT(S)->vtemp1; + vtemp2 = SPTFQMR_CONTENT(S)->vtemp2; + vtemp3 = SPTFQMR_CONTENT(S)->vtemp3; + sb = SPTFQMR_CONTENT(S)->s1; + sx = SPTFQMR_CONTENT(S)->s2; + A_data = SPTFQMR_CONTENT(S)->ATData; + P_data = SPTFQMR_CONTENT(S)->PData; + atimes = SPTFQMR_CONTENT(S)->ATimes; + psolve = SPTFQMR_CONTENT(S)->Psolve; + nli = &(SPTFQMR_CONTENT(S)->numiters); + res_norm = &(SPTFQMR_CONTENT(S)->resnorm); + + /* Initialize counters and convergence flag */ + temp_val = r_curr_norm = -ONE; + *nli = 0; + converged = SUNFALSE; + b_ok = SUNFALSE; + + /* set booleantype flags for internal solver options */ + preOnLeft = ( (SPTFQMR_CONTENT(S)->pretype == PREC_LEFT) || + (SPTFQMR_CONTENT(S)->pretype == PREC_BOTH) ); + preOnRight = ( (SPTFQMR_CONTENT(S)->pretype == PREC_RIGHT) || + (SPTFQMR_CONTENT(S)->pretype == PREC_BOTH) ); + scale_x = (sx != NULL); + scale_b = (sb != NULL); + + /* Set r_star to initial (unscaled) residual r_star = r_0 = b - A*x_0 */ + /* NOTE: if x == 0 then just set residual to b and continue */ + if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r_star); + else { + ier = atimes(A_data, x, r_star); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; + return(LASTFLAG(S)); + } + N_VLinearSum(ONE, b, -ONE, r_star, r_star); + } + + /* Apply left preconditioner and b-scaling to r_star (or really just r_0) */ + if (preOnLeft) { + ier = psolve(P_data, r_star, vtemp1, delta, PREC_LEFT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } + else N_VScale(ONE, r_star, vtemp1); + if (scale_b) N_VProd(sb, vtemp1, r_star); + else N_VScale(ONE, vtemp1, r_star); + + /* Initialize rho[0] */ + /* NOTE: initialized here to reduce number of computations - avoid need + to compute r_star^T*r_star twice, and avoid needlessly squaring + values */ + rho[0] = N_VDotProd(r_star, r_star); + + /* Compute norm of initial residual (r_0) to see if we really need + to do anything */ + *res_norm = r_init_norm = SUNRsqrt(rho[0]); + if (r_init_norm <= delta) { + LASTFLAG(S) = SUNLS_SUCCESS; + return(LASTFLAG(S)); + } + + /* Set v = A*r_0 (preconditioned and scaled) */ + if (scale_x) N_VDiv(r_star, sx, vtemp1); + else N_VScale(ONE, r_star, vtemp1); + if (preOnRight) { + N_VScale(ONE, vtemp1, v); + ier = psolve(P_data, v, vtemp1, delta, PREC_RIGHT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } + ier = atimes(A_data, vtemp1, v); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; + return(LASTFLAG(S)); + } + if (preOnLeft) { + ier = psolve(P_data, v, vtemp1, delta, PREC_LEFT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } + else N_VScale(ONE, v, vtemp1); + if (scale_b) N_VProd(sb, vtemp1, v); + else N_VScale(ONE, vtemp1, v); + + /* Initialize remaining variables */ + N_VScale(ONE, r_star, r[0]); + N_VScale(ONE, r_star, u); + N_VScale(ONE, r_star, p); + N_VConst(ZERO, d); + + tau = r_init_norm; + v_bar = eta = ZERO; + + /* START outer loop */ + for (n = 0; n < l_max; ++n) { + + /* Increment linear iteration counter */ + (*nli)++; + + /* sigma = r_star^T*v */ + sigma = N_VDotProd(r_star, v); + + /* alpha = rho[0]/sigma */ + alpha = rho[0]/sigma; + + /* q = u-alpha*v */ + N_VLinearSum(ONE, u, -alpha, v, q); + + /* r[1] = r[0]-alpha*A*(u+q) */ + N_VLinearSum(ONE, u, ONE, q, r[1]); + if (scale_x) N_VDiv(r[1], sx, r[1]); + if (preOnRight) { + N_VScale(ONE, r[1], vtemp1); + ier = psolve(P_data, vtemp1, r[1], delta, PREC_RIGHT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } + ier = atimes(A_data, r[1], vtemp1); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; + return(LASTFLAG(S)); + } + if (preOnLeft) { + ier = psolve(P_data, vtemp1, r[1], delta, PREC_LEFT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } + else N_VScale(ONE, vtemp1, r[1]); + if (scale_b) N_VProd(sb, r[1], vtemp1); + else N_VScale(ONE, r[1], vtemp1); + N_VLinearSum(ONE, r[0], -alpha, vtemp1, r[1]); + + /* START inner loop */ + for (m = 0; m < 2; ++m) { + + /* d = [*]+(v_bar^2*eta/alpha)*d */ + /* NOTES: + * (1) [*] = u if m == 0, and q if m == 1 + * (2) using temp_val reduces the number of required computations + * if the inner loop is executed twice + */ + if (m == 0) { + temp_val = SUNRsqrt(N_VDotProd(r[1], r[1])); + omega = SUNRsqrt(SUNRsqrt(N_VDotProd(r[0], r[0]))*temp_val); + N_VLinearSum(ONE, u, SUNSQR(v_bar)*eta/alpha, d, d); + } + else { + omega = temp_val; + N_VLinearSum(ONE, q, SUNSQR(v_bar)*eta/alpha, d, d); + } + + /* v_bar = omega/tau */ + v_bar = omega/tau; + + /* c = (1+v_bar^2)^(-1/2) */ + c = ONE / SUNRsqrt(ONE+SUNSQR(v_bar)); + + /* tau = tau*v_bar*c */ + tau = tau*v_bar*c; + + /* eta = c^2*alpha */ + eta = SUNSQR(c)*alpha; + + /* x = x+eta*d */ + N_VLinearSum(ONE, x, eta, d, x); + + /* Check for convergence... */ + /* NOTE: just use approximation to norm of residual, if possible */ + *res_norm = r_curr_norm = tau*SUNRsqrt(m+1); + + /* Exit inner loop if iteration has converged based upon approximation + to norm of current residual */ + if (r_curr_norm <= delta) { + converged = SUNTRUE; + break; + } + + /* Decide if actual norm of residual vector should be computed */ + /* NOTES: + * (1) if r_curr_norm > delta, then check if actual residual norm + * is OK (recall we first compute an approximation) + * (2) if r_curr_norm >= r_init_norm and m == 1 and n == l_max, then + * compute actual residual norm to see if the iteration can be + * saved + * (3) the scaled and preconditioned right-hand side of the given + * linear system (denoted by b) is only computed once, and the + * result is stored in vtemp3 so it can be reused - reduces the + * number of psovles if using left preconditioning + */ + if ((r_curr_norm > delta) || + (r_curr_norm >= r_init_norm && m == 1 && n == l_max)) { + + /* Compute norm of residual ||b-A*x||_2 (preconditioned and scaled) */ + if (scale_x) N_VDiv(x, sx, vtemp1); + else N_VScale(ONE, x, vtemp1); + if (preOnRight) { + ier = psolve(P_data, vtemp1, vtemp2, delta, PREC_RIGHT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_UNREC; + return(LASTFLAG(S)); + } + N_VScale(ONE, vtemp2, vtemp1); + } + ier = atimes(A_data, vtemp1, vtemp2); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; + return(LASTFLAG(S)); + } + if (preOnLeft) { + ier = psolve(P_data, vtemp2, vtemp1, delta, PREC_LEFT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } + else N_VScale(ONE, vtemp2, vtemp1); + if (scale_b) N_VProd(sb, vtemp1, vtemp2); + else N_VScale(ONE, vtemp1, vtemp2); + /* Only precondition and scale b once (result saved for reuse) */ + if (!b_ok) { + b_ok = SUNTRUE; + if (preOnLeft) { + ier = psolve(P_data, b, vtemp3, delta, PREC_LEFT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } + else N_VScale(ONE, b, vtemp3); + if (scale_b) N_VProd(sb, vtemp3, vtemp3); + } + N_VLinearSum(ONE, vtemp3, -ONE, vtemp2, vtemp1); + *res_norm = r_curr_norm = SUNRsqrt(N_VDotProd(vtemp1, vtemp1)); + + /* Exit inner loop if inequality condition is satisfied + (meaning exit if we have converged) */ + if (r_curr_norm <= delta) { + converged = SUNTRUE; + break; + } + + } + + } /* END inner loop */ + + /* If converged, then exit outer loop as well */ + if (converged == SUNTRUE) break; + + /* rho[1] = r_star^T*r_[1] */ + rho[1] = N_VDotProd(r_star, r[1]); + + /* beta = rho[1]/rho[0] */ + beta = rho[1]/rho[0]; + + /* u = r[1]+beta*q */ + N_VLinearSum(ONE, r[1], beta, q, u); + + /* p = u+beta*(q+beta*p) = beta*beta*p + beta*q + u */ + cv[0] = SUNSQR(beta); + Xv[0] = p; + + cv[1] = beta; + Xv[1] = q; + + cv[2] = ONE; + Xv[2] = u; + + ier = N_VLinearCombination(3, cv, Xv, p); + if (ier != SUNLS_SUCCESS) return(SUNLS_VECTOROP_ERR); + + /* v = A*p */ + if (scale_x) N_VDiv(p, sx, vtemp1); + else N_VScale(ONE, p, vtemp1); + if (preOnRight) { + N_VScale(ONE, vtemp1, v); + ier = psolve(P_data, v, vtemp1, delta, PREC_RIGHT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } + ier = atimes(A_data, vtemp1, v); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; + return(LASTFLAG(S)); + } + if (preOnLeft) { + ier = psolve(P_data, v, vtemp1, delta, PREC_LEFT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; + return(LASTFLAG(S)); + } + } + else N_VScale(ONE, v, vtemp1); + if (scale_b) N_VProd(sb, vtemp1, v); + else N_VScale(ONE, vtemp1, v); + + /* Shift variable values */ + /* NOTE: reduces storage requirements */ + N_VScale(ONE, r[1], r[0]); + rho[0] = rho[1]; + + } /* END outer loop */ + + /* Determine return value */ + /* If iteration converged or residual was reduced, then return current iterate (x) */ + if ((converged == SUNTRUE) || (r_curr_norm < r_init_norm)) { + if (scale_x) N_VDiv(x, sx, x); + if (preOnRight) { + ier = psolve(P_data, x, vtemp1, delta, PREC_RIGHT); + if (ier != 0) { + LASTFLAG(S) = (ier < 0) ? + SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_UNREC; + return(LASTFLAG(S)); + } + N_VScale(ONE, vtemp1, x); + } + if (converged == SUNTRUE) + LASTFLAG(S) = SUNLS_SUCCESS; + else + LASTFLAG(S) = SUNLS_RES_REDUCED; + return(LASTFLAG(S)); + } + /* Otherwise, return error code */ + else { + LASTFLAG(S) = SUNLS_CONV_FAIL; + return(LASTFLAG(S)); + } +} + + +int SUNLinSolNumIters_SPTFQMR(SUNLinearSolver S) +{ + /* return the stored 'numiters' value */ + if (S == NULL) return(-1); + return (SPTFQMR_CONTENT(S)->numiters); +} + + +realtype SUNLinSolResNorm_SPTFQMR(SUNLinearSolver S) +{ + /* return the stored 'resnorm' value */ + if (S == NULL) return(-ONE); + return (SPTFQMR_CONTENT(S)->resnorm); +} + + +N_Vector SUNLinSolResid_SPTFQMR(SUNLinearSolver S) +{ + /* return the stored 'vtemp1' vector */ + return (SPTFQMR_CONTENT(S)->vtemp1); +} + + +sunindextype SUNLinSolLastFlag_SPTFQMR(SUNLinearSolver S) +{ + /* return the stored 'last_flag' value */ + if (S == NULL) return(-1); + return (LASTFLAG(S)); +} + + +int SUNLinSolSpace_SPTFQMR(SUNLinearSolver S, + long int *lenrwLS, + long int *leniwLS) +{ + sunindextype liw1, lrw1; + if (SPTFQMR_CONTENT(S)->vtemp1->ops->nvspace) + N_VSpace(SPTFQMR_CONTENT(S)->vtemp1, &lrw1, &liw1); + else + lrw1 = liw1 = 0; + *lenrwLS = lrw1*11; + *leniwLS = liw1*11; + return(SUNLS_SUCCESS); +} + +int SUNLinSolFree_SPTFQMR(SUNLinearSolver S) +{ + if (S == NULL) return(SUNLS_SUCCESS); + + if (S->content) { + /* delete items from within the content structure */ + if (SPTFQMR_CONTENT(S)->r_star) { + N_VDestroy(SPTFQMR_CONTENT(S)->r_star); + SPTFQMR_CONTENT(S)->r_star = NULL; + } + if (SPTFQMR_CONTENT(S)->q) { + N_VDestroy(SPTFQMR_CONTENT(S)->q); + SPTFQMR_CONTENT(S)->q = NULL; + } + if (SPTFQMR_CONTENT(S)->d) { + N_VDestroy(SPTFQMR_CONTENT(S)->d); + SPTFQMR_CONTENT(S)->d = NULL; + } + if (SPTFQMR_CONTENT(S)->v) { + N_VDestroy(SPTFQMR_CONTENT(S)->v); + SPTFQMR_CONTENT(S)->v = NULL; + } + if (SPTFQMR_CONTENT(S)->p) { + N_VDestroy(SPTFQMR_CONTENT(S)->p); + SPTFQMR_CONTENT(S)->p = NULL; + } + if (SPTFQMR_CONTENT(S)->r) { + N_VDestroyVectorArray(SPTFQMR_CONTENT(S)->r, 2); + SPTFQMR_CONTENT(S)->r = NULL; + } + if (SPTFQMR_CONTENT(S)->u) { + N_VDestroy(SPTFQMR_CONTENT(S)->u); + SPTFQMR_CONTENT(S)->u = NULL; + } + if (SPTFQMR_CONTENT(S)->vtemp1) { + N_VDestroy(SPTFQMR_CONTENT(S)->vtemp1); + SPTFQMR_CONTENT(S)->vtemp1 = NULL; + } + if (SPTFQMR_CONTENT(S)->vtemp2) { + N_VDestroy(SPTFQMR_CONTENT(S)->vtemp2); + SPTFQMR_CONTENT(S)->vtemp2 = NULL; + } + if (SPTFQMR_CONTENT(S)->vtemp3) { + N_VDestroy(SPTFQMR_CONTENT(S)->vtemp3); + SPTFQMR_CONTENT(S)->vtemp3 = NULL; + } + free(S->content); S->content = NULL; + } + if (S->ops) { free(S->ops); S->ops = NULL; } + free(S); S = NULL; + return(SUNLS_SUCCESS); +} diff --git a/bazaar/plugin/sundials/src/sunmatrix/band/fmod/fsunmatrix_band_mod.c b/bazaar/plugin/sundials/src/sunmatrix/band/fmod/fsunmatrix_band_mod.c new file mode 100644 index 000000000..95223729c --- /dev/null +++ b/bazaar/plugin/sundials/src/sunmatrix/band/fmod/fsunmatrix_band_mod.c @@ -0,0 +1,485 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ + +/* --------------------------------------------------------------- + * Programmer(s): Auto-generated by swig. + * --------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * -------------------------------------------------------------*/ + +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_matrix.h" + + +#include "sunmatrix/sunmatrix_band.h" + +SWIGEXPORT SUNMatrix _wrap_FSUNBandMatrix(int64_t const *farg1, int64_t const *farg2, int64_t const *farg3) { + SUNMatrix fresult ; + sunindextype arg1 ; + sunindextype arg2 ; + sunindextype arg3 ; + SUNMatrix result; + + arg1 = (sunindextype)(*farg1); + arg2 = (sunindextype)(*farg2); + arg3 = (sunindextype)(*farg3); + result = (SUNMatrix)SUNBandMatrix(arg1,arg2,arg3); + fresult = result; + return fresult; +} + + +SWIGEXPORT SUNMatrix _wrap_FSUNBandMatrixStorage(int64_t const *farg1, int64_t const *farg2, int64_t const *farg3, int64_t const *farg4) { + SUNMatrix fresult ; + sunindextype arg1 ; + sunindextype arg2 ; + sunindextype arg3 ; + sunindextype arg4 ; + SUNMatrix result; + + arg1 = (sunindextype)(*farg1); + arg2 = (sunindextype)(*farg2); + arg3 = (sunindextype)(*farg3); + arg4 = (sunindextype)(*farg4); + result = (SUNMatrix)SUNBandMatrixStorage(arg1,arg2,arg3,arg4); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FSUNBandMatrix_Print(SUNMatrix farg1, void *farg2) { + SUNMatrix arg1 = (SUNMatrix) 0 ; + FILE *arg2 = (FILE *) 0 ; + + arg1 = (SUNMatrix)(farg1); + arg2 = (FILE *)(farg2); + SUNBandMatrix_Print(arg1,arg2); +} + + +SWIGEXPORT int64_t _wrap_FSUNBandMatrix_Rows(SUNMatrix farg1) { + int64_t fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype result; + + arg1 = (SUNMatrix)(farg1); + result = SUNBandMatrix_Rows(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNBandMatrix_Columns(SUNMatrix farg1) { + int64_t fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype result; + + arg1 = (SUNMatrix)(farg1); + result = SUNBandMatrix_Columns(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNBandMatrix_LowerBandwidth(SUNMatrix farg1) { + int64_t fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype result; + + arg1 = (SUNMatrix)(farg1); + result = SUNBandMatrix_LowerBandwidth(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNBandMatrix_UpperBandwidth(SUNMatrix farg1) { + int64_t fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype result; + + arg1 = (SUNMatrix)(farg1); + result = SUNBandMatrix_UpperBandwidth(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNBandMatrix_StoredUpperBandwidth(SUNMatrix farg1) { + int64_t fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype result; + + arg1 = (SUNMatrix)(farg1); + result = SUNBandMatrix_StoredUpperBandwidth(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNBandMatrix_LDim(SUNMatrix farg1) { + int64_t fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype result; + + arg1 = (SUNMatrix)(farg1); + result = SUNBandMatrix_LDim(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT double * _wrap_FSUNBandMatrix_Data(SUNMatrix farg1) { + double * fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + realtype *result = 0 ; + + arg1 = (SUNMatrix)(farg1); + result = (realtype *)SUNBandMatrix_Data(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT void * _wrap_FSUNBandMatrix_Cols(SUNMatrix farg1) { + void * fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + realtype **result = 0 ; + + arg1 = (SUNMatrix)(farg1); + result = (realtype **)SUNBandMatrix_Cols(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT double * _wrap_FSUNBandMatrix_Column(SUNMatrix farg1, int64_t const *farg2) { + double * fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype arg2 ; + realtype *result = 0 ; + + arg1 = (SUNMatrix)(farg1); + arg2 = (sunindextype)(*farg2); + result = (realtype *)SUNBandMatrix_Column(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatGetID_Band(SUNMatrix farg1) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + SUNMatrix_ID result; + + arg1 = (SUNMatrix)(farg1); + result = (SUNMatrix_ID)SUNMatGetID_Band(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SUNMatrix _wrap_FSUNMatClone_Band(SUNMatrix farg1) { + SUNMatrix fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + SUNMatrix result; + + arg1 = (SUNMatrix)(farg1); + result = (SUNMatrix)SUNMatClone_Band(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FSUNMatDestroy_Band(SUNMatrix farg1) { + SUNMatrix arg1 = (SUNMatrix) 0 ; + + arg1 = (SUNMatrix)(farg1); + SUNMatDestroy_Band(arg1); +} + + +SWIGEXPORT int _wrap_FSUNMatZero_Band(SUNMatrix farg1) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + result = (int)SUNMatZero_Band(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatCopy_Band(SUNMatrix farg1, SUNMatrix farg2) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNMatCopy_Band(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatScaleAdd_Band(double const *farg1, SUNMatrix farg2, SUNMatrix farg3) { + int fresult ; + realtype arg1 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + SUNMatrix arg3 = (SUNMatrix) 0 ; + int result; + + arg1 = (realtype)(*farg1); + arg2 = (SUNMatrix)(farg2); + arg3 = (SUNMatrix)(farg3); + result = (int)SUNMatScaleAdd_Band(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatScaleAddI_Band(double const *farg1, SUNMatrix farg2) { + int fresult ; + realtype arg1 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (realtype)(*farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNMatScaleAddI_Band(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatMatvec_Band(SUNMatrix farg1, N_Vector farg2, N_Vector farg3) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)SUNMatMatvec_Band(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatSpace_Band(SUNMatrix farg1, long *farg2, long *farg3) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)SUNMatSpace_Band(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/sunmatrix/band/fsunmatrix_band.c b/bazaar/plugin/sundials/src/sunmatrix/band/fsunmatrix_band.c new file mode 100644 index 000000000..a15a31c59 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunmatrix/band/fsunmatrix_band.c @@ -0,0 +1,90 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunmatrix_band.h) contains the + * implementation needed for the Fortran initialization of band + * vector operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fsunmatrix_band.h" + +/* Define global matrix variables */ + +SUNMatrix F2C_CVODE_matrix; +SUNMatrix F2C_IDA_matrix; +SUNMatrix F2C_KINSOL_matrix; +SUNMatrix F2C_ARKODE_matrix; +SUNMatrix F2C_ARKODE_mass_matrix; + +/* Fortran callable interfaces */ + +void FSUNBANDMAT_INIT(int *code, long int *N, long int *mu, + long int *ml, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (F2C_CVODE_matrix) SUNMatDestroy(F2C_CVODE_matrix); + F2C_CVODE_matrix = NULL; + F2C_CVODE_matrix = SUNBandMatrix((sunindextype)(*N), + (sunindextype)(*mu), + (sunindextype)(*ml)); + if (F2C_CVODE_matrix == NULL) *ier = -1; + break; + case FCMIX_IDA: + if (F2C_IDA_matrix) SUNMatDestroy(F2C_IDA_matrix); + F2C_IDA_matrix = NULL; + F2C_IDA_matrix = SUNBandMatrix((sunindextype)(*N), + (sunindextype)(*mu), + (sunindextype)(*ml)); + if (F2C_IDA_matrix == NULL) *ier = -1; + break; + case FCMIX_KINSOL: + if (F2C_KINSOL_matrix) SUNMatDestroy(F2C_KINSOL_matrix); + F2C_KINSOL_matrix = NULL; + F2C_KINSOL_matrix = SUNBandMatrix((sunindextype)(*N), + (sunindextype)(*mu), + (sunindextype)(*ml)); + if (F2C_KINSOL_matrix == NULL) *ier = -1; + break; + case FCMIX_ARKODE: + if (F2C_ARKODE_matrix) SUNMatDestroy(F2C_ARKODE_matrix); + F2C_ARKODE_matrix = NULL; + F2C_ARKODE_matrix = SUNBandMatrix((sunindextype)(*N), + (sunindextype)(*mu), + (sunindextype)(*ml)); + if (F2C_ARKODE_matrix == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + + +void FSUNBANDMASSMAT_INIT(long int *N, long int *mu, + long int *ml, int *ier) +{ + *ier = 0; + if (F2C_ARKODE_mass_matrix) SUNMatDestroy(F2C_ARKODE_mass_matrix); + F2C_ARKODE_mass_matrix = NULL; + F2C_ARKODE_mass_matrix = SUNBandMatrix((sunindextype)(*N), + (sunindextype)(*mu), + (sunindextype)(*ml)); + if (F2C_ARKODE_mass_matrix == NULL) *ier = -1; +} diff --git a/bazaar/plugin/sundials/src/sunmatrix/band/fsunmatrix_band.h b/bazaar/plugin/sundials/src/sunmatrix/band/fsunmatrix_band.h new file mode 100644 index 000000000..18d912807 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunmatrix/band/fsunmatrix_band.h @@ -0,0 +1,62 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunmatrix_band.c) contains the + * definitions needed for the initialization of band + * matrix operations in Fortran. + * ----------------------------------------------------------------- + */ + +#ifndef _FSUNMATRIX_BAND_H +#define _FSUNMATRIX_BAND_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#if defined(SUNDIALS_F77_FUNC) +#define FSUNBANDMAT_INIT SUNDIALS_F77_FUNC(fsunbandmatinit, FSUNBANDMATINIT) +#define FSUNBANDMASSMAT_INIT SUNDIALS_F77_FUNC(fsunbandmassmatinit, FSUNBANDMASSMATINIT) +#else +#define FSUNBANDMAT_INIT fsunbandmatinit_ +#define FSUNBANDMASSMAT_INIT fsunbandmassmatinit_ +#endif + + +/* Declarations of global variables */ + +extern SUNMatrix F2C_CVODE_matrix; +extern SUNMatrix F2C_IDA_matrix; +extern SUNMatrix F2C_KINSOL_matrix; +extern SUNMatrix F2C_ARKODE_matrix; +extern SUNMatrix F2C_ARKODE_mass_matrix; + +/* + * Prototypes of exported functions + * + * FSUNBANDMAT_INIT - initializes band matrix operations for main problem + * FSUNBANDMASSMAT_INIT - initializes band matrix operations for mass matrix solve + */ + +void FSUNBANDMAT_INIT(int *code, long int *N, long int *mu, long int *ml, int *ier); +void FSUNBANDMASSMAT_INIT(long int *N, long int *mu, long int *ml, int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/sunmatrix/band/sunmatrix_band.c b/bazaar/plugin/sundials/src/sunmatrix/band/sunmatrix_band.c new file mode 100644 index 000000000..b6d902104 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunmatrix/band/sunmatrix_band.c @@ -0,0 +1,489 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * David Gardner @ LLNL + * Based on code sundials_band.c by: Alan C. Hindmarsh and + * Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for the band implementation of + * the SUNMATRIX package. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + + +/* Private function prototypes */ +static booleantype SMCompatible_Band(SUNMatrix A, SUNMatrix B); +static booleantype SMCompatible2_Band(SUNMatrix A, N_Vector x, N_Vector y); +static int SMScaleAddNew_Band(realtype c, SUNMatrix A, SUNMatrix B); + + +/* + * ----------------------------------------------------------------- + * exported functions + * ----------------------------------------------------------------- + */ + +/* ---------------------------------------------------------------------------- + * Function to create a new band matrix with default storage upper bandwidth + */ + +SUNMatrix SUNBandMatrix(sunindextype N, sunindextype mu, sunindextype ml) +{ + return (SUNBandMatrixStorage(N, mu, ml, mu+ml)); +} + +/* ---------------------------------------------------------------------------- + * Function to create a new band matrix with specified storage upper bandwidth + */ + +SUNMatrix SUNBandMatrixStorage(sunindextype N, sunindextype mu, + sunindextype ml, sunindextype smu) +{ + SUNMatrix A; + SUNMatrixContent_Band content; + sunindextype j, colSize; + + /* return with NULL matrix on illegal dimension input */ + if ( (N <= 0) || (smu < 0) || (ml < 0) ) return(NULL); + + /* Create an empty matrix object */ + A = NULL; + A = SUNMatNewEmpty(); + if (A == NULL) return(NULL); + + /* Attach operations */ + A->ops->getid = SUNMatGetID_Band; + A->ops->clone = SUNMatClone_Band; + A->ops->destroy = SUNMatDestroy_Band; + A->ops->zero = SUNMatZero_Band; + A->ops->copy = SUNMatCopy_Band; + A->ops->scaleadd = SUNMatScaleAdd_Band; + A->ops->scaleaddi = SUNMatScaleAddI_Band; + A->ops->matvec = SUNMatMatvec_Band; + A->ops->space = SUNMatSpace_Band; + + /* Create content */ + content = NULL; + content = (SUNMatrixContent_Band) malloc(sizeof *content); + if (content == NULL) { SUNMatDestroy(A); return(NULL); } + + /* Attach content */ + A->content = content; + + /* Fill content */ + colSize = smu + ml + 1; + content->M = N; + content->N = N; + content->mu = mu; + content->ml = ml; + content->s_mu = smu; + content->ldim = colSize; + content->ldata = N * colSize; + content->data = NULL; + content->cols = NULL; + + /* Allocate content */ + content->data = (realtype *) calloc(N * colSize, sizeof(realtype)); + if (content->data == NULL) { SUNMatDestroy(A); return(NULL); } + + content->cols = (realtype **) malloc(N * sizeof(realtype *)); + if (content->cols == NULL) { SUNMatDestroy(A); return(NULL); } + for (j=0; jcols[j] = content->data + j * colSize; + + return(A); +} + +/* ---------------------------------------------------------------------------- + * Function to print the band matrix + */ + +void SUNBandMatrix_Print(SUNMatrix A, FILE* outfile) +{ + sunindextype i, j, start, finish; + + /* should not be called unless A is a band matrix; + otherwise return immediately */ + if (SUNMatGetID(A) != SUNMATRIX_BAND) + return; + + /* perform operation */ + fprintf(outfile,"\n"); + for (i=0; icontent != NULL) { + /* free data array */ + if (SM_DATA_B(A)) { + free(SM_DATA_B(A)); + SM_DATA_B(A) = NULL; + } + /* free column pointers */ + if (SM_COLS_B(A)) { + free(SM_COLS_B(A)); + SM_COLS_B(A) = NULL; + } + /* free content struct */ + free(A->content); + A->content = NULL; + } + + /* free ops and matrix */ + if (A->ops) { free(A->ops); A->ops = NULL; } + free(A); A = NULL; + + return; +} + +int SUNMatZero_Band(SUNMatrix A) +{ + sunindextype i; + realtype *Adata; + + /* Verify that A is a band matrix */ + if (SUNMatGetID(A) != SUNMATRIX_BAND) + return SUNMAT_ILL_INPUT; + + /* Perform operation */ + Adata = SM_DATA_B(A); + for (i=0; i SM_UBAND_B(B)) || + (SM_LBAND_B(A) > SM_LBAND_B(B)) ) { + ml = SUNMAX(SM_LBAND_B(B),SM_LBAND_B(A)); + mu = SUNMAX(SM_UBAND_B(B),SM_UBAND_B(A)); + smu = SUNMAX(SM_SUBAND_B(B),SM_SUBAND_B(A)); + colSize = smu + ml + 1; + SM_CONTENT_B(B)->mu = mu; + SM_CONTENT_B(B)->ml = ml; + SM_CONTENT_B(B)->s_mu = smu; + SM_CONTENT_B(B)->ldim = colSize; + SM_CONTENT_B(B)->ldata = SM_COLUMNS_B(B) * colSize; + SM_CONTENT_B(B)->data = (realtype *) + realloc(SM_CONTENT_B(B)->data, SM_COLUMNS_B(B) * colSize*sizeof(realtype)); + for (j=0; jcols[j] = SM_CONTENT_B(B)->data + j * colSize; + } + + /* Perform operation */ + if (SUNMatZero_Band(B) != SUNMAT_SUCCESS) + return SUNMAT_OPERATION_FAIL; + for (j=0; j SM_UBAND_B(A)) || + (SM_LBAND_B(B) > SM_LBAND_B(A)) ) { + return SMScaleAddNew_Band(c,A,B); + } + + /* Otherwise, perform operation in-place */ + for (j=0; jcontent); A->content = NULL; + A->content = C->content; + C->content = NULL; + SUNMatDestroy_Band(C); + + return SUNMAT_SUCCESS; +} + diff --git a/bazaar/plugin/sundials/src/sunmatrix/dense/fmod/fsunmatrix_dense_mod.c b/bazaar/plugin/sundials/src/sunmatrix/dense/fmod/fsunmatrix_dense_mod.c new file mode 100644 index 000000000..dee5c7cf6 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunmatrix/dense/fmod/fsunmatrix_dense_mod.c @@ -0,0 +1,429 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ + +/* --------------------------------------------------------------- + * Programmer(s): Auto-generated by swig. + * --------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * -------------------------------------------------------------*/ + +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_matrix.h" + + +#include "sunmatrix/sunmatrix_dense.h" + +SWIGEXPORT SUNMatrix _wrap_FSUNDenseMatrix(int64_t const *farg1, int64_t const *farg2) { + SUNMatrix fresult ; + sunindextype arg1 ; + sunindextype arg2 ; + SUNMatrix result; + + arg1 = (sunindextype)(*farg1); + arg2 = (sunindextype)(*farg2); + result = (SUNMatrix)SUNDenseMatrix(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FSUNDenseMatrix_Print(SUNMatrix farg1, void *farg2) { + SUNMatrix arg1 = (SUNMatrix) 0 ; + FILE *arg2 = (FILE *) 0 ; + + arg1 = (SUNMatrix)(farg1); + arg2 = (FILE *)(farg2); + SUNDenseMatrix_Print(arg1,arg2); +} + + +SWIGEXPORT int64_t _wrap_FSUNDenseMatrix_Rows(SUNMatrix farg1) { + int64_t fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype result; + + arg1 = (SUNMatrix)(farg1); + result = SUNDenseMatrix_Rows(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNDenseMatrix_Columns(SUNMatrix farg1) { + int64_t fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype result; + + arg1 = (SUNMatrix)(farg1); + result = SUNDenseMatrix_Columns(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNDenseMatrix_LData(SUNMatrix farg1) { + int64_t fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype result; + + arg1 = (SUNMatrix)(farg1); + result = SUNDenseMatrix_LData(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT double * _wrap_FSUNDenseMatrix_Data(SUNMatrix farg1) { + double * fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + realtype *result = 0 ; + + arg1 = (SUNMatrix)(farg1); + result = (realtype *)SUNDenseMatrix_Data(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT void * _wrap_FSUNDenseMatrix_Cols(SUNMatrix farg1) { + void * fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + realtype **result = 0 ; + + arg1 = (SUNMatrix)(farg1); + result = (realtype **)SUNDenseMatrix_Cols(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT double * _wrap_FSUNDenseMatrix_Column(SUNMatrix farg1, int64_t const *farg2) { + double * fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype arg2 ; + realtype *result = 0 ; + + arg1 = (SUNMatrix)(farg1); + arg2 = (sunindextype)(*farg2); + result = (realtype *)SUNDenseMatrix_Column(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatGetID_Dense(SUNMatrix farg1) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + SUNMatrix_ID result; + + arg1 = (SUNMatrix)(farg1); + result = (SUNMatrix_ID)SUNMatGetID_Dense(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SUNMatrix _wrap_FSUNMatClone_Dense(SUNMatrix farg1) { + SUNMatrix fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + SUNMatrix result; + + arg1 = (SUNMatrix)(farg1); + result = (SUNMatrix)SUNMatClone_Dense(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FSUNMatDestroy_Dense(SUNMatrix farg1) { + SUNMatrix arg1 = (SUNMatrix) 0 ; + + arg1 = (SUNMatrix)(farg1); + SUNMatDestroy_Dense(arg1); +} + + +SWIGEXPORT int _wrap_FSUNMatZero_Dense(SUNMatrix farg1) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + result = (int)SUNMatZero_Dense(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatCopy_Dense(SUNMatrix farg1, SUNMatrix farg2) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNMatCopy_Dense(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatScaleAdd_Dense(double const *farg1, SUNMatrix farg2, SUNMatrix farg3) { + int fresult ; + realtype arg1 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + SUNMatrix arg3 = (SUNMatrix) 0 ; + int result; + + arg1 = (realtype)(*farg1); + arg2 = (SUNMatrix)(farg2); + arg3 = (SUNMatrix)(farg3); + result = (int)SUNMatScaleAdd_Dense(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatScaleAddI_Dense(double const *farg1, SUNMatrix farg2) { + int fresult ; + realtype arg1 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (realtype)(*farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNMatScaleAddI_Dense(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatMatvec_Dense(SUNMatrix farg1, N_Vector farg2, N_Vector farg3) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)SUNMatMatvec_Dense(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatSpace_Dense(SUNMatrix farg1, long *farg2, long *farg3) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)SUNMatSpace_Dense(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/sunmatrix/dense/fsunmatrix_dense.c b/bazaar/plugin/sundials/src/sunmatrix/dense/fsunmatrix_dense.c new file mode 100644 index 000000000..b33bf738a --- /dev/null +++ b/bazaar/plugin/sundials/src/sunmatrix/dense/fsunmatrix_dense.c @@ -0,0 +1,83 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunmatrix_dense.h) contains the + * implementation needed for the Fortran initialization of dense + * vector operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fsunmatrix_dense.h" + +/* Define global matrix variables */ + +SUNMatrix F2C_CVODE_matrix; +SUNMatrix F2C_IDA_matrix; +SUNMatrix F2C_KINSOL_matrix; +SUNMatrix F2C_ARKODE_matrix; +SUNMatrix F2C_ARKODE_mass_matrix; + +/* Fortran callable interfaces */ + +void FSUNDENSEMAT_INIT(int *code, long int *M, long int *N, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (F2C_CVODE_matrix) SUNMatDestroy(F2C_CVODE_matrix); + F2C_CVODE_matrix = NULL; + F2C_CVODE_matrix = SUNDenseMatrix((sunindextype)(*M), + (sunindextype)(*N)); + if (F2C_CVODE_matrix == NULL) *ier = -1; + break; + case FCMIX_IDA: + if (F2C_IDA_matrix) SUNMatDestroy(F2C_IDA_matrix); + F2C_IDA_matrix = NULL; + F2C_IDA_matrix = SUNDenseMatrix((sunindextype)(*M), + (sunindextype)(*N)); + if (F2C_IDA_matrix == NULL) *ier = -1; + break; + case FCMIX_KINSOL: + if (F2C_KINSOL_matrix) SUNMatDestroy(F2C_KINSOL_matrix); + F2C_KINSOL_matrix = NULL; + F2C_KINSOL_matrix = SUNDenseMatrix((sunindextype)(*M), + (sunindextype)(*N)); + if (F2C_KINSOL_matrix == NULL) *ier = -1; + break; + case FCMIX_ARKODE: + if (F2C_ARKODE_matrix) SUNMatDestroy(F2C_ARKODE_matrix); + F2C_ARKODE_matrix = NULL; + F2C_ARKODE_matrix = SUNDenseMatrix((sunindextype)(*M), + (sunindextype)(*N)); + if (F2C_ARKODE_matrix == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + + +void FSUNDENSEMASSMAT_INIT(long int *M, long int *N, int *ier) +{ + *ier = 0; + if (F2C_ARKODE_mass_matrix) SUNMatDestroy(F2C_ARKODE_mass_matrix); + F2C_ARKODE_mass_matrix = NULL; + F2C_ARKODE_mass_matrix = SUNDenseMatrix((sunindextype)(*M), + (sunindextype)(*N)); + if (F2C_ARKODE_mass_matrix == NULL) *ier = -1; +} diff --git a/bazaar/plugin/sundials/src/sunmatrix/dense/fsunmatrix_dense.h b/bazaar/plugin/sundials/src/sunmatrix/dense/fsunmatrix_dense.h new file mode 100644 index 000000000..a218acb88 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunmatrix/dense/fsunmatrix_dense.h @@ -0,0 +1,62 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunmatrix_dense.c) contains the + * definitions needed for the initialization of dense + * matrix operations in Fortran. + * ----------------------------------------------------------------- + */ + +#ifndef _FSUNMATRIX_DENSE_H +#define _FSUNMATRIX_DENSE_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#if defined(SUNDIALS_F77_FUNC) +#define FSUNDENSEMAT_INIT SUNDIALS_F77_FUNC(fsundensematinit, FSUNDENSEMATINIT) +#define FSUNDENSEMASSMAT_INIT SUNDIALS_F77_FUNC(fsundensemassmatinit, FSUNDENSEMASSMATINIT) +#else +#define FSUNDENSEMAT_INIT fsundensematinit_ +#define FSUNDENSEMASSMAT_INIT fsundensemassmatinit_ +#endif + + +/* Declarations of global variables */ + +extern SUNMatrix F2C_CVODE_matrix; +extern SUNMatrix F2C_IDA_matrix; +extern SUNMatrix F2C_KINSOL_matrix; +extern SUNMatrix F2C_ARKODE_matrix; +extern SUNMatrix F2C_ARKODE_mass_matrix; + +/* + * Prototypes of exported functions + * + * FSUNDENSEMAT_INIT - initializes dense matrix operations for main problem + * FSUNDENSEMASSMAT_INIT - initializes dense matrix operations for mass matrix solver + */ + +void FSUNDENSEMAT_INIT(int *code, long int *M, long int *N, int *ier); +void FSUNDENSEMASSMAT_INIT(long int *M, long int *N, int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/sunmatrix/dense/sunmatrix_dense.c b/bazaar/plugin/sundials/src/sunmatrix/dense/sunmatrix_dense.c new file mode 100644 index 000000000..970ab0e87 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunmatrix/dense/sunmatrix_dense.c @@ -0,0 +1,355 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * David Gardner @ LLNL + * Based on code sundials_dense.c by: Scott D. Cohen, + * Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for the dense implementation of + * the SUNMATRIX package. + * -----------------------------------------------------------------*/ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + + +/* Private function prototypes */ +static booleantype SMCompatible_Dense(SUNMatrix A, SUNMatrix B); +static booleantype SMCompatible2_Dense(SUNMatrix A, N_Vector x, N_Vector y); + + +/* + * ----------------------------------------------------------------- + * exported functions + * ----------------------------------------------------------------- + */ + +/* ---------------------------------------------------------------------------- + * Function to create a new dense matrix + */ + +SUNMatrix SUNDenseMatrix(sunindextype M, sunindextype N) +{ + SUNMatrix A; + SUNMatrixContent_Dense content; + sunindextype j; + + /* return with NULL matrix on illegal dimension input */ + if ( (M <= 0) || (N <= 0) ) return(NULL); + + /* Create an empty matrix object */ + A = NULL; + A = SUNMatNewEmpty(); + if (A == NULL) return(NULL); + + /* Attach operations */ + A->ops->getid = SUNMatGetID_Dense; + A->ops->clone = SUNMatClone_Dense; + A->ops->destroy = SUNMatDestroy_Dense; + A->ops->zero = SUNMatZero_Dense; + A->ops->copy = SUNMatCopy_Dense; + A->ops->scaleadd = SUNMatScaleAdd_Dense; + A->ops->scaleaddi = SUNMatScaleAddI_Dense; + A->ops->matvec = SUNMatMatvec_Dense; + A->ops->space = SUNMatSpace_Dense; + + /* Create content */ + content = NULL; + content = (SUNMatrixContent_Dense) malloc(sizeof *content); + if (content == NULL) { SUNMatDestroy(A); return(NULL); } + + /* Attach content */ + A->content = content; + + /* Fill content */ + content->M = M; + content->N = N; + content->ldata = M*N; + content->data = NULL; + content->cols = NULL; + + /* Allocate content */ + content->data = (realtype *) calloc(M * N, sizeof(realtype)); + if (content->data == NULL) { SUNMatDestroy(A); return(NULL); } + + content->cols = (realtype **) malloc(N * sizeof(realtype *)); + if (content->cols == NULL) { SUNMatDestroy(A); return(NULL); } + for (j=0; jcols[j] = content->data + j * M; + + return(A); +} + + +/* ---------------------------------------------------------------------------- + * Function to print the dense matrix + */ + +void SUNDenseMatrix_Print(SUNMatrix A, FILE* outfile) +{ + sunindextype i, j; + + /* should not be called unless A is a dense matrix; + otherwise return immediately */ + if (SUNMatGetID(A) != SUNMATRIX_DENSE) + return; + + /* perform operation */ + fprintf(outfile,"\n"); + for (i=0; icontent != NULL) { + /* free data array */ + if (SM_DATA_D(A) != NULL) { + free(SM_DATA_D(A)); + SM_DATA_D(A) = NULL; + } + /* free column pointers */ + if (SM_CONTENT_D(A)->cols != NULL) { + free(SM_CONTENT_D(A)->cols); + SM_CONTENT_D(A)->cols = NULL; + } + /* free content struct */ + free(A->content); + A->content = NULL; + } + + /* free ops and matrix */ + if (A->ops) { free(A->ops); A->ops = NULL; } + free(A); A = NULL; + + return; +} + +int SUNMatZero_Dense(SUNMatrix A) +{ + sunindextype i; + realtype *Adata; + + /* Perform operation */ + Adata = SM_DATA_D(A); + for (i=0; i 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_matrix.h" + + +#include "sunmatrix/sunmatrix_sparse.h" + +SWIGEXPORT SUNMatrix _wrap_FSUNSparseMatrix(int64_t const *farg1, int64_t const *farg2, int64_t const *farg3, int const *farg4) { + SUNMatrix fresult ; + sunindextype arg1 ; + sunindextype arg2 ; + sunindextype arg3 ; + int arg4 ; + SUNMatrix result; + + arg1 = (sunindextype)(*farg1); + arg2 = (sunindextype)(*farg2); + arg3 = (sunindextype)(*farg3); + arg4 = (int)(*farg4); + result = (SUNMatrix)SUNSparseMatrix(arg1,arg2,arg3,arg4); + fresult = result; + return fresult; +} + + +SWIGEXPORT SUNMatrix _wrap_FSUNSparseFromDenseMatrix(SUNMatrix farg1, double const *farg2, int const *farg3) { + SUNMatrix fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + realtype arg2 ; + int arg3 ; + SUNMatrix result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (int)(*farg3); + result = (SUNMatrix)SUNSparseFromDenseMatrix(arg1,arg2,arg3); + fresult = result; + return fresult; +} + + +SWIGEXPORT SUNMatrix _wrap_FSUNSparseFromBandMatrix(SUNMatrix farg1, double const *farg2, int const *farg3) { + SUNMatrix fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + realtype arg2 ; + int arg3 ; + SUNMatrix result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (int)(*farg3); + result = (SUNMatrix)SUNSparseFromBandMatrix(arg1,arg2,arg3); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNSparseMatrix_ToCSR(SUNMatrix farg1, void *farg2) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) (SUNMatrix)0 ; + SUNMatrix *arg2 = (SUNMatrix *) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (SUNMatrix *)(farg2); + result = (int)SUNSparseMatrix_ToCSR(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNSparseMatrix_ToCSC(SUNMatrix farg1, void *farg2) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) (SUNMatrix)0 ; + SUNMatrix *arg2 = (SUNMatrix *) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (SUNMatrix *)(farg2); + result = (int)SUNSparseMatrix_ToCSC(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNSparseMatrix_Realloc(SUNMatrix farg1) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + result = (int)SUNSparseMatrix_Realloc(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNSparseMatrix_Reallocate(SUNMatrix farg1, int64_t const *farg2) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype arg2 ; + int result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (sunindextype)(*farg2); + result = (int)SUNSparseMatrix_Reallocate(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_FSUNSparseMatrix_Print(SUNMatrix farg1, void *farg2) { + SUNMatrix arg1 = (SUNMatrix) 0 ; + FILE *arg2 = (FILE *) 0 ; + + arg1 = (SUNMatrix)(farg1); + arg2 = (FILE *)(farg2); + SUNSparseMatrix_Print(arg1,arg2); +} + + +SWIGEXPORT int64_t _wrap_FSUNSparseMatrix_Rows(SUNMatrix farg1) { + int64_t fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype result; + + arg1 = (SUNMatrix)(farg1); + result = SUNSparseMatrix_Rows(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNSparseMatrix_Columns(SUNMatrix farg1) { + int64_t fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype result; + + arg1 = (SUNMatrix)(farg1); + result = SUNSparseMatrix_Columns(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNSparseMatrix_NNZ(SUNMatrix farg1) { + int64_t fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype result; + + arg1 = (SUNMatrix)(farg1); + result = SUNSparseMatrix_NNZ(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int64_t _wrap_FSUNSparseMatrix_NP(SUNMatrix farg1) { + int64_t fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype result; + + arg1 = (SUNMatrix)(farg1); + result = SUNSparseMatrix_NP(arg1); + fresult = (sunindextype)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNSparseMatrix_SparseType(SUNMatrix farg1) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + result = (int)SUNSparseMatrix_SparseType(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT double * _wrap_FSUNSparseMatrix_Data(SUNMatrix farg1) { + double * fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + realtype *result = 0 ; + + arg1 = (SUNMatrix)(farg1); + result = (realtype *)SUNSparseMatrix_Data(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT int64_t * _wrap_FSUNSparseMatrix_IndexValues(SUNMatrix farg1) { + int64_t * fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype *result = 0 ; + + arg1 = (SUNMatrix)(farg1); + result = (sunindextype *)SUNSparseMatrix_IndexValues(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT int64_t * _wrap_FSUNSparseMatrix_IndexPointers(SUNMatrix farg1) { + int64_t * fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + sunindextype *result = 0 ; + + arg1 = (SUNMatrix)(farg1); + result = (sunindextype *)SUNSparseMatrix_IndexPointers(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatGetID_Sparse(SUNMatrix farg1) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + SUNMatrix_ID result; + + arg1 = (SUNMatrix)(farg1); + result = (SUNMatrix_ID)SUNMatGetID_Sparse(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SUNMatrix _wrap_FSUNMatClone_Sparse(SUNMatrix farg1) { + SUNMatrix fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + SUNMatrix result; + + arg1 = (SUNMatrix)(farg1); + result = (SUNMatrix)SUNMatClone_Sparse(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FSUNMatDestroy_Sparse(SUNMatrix farg1) { + SUNMatrix arg1 = (SUNMatrix) 0 ; + + arg1 = (SUNMatrix)(farg1); + SUNMatDestroy_Sparse(arg1); +} + + +SWIGEXPORT int _wrap_FSUNMatZero_Sparse(SUNMatrix farg1) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + result = (int)SUNMatZero_Sparse(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatCopy_Sparse(SUNMatrix farg1, SUNMatrix farg2) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNMatCopy_Sparse(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatScaleAdd_Sparse(double const *farg1, SUNMatrix farg2, SUNMatrix farg3) { + int fresult ; + realtype arg1 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + SUNMatrix arg3 = (SUNMatrix) 0 ; + int result; + + arg1 = (realtype)(*farg1); + arg2 = (SUNMatrix)(farg2); + arg3 = (SUNMatrix)(farg3); + result = (int)SUNMatScaleAdd_Sparse(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatScaleAddI_Sparse(double const *farg1, SUNMatrix farg2) { + int fresult ; + realtype arg1 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + int result; + + arg1 = (realtype)(*farg1); + arg2 = (SUNMatrix)(farg2); + result = (int)SUNMatScaleAddI_Sparse(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatMatvec_Sparse(SUNMatrix farg1, N_Vector farg2, N_Vector farg3) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)SUNMatMatvec_Sparse(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNMatSpace_Sparse(SUNMatrix farg1, long *farg2, long *farg3) { + int fresult ; + SUNMatrix arg1 = (SUNMatrix) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)SUNMatSpace_Sparse(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/sunmatrix/sparse/fsunmatrix_sparse.c b/bazaar/plugin/sundials/src/sunmatrix/sparse/fsunmatrix_sparse.c new file mode 100644 index 000000000..5e2825f3d --- /dev/null +++ b/bazaar/plugin/sundials/src/sunmatrix/sparse/fsunmatrix_sparse.c @@ -0,0 +1,94 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunmatrix_sparse.h) contains the + * implementation needed for the Fortran initialization of sparse + * vector operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fsunmatrix_sparse.h" + +/* Define global matrix variables */ + +SUNMatrix F2C_CVODE_matrix; +SUNMatrix F2C_IDA_matrix; +SUNMatrix F2C_KINSOL_matrix; +SUNMatrix F2C_ARKODE_matrix; +SUNMatrix F2C_ARKODE_mass_matrix; + +/* Fortran callable interfaces */ + +void FSUNSPARSEMAT_INIT(int *code, long int *M, long int *N, + long int *NNZ, int *sparsetype, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (F2C_CVODE_matrix) SUNMatDestroy(F2C_CVODE_matrix); + F2C_CVODE_matrix = NULL; + F2C_CVODE_matrix = SUNSparseMatrix((sunindextype)(*M), + (sunindextype)(*N), + (sunindextype)(*NNZ), + *sparsetype); + if (F2C_CVODE_matrix == NULL) *ier = -1; + break; + case FCMIX_IDA: + if (F2C_IDA_matrix) SUNMatDestroy(F2C_IDA_matrix); + F2C_IDA_matrix = NULL; + F2C_IDA_matrix = SUNSparseMatrix((sunindextype)(*M), + (sunindextype)(*N), + (sunindextype)(*NNZ), + *sparsetype); + if (F2C_IDA_matrix == NULL) *ier = -1; + break; + case FCMIX_KINSOL: + if (F2C_KINSOL_matrix) SUNMatDestroy(F2C_KINSOL_matrix); + F2C_KINSOL_matrix = NULL; + F2C_KINSOL_matrix = SUNSparseMatrix((sunindextype)(*M), + (sunindextype)(*N), + (sunindextype)(*NNZ), + *sparsetype); + if (F2C_KINSOL_matrix == NULL) *ier = -1; + break; + case FCMIX_ARKODE: + if (F2C_ARKODE_matrix) SUNMatDestroy(F2C_ARKODE_matrix); + F2C_ARKODE_matrix = NULL; + F2C_ARKODE_matrix = SUNSparseMatrix((sunindextype)(*M), + (sunindextype)(*N), + (sunindextype)(*NNZ), + *sparsetype); + if (F2C_ARKODE_matrix == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FSUNSPARSEMASSMAT_INIT(long int *M, long int *N, long int *NNZ, + int *sparsetype, int *ier) +{ + *ier = 0; + if (F2C_ARKODE_mass_matrix) SUNMatDestroy(F2C_ARKODE_mass_matrix); + F2C_ARKODE_mass_matrix = NULL; + F2C_ARKODE_mass_matrix = SUNSparseMatrix((sunindextype)(*M), + (sunindextype)(*N), + (sunindextype)(*NNZ), + *sparsetype); + if (F2C_ARKODE_mass_matrix == NULL) *ier = -1; +} diff --git a/bazaar/plugin/sundials/src/sunmatrix/sparse/fsunmatrix_sparse.h b/bazaar/plugin/sundials/src/sunmatrix/sparse/fsunmatrix_sparse.h new file mode 100644 index 000000000..79bde1220 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunmatrix/sparse/fsunmatrix_sparse.h @@ -0,0 +1,65 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This file (companion of fsunmatrix_sparse.c) contains the + * definitions needed for the initialization of sparse + * matrix operations in Fortran. + * ----------------------------------------------------------------- + */ + +#ifndef _FSUNMATRIX_SPARSE_H +#define _FSUNMATRIX_SPARSE_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#if defined(SUNDIALS_F77_FUNC) +#define FSUNSPARSEMAT_INIT SUNDIALS_F77_FUNC(fsunsparsematinit, FSUNSPARSEMATINIT) +#define FSUNSPARSEMASSMAT_INIT SUNDIALS_F77_FUNC(fsunsparsemassmatinit, FSUNSPARSEMASSMATINIT) +#else +#define FSUNSPARSEMAT_INIT fsunsparsematinit_ +#define FSUNSPARSEMASSMAT_INIT fsunsparsemassmatinit_ +#endif + + +/* Declarations of global variables */ + +extern SUNMatrix F2C_CVODE_matrix; +extern SUNMatrix F2C_IDA_matrix; +extern SUNMatrix F2C_KINSOL_matrix; +extern SUNMatrix F2C_ARKODE_matrix; +extern SUNMatrix F2C_ARKODE_mass_matrix; + +/* + * Prototypes of exported functions + * + * FSUNSPARSEMAT_INIT - initializes sparse matrix operations for main problem + * FSUNSPARSEMASSMAT_INIT - initializes sparse matrix operations for mass matrix solve + */ + +void FSUNSPARSEMAT_INIT(int *code, long int *M, long int *N, + long int *NNZ, int *sparsetype, int *ier); + +void FSUNSPARSEMASSMAT_INIT(long int *M, long int *N, + long int *NNZ, int *sparsetype, int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/sunmatrix/sparse/sunmatrix_sparse.c b/bazaar/plugin/sundials/src/sunmatrix/sparse/sunmatrix_sparse.c new file mode 100644 index 000000000..4d5eb9d0f --- /dev/null +++ b/bazaar/plugin/sundials/src/sunmatrix/sparse/sunmatrix_sparse.c @@ -0,0 +1,1233 @@ +/* + * ----------------------------------------------------------------- + * Programmer(s): Daniel Reynolds @ SMU + * David Gardner @ LLNL + * Based on code sundials_sparse.c by: Carol Woodward and + * Slaven Peles @ LLNL, and Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the implementation file for the sparse implementation of + * the SUNMATRIX package. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* Private function prototypes */ +static booleantype SMCompatible_Sparse(SUNMatrix A, SUNMatrix B); +static booleantype SMCompatible2_Sparse(SUNMatrix A, N_Vector x, N_Vector y); +static int Matvec_SparseCSC(SUNMatrix A, N_Vector x, N_Vector y); +static int Matvec_SparseCSR(SUNMatrix A, N_Vector x, N_Vector y); +static int format_convert(const SUNMatrix A, SUNMatrix B); + +/* + * ----------------------------------------------------------------- + * exported functions + * ----------------------------------------------------------------- + */ + +/* + * ================================================================== + * Private function prototypes (functions working on SlsMat) + * ================================================================== + */ + +/* ---------------------------------------------------------------------------- + * Function to create a new sparse matrix + */ + +SUNMatrix SUNSparseMatrix(sunindextype M, sunindextype N, + sunindextype NNZ, int sparsetype) +{ + SUNMatrix A; + SUNMatrixContent_Sparse content; + + /* return with NULL matrix on illegal input */ + if ( (M <= 0) || (N <= 0) || (NNZ < 0) ) return(NULL); + if ( (sparsetype != CSC_MAT) && (sparsetype != CSR_MAT) ) return(NULL); + + /* Create an empty matrix object */ + A = NULL; + A = SUNMatNewEmpty(); + if (A == NULL) return(NULL); + + /* Attach operations */ + A->ops->getid = SUNMatGetID_Sparse; + A->ops->clone = SUNMatClone_Sparse; + A->ops->destroy = SUNMatDestroy_Sparse; + A->ops->zero = SUNMatZero_Sparse; + A->ops->copy = SUNMatCopy_Sparse; + A->ops->scaleadd = SUNMatScaleAdd_Sparse; + A->ops->scaleaddi = SUNMatScaleAddI_Sparse; + A->ops->matvec = SUNMatMatvec_Sparse; + A->ops->space = SUNMatSpace_Sparse; + + /* Create content */ + content = NULL; + content = (SUNMatrixContent_Sparse) malloc(sizeof *content); + if (content == NULL) { SUNMatDestroy(A); return(NULL); } + + /* Attach content */ + A->content = content; + + /* Fill content */ + content->sparsetype = sparsetype; + content->M = M; + content->N = N; + content->NNZ = NNZ; + switch(sparsetype){ + case CSC_MAT: + content->NP = N; + content->rowvals = &(content->indexvals); + content->colptrs = &(content->indexptrs); + /* CSR indices */ + content->colvals = NULL; + content->rowptrs = NULL; + break; + case CSR_MAT: + content->NP = M; + content->colvals = &(content->indexvals); + content->rowptrs = &(content->indexptrs); + /* CSC indices */ + content->rowvals = NULL; + content->colptrs = NULL; + } + content->data = NULL; + content->indexvals = NULL; + content->indexptrs = NULL; + + /* Allocate content */ + content->data = (realtype *) calloc(NNZ, sizeof(realtype)); + if (content->data == NULL) { SUNMatDestroy(A); return(NULL); } + + content->indexvals = (sunindextype *) calloc(NNZ, sizeof(sunindextype)); + if (content->indexvals == NULL) { SUNMatDestroy(A); return(NULL); } + + content->indexptrs = (sunindextype *) calloc((content->NP + 1), sizeof(sunindextype)); + if (content->indexptrs == NULL) { SUNMatDestroy(A); return(NULL); } + content->indexptrs[content->NP] = 0; + + return(A); +} + + + + +/* ---------------------------------------------------------------------------- + * Function to create a new sparse matrix from an existing dense matrix + * by copying all nonzero values into the sparse matrix structure. Returns NULL + * if the request for matrix storage cannot be satisfied. + */ + +SUNMatrix SUNSparseFromDenseMatrix(SUNMatrix Ad, realtype droptol, int sparsetype) +{ + sunindextype i, j, nnz; + sunindextype M, N; + SUNMatrix As; + + /* check for legal sparsetype, droptol and input matrix type */ + if ( (sparsetype != CSR_MAT) && (sparsetype != CSC_MAT) ) + return NULL; + if ( droptol < ZERO ) + return NULL; + if (SUNMatGetID(Ad) != SUNMATRIX_DENSE) + return NULL; + + /* set size of new matrix */ + M = SM_ROWS_D(Ad); + N = SM_COLUMNS_D(Ad); + + /* determine total number of nonzeros */ + nnz = 0; + for (j=0; j droptol); + + /* allocate sparse matrix */ + As = SUNSparseMatrix(M, N, nnz, sparsetype); + if (As == NULL) return NULL; + + /* copy nonzeros from Ad into As, based on CSR/CSC type */ + nnz = 0; + if (sparsetype == CSC_MAT) { + for (j=0; j droptol ) { + (SM_INDEXVALS_S(As))[nnz] = i; + (SM_DATA_S(As))[nnz++] = SM_ELEMENT_D(Ad,i,j); + } + } + } + (SM_INDEXPTRS_S(As))[N] = nnz; + } else { /* CSR_MAT */ + for (i=0; i droptol ) { + (SM_INDEXVALS_S(As))[nnz] = j; + (SM_DATA_S(As))[nnz++] = SM_ELEMENT_D(Ad,i,j); + } + } + } + (SM_INDEXPTRS_S(As))[M] = nnz; + } + + return(As); +} + + +/* ---------------------------------------------------------------------------- + * Function to create a new sparse matrix from an existing band matrix + * by copying all nonzero values into the sparse matrix structure. Returns NULL + * if the request for matrix storage cannot be satisfied. + */ + +SUNMatrix SUNSparseFromBandMatrix(SUNMatrix Ad, realtype droptol, int sparsetype) +{ + sunindextype i, j, nnz; + sunindextype M, N; + SUNMatrix As; + + /* check for legal sparsetype, droptol and input matrix type */ + if ( (sparsetype != CSR_MAT) && (sparsetype != CSC_MAT) ) + return NULL; + if ( droptol < ZERO ) + return NULL; + if (SUNMatGetID(Ad) != SUNMATRIX_BAND) + return NULL; + + /* set size of new matrix */ + M = SM_ROWS_B(Ad); + N = SM_COLUMNS_B(Ad); + + /* determine total number of nonzeros */ + nnz = 0; + for (j=0; j droptol); + + /* allocate sparse matrix */ + As = SUNSparseMatrix(M, N, nnz, sparsetype); + if (As == NULL) return NULL; + + /* copy nonzeros from Ad into As, based on CSR/CSC type */ + nnz = 0; + if (sparsetype == CSC_MAT) { + for (j=0; j droptol ) { + (SM_INDEXVALS_S(As))[nnz] = i; + (SM_DATA_S(As))[nnz++] = SM_ELEMENT_B(Ad,i,j); + } + } + } + (SM_INDEXPTRS_S(As))[N] = nnz; + } else { /* CSR_MAT */ + for (i=0; i droptol ) { + (SM_INDEXVALS_S(As))[nnz] = j; + (SM_DATA_S(As))[nnz++] = SM_ELEMENT_B(Ad,i,j); + } + } + } + (SM_INDEXPTRS_S(As))[M] = nnz; + } + + return(As); +} + + +/* ---------------------------------------------------------------------------- + * Function to create a new CSR matrix from a CSC matrix. + */ +int SUNSparseMatrix_ToCSR(const SUNMatrix A, SUNMatrix* Bout) +{ + if (A == NULL) return(SUNMAT_ILL_INPUT); + if (SM_SPARSETYPE_S(A) != CSC_MAT) return(SUNMAT_ILL_INPUT); + + *Bout = SUNSparseMatrix(SM_ROWS_S(A), SM_COLUMNS_S(A), SM_NNZ_S(A), CSR_MAT); + if (*Bout == NULL) return(SUNMAT_MEM_FAIL); + + return format_convert(A, *Bout); +} + + +/* ---------------------------------------------------------------------------- + * Function to create a new CSC matrix from a CSR matrix. + */ +int SUNSparseMatrix_ToCSC(const SUNMatrix A, SUNMatrix* Bout) +{ + if (A == NULL) return(SUNMAT_ILL_INPUT); + if (SM_SPARSETYPE_S(A) != CSR_MAT) return(SUNMAT_ILL_INPUT); + + *Bout = SUNSparseMatrix(SM_ROWS_S(A), SM_COLUMNS_S(A), SM_NNZ_S(A), CSC_MAT); + if (*Bout == NULL) return(SUNMAT_MEM_FAIL); + + return format_convert(A, *Bout); +} + + +/* ---------------------------------------------------------------------------- + * Function to reallocate internal sparse matrix storage arrays so that the + * resulting sparse matrix holds indexptrs[NP] nonzeros. Returns 0 on success + * and 1 on failure (e.g. if A does not have sparse type, or if nnz is negative) + */ + +int SUNSparseMatrix_Realloc(SUNMatrix A) +{ + sunindextype nzmax; + + /* check for valid matrix type */ + if (SUNMatGetID(A) != SUNMATRIX_SPARSE) + return SUNMAT_ILL_INPUT; + + /* get total number of nonzeros (return with failure if illegal) */ + nzmax = (SM_INDEXPTRS_S(A))[SM_NP_S(A)]; + if (nzmax < 0) return SUNMAT_ILL_INPUT; + + /* perform reallocation */ + SM_INDEXVALS_S(A) = (sunindextype *) realloc(SM_INDEXVALS_S(A), nzmax*sizeof(sunindextype)); + SM_DATA_S(A) = (realtype *) realloc(SM_DATA_S(A), nzmax*sizeof(realtype)); + SM_NNZ_S(A) = nzmax; + + return SUNMAT_SUCCESS; +} + + +/* ---------------------------------------------------------------------------- + * Function to reallocate internal sparse matrix storage arrays so that the + * resulting sparse matrix has storage for a specified number of nonzeros. + * Returns 0 on success and 1 on failure (e.g. if A does not have sparse type, + * or if nnz is negative) + */ + +int SUNSparseMatrix_Reallocate(SUNMatrix A, sunindextype NNZ) +{ + /* check for valid matrix type */ + if (SUNMatGetID(A) != SUNMATRIX_SPARSE) return SUNMAT_ILL_INPUT; + + /* check for valid nnz */ + if (NNZ < 0) return SUNMAT_ILL_INPUT; + + /* perform reallocation */ + SM_INDEXVALS_S(A) = (sunindextype *) realloc(SM_INDEXVALS_S(A), NNZ*sizeof(sunindextype)); + SM_DATA_S(A) = (realtype *) realloc(SM_DATA_S(A), NNZ*sizeof(realtype)); + SM_NNZ_S(A) = NNZ; + + return SUNMAT_SUCCESS; +} + + +/* ---------------------------------------------------------------------------- + * Function to print the sparse matrix + */ + +void SUNSparseMatrix_Print(SUNMatrix A, FILE* outfile) +{ + sunindextype i, j; + char *matrixtype; + char *indexname; + + /* should not be called unless A is a sparse matrix; + otherwise return immediately */ + if (SUNMatGetID(A) != SUNMATRIX_SPARSE) + return; + + /* perform operation */ + if (SM_SPARSETYPE_S(A) == CSC_MAT) { + indexname = (char*) "col"; + matrixtype = (char*) "CSC"; + } else { + indexname = (char*) "row"; + matrixtype = (char*) "CSR"; + } + fprintf(outfile, "\n"); + fprintf(outfile, "%ld by %ld %s matrix, NNZ: %ld \n", + (long int) SM_ROWS_S(A), (long int) SM_COLUMNS_S(A), + matrixtype, (long int) SM_NNZ_S(A)); + for (j=0; jcontent != NULL) { + /* free data array */ + if (SM_DATA_S(A)) { + free(SM_DATA_S(A)); + SM_DATA_S(A) = NULL; + } + /* free index values array */ + if (SM_INDEXVALS_S(A)) { + free(SM_INDEXVALS_S(A)); + SM_INDEXVALS_S(A) = NULL; + SM_CONTENT_S(A)->rowvals = NULL; + SM_CONTENT_S(A)->colvals = NULL; + } + /* free index pointers array */ + if (SM_INDEXPTRS_S(A)) { + free(SM_INDEXPTRS_S(A)); + SM_INDEXPTRS_S(A) = NULL; + SM_CONTENT_S(A)->colptrs = NULL; + SM_CONTENT_S(A)->rowptrs = NULL; + } + /* free content struct */ + free(A->content); + A->content = NULL; + } + + /* free ops and matrix */ + if (A->ops) { free(A->ops); A->ops = NULL; } + free(A); A = NULL; + + return; +} + +int SUNMatZero_Sparse(SUNMatrix A) +{ + sunindextype i; + + /* Perform operation */ + for (i=0; i (SM_NNZ_S(A) - Ap[N])) + newmat = SUNTRUE; + + + /* perform operation based on existing/necessary structure */ + + /* case 1: A already contains a diagonal */ + if (newvals == 0) { + + /* iterate through columns, adding 1.0 to diagonal */ + for (j=0; j < SUNMIN(M,N); j++) + for (i=Ap[j]; i=0; j--) { + + /* clear out temporary arrays for this column (row) */ + for (i=0; i=0; i--) { + if ( w[i] > 0 ) { + Ai[--nz] = i; + Ax[nz] = x[i]; + } + } + + /* store ptr past this col (row) from orig A, update value for new A */ + cend = Ap[j]; + Ap[j] = nz; + + } + + /* clean up */ + free(w); + free(x); + + + /* case 3: A must be reallocated with sufficient storage */ + } else { + + /* create work arrays for nonzero indices and values */ + w = (sunindextype *) malloc(M * sizeof(sunindextype)); + x = (realtype *) malloc(M * sizeof(realtype)); + + /* create new matrix for sum */ + C = SUNSparseMatrix(SM_ROWS_S(A), SM_COLUMNS_S(A), + Ap[N] + newvals, + SM_SPARSETYPE_S(A)); + + /* access data from CSR structures (return if failure) */ + Cp = Ci = NULL; + Cx = NULL; + if (SM_INDEXPTRS_S(C)) Cp = SM_INDEXPTRS_S(C); + else return (SUNMAT_MEM_FAIL); + if (SM_INDEXVALS_S(C)) Ci = SM_INDEXVALS_S(C); + else return (SUNMAT_MEM_FAIL); + if (SM_DATA_S(C)) Cx = SM_DATA_S(C); + else return (SUNMAT_MEM_FAIL); + + /* initialize total nonzero count */ + nz = 0; + + /* iterate through columns (rows for CSR) */ + for (j=0; j 0 ) { + Ci[nz] = i; + Cx[nz++] = x[i]; + } + } + } + + /* indicate end of data */ + Cp[N] = nz; + + /* update A's structure with C's values; nullify C's pointers */ + SM_NNZ_S(A) = SM_NNZ_S(C); + + if (SM_DATA_S(A)) + free(SM_DATA_S(A)); + SM_DATA_S(A) = SM_DATA_S(C); + SM_DATA_S(C) = NULL; + + if (SM_INDEXVALS_S(A)) + free(SM_INDEXVALS_S(A)); + SM_INDEXVALS_S(A) = SM_INDEXVALS_S(C); + SM_INDEXVALS_S(C) = NULL; + + if (SM_INDEXPTRS_S(A)) + free(SM_INDEXPTRS_S(A)); + SM_INDEXPTRS_S(A) = SM_INDEXPTRS_S(C); + SM_INDEXPTRS_S(C) = NULL; + + /* clean up */ + SUNMatDestroy_Sparse(C); + free(w); + free(x); + + } + return SUNMAT_SUCCESS; + +} + +int SUNMatScaleAdd_Sparse(realtype c, SUNMatrix A, SUNMatrix B) +{ + sunindextype j, i, p, nz, newvals, M, N, cend; + booleantype newmat; + sunindextype *w, *Ap, *Ai, *Bp, *Bi, *Cp, *Ci; + realtype *x, *Ax, *Bx, *Cx; + SUNMatrix C; + + /* Verify that A and B are compatible */ + if (!SMCompatible_Sparse(A, B)) + return SUNMAT_ILL_INPUT; + + /* store shortcuts to matrix dimensions (M is inner dimension, N is outer) */ + if (SM_SPARSETYPE_S(A) == CSC_MAT) { + M = SM_ROWS_S(A); + N = SM_COLUMNS_S(A); + } + else { + M = SM_COLUMNS_S(A); + N = SM_ROWS_S(A); + } + + /* access data arrays from A and B (return if failure) */ + Ap = Ai = Bp = Bi = NULL; + Ax = Bx = NULL; + if (SM_INDEXPTRS_S(A)) Ap = SM_INDEXPTRS_S(A); + else return(SUNMAT_MEM_FAIL); + if (SM_INDEXVALS_S(A)) Ai = SM_INDEXVALS_S(A); + else return(SUNMAT_MEM_FAIL); + if (SM_DATA_S(A)) Ax = SM_DATA_S(A); + else return(SUNMAT_MEM_FAIL); + if (SM_INDEXPTRS_S(B)) Bp = SM_INDEXPTRS_S(B); + else return(SUNMAT_MEM_FAIL); + if (SM_INDEXVALS_S(B)) Bi = SM_INDEXVALS_S(B); + else return(SUNMAT_MEM_FAIL); + if (SM_DATA_S(B)) Bx = SM_DATA_S(B); + else return(SUNMAT_MEM_FAIL); + + /* create work arrays for row indices and nonzero column values */ + w = (sunindextype *) malloc(M * sizeof(sunindextype)); + x = (realtype *) malloc(M * sizeof(realtype)); + + /* determine if A already contains the sparsity pattern of B */ + newvals = 0; + for (j=0; j (SM_NNZ_S(A) - Ap[N])) + newmat = SUNTRUE; + + /* perform operation based on existing/necessary structure */ + + /* case 1: A already contains sparsity pattern of B */ + if (newvals == 0) { + + /* iterate through columns, adding matrices */ + for (j=0; j=0; j--) { + + /* clear out temporary arrays for this column (row) */ + for (i=0; i=0; i--) { + if ( w[i] > 0 ) { + Ai[--nz] = i; + Ax[nz] = x[i]; + } + } + + /* store ptr past this col (row) from orig A, update value for new A */ + cend = Ap[j]; + Ap[j] = nz; + + } + + + /* case 3: A must be reallocated with sufficient storage */ + } else { + + + /* create new matrix for sum */ + C = SUNSparseMatrix(SM_ROWS_S(A), SM_COLUMNS_S(A), + Ap[N] + newvals, SM_SPARSETYPE_S(A)); + + /* access data from CSR structures (return if failure) */ + Cp = Ci = NULL; + Cx = NULL; + if (SM_INDEXPTRS_S(C)) Cp = SM_INDEXPTRS_S(C); + else return(SUNMAT_MEM_FAIL); + if (SM_INDEXVALS_S(C)) Ci = SM_INDEXVALS_S(C); + else return(SUNMAT_MEM_FAIL); + if (SM_DATA_S(C)) Cx = SM_DATA_S(C); + else return(SUNMAT_MEM_FAIL); + + /* initialize total nonzero count */ + nz = 0; + + /* iterate through columns (rows) */ + for (j=0; j 0 ) { + Ci[nz] = i; + Cx[nz++] = x[i]; + } + } + } + + /* indicate end of data */ + Cp[N] = nz; + + /* update A's structure with C's values; nullify C's pointers */ + SM_NNZ_S(A) = SM_NNZ_S(C); + + free(SM_DATA_S(A)); + SM_DATA_S(A) = SM_DATA_S(C); + SM_DATA_S(C) = NULL; + + free(SM_INDEXVALS_S(A)); + SM_INDEXVALS_S(A) = SM_INDEXVALS_S(C); + SM_INDEXVALS_S(C) = NULL; + + free(SM_INDEXPTRS_S(A)); + SM_INDEXPTRS_S(A) = SM_INDEXPTRS_S(C); + SM_INDEXPTRS_S(C) = NULL; + + /* clean up */ + SUNMatDestroy_Sparse(C); + + } + + /* clean up */ + free(w); + free(x); + + /* return success */ + return(0); + +} + +int SUNMatMatvec_Sparse(SUNMatrix A, N_Vector x, N_Vector y) +{ + /* Verify that A, x and y are compatible */ + if (!SMCompatible2_Sparse(A, x, y)) + return SUNMAT_ILL_INPUT; + + /* Perform operation */ + if(SM_SPARSETYPE_S(A) == CSC_MAT) + return Matvec_SparseCSC(A, x, y); + else + return Matvec_SparseCSR(A, x, y); +} + +int SUNMatSpace_Sparse(SUNMatrix A, long int *lenrw, long int *leniw) +{ + *lenrw = SM_NNZ_S(A); + *leniw = 10 + SM_NP_S(A) + SM_NNZ_S(A); + return SUNMAT_SUCCESS; +} + + +/* + * ================================================================= + * private functions + * ================================================================= + */ + +/* ----------------------------------------------------------------- + * Function to check compatibility of two sparse SUNMatrix objects + */ + +static booleantype SMCompatible_Sparse(SUNMatrix A, SUNMatrix B) +{ + /* both matrices must be sparse */ + if ( (SUNMatGetID(A) != SUNMATRIX_SPARSE) || + (SUNMatGetID(B) != SUNMATRIX_SPARSE) ) + return SUNFALSE; + + /* both matrices must have the same shape and sparsity type */ + if (SUNSparseMatrix_Rows(A) != SUNSparseMatrix_Rows(B)) + return SUNFALSE; + if (SUNSparseMatrix_Columns(A) != SUNSparseMatrix_Columns(B)) + return SUNFALSE; + if (SM_SPARSETYPE_S(A) != SM_SPARSETYPE_S(B)) + return SUNFALSE; + + return SUNTRUE; +} + + +/* ----------------------------------------------------------------- + * Function to check compatibility of a SUNMatrix object with two + * N_Vectors (A*x = b) + */ + +static booleantype SMCompatible2_Sparse(SUNMatrix A, N_Vector x, N_Vector y) +{ + /* vectors must implement N_VGetArrayPointer */ + if ( (x->ops->nvgetarraypointer == NULL) || + (y->ops->nvgetarraypointer == NULL) ) + return SUNFALSE; + + /* Verify that the dimensions of A, x, and y agree */ + if ( (SUNSparseMatrix_Columns(A) != N_VGetLength(x)) || + (SUNSparseMatrix_Rows(A) != N_VGetLength(y)) ) + return SUNFALSE; + + return SUNTRUE; +} + + +/* ----------------------------------------------------------------- + * Computes y=A*x, where A is a CSC SUNMatrix_Sparse of dimension MxN, x is a + * compatible N_Vector object of length N, and y is a compatible + * N_Vector object of length M. + * + * Returns 0 if successful, 1 if unsuccessful (failed memory access, or both + * x and y are the same vector). + */ +int Matvec_SparseCSC(SUNMatrix A, N_Vector x, N_Vector y) +{ + sunindextype i, j; + sunindextype *Ap, *Ai; + realtype *Ax, *xd, *yd; + + /* access data from CSC structure (return if failure) */ + Ap = SM_INDEXPTRS_S(A); + Ai = SM_INDEXVALS_S(A); + Ax = SM_DATA_S(A); + if ((Ap == NULL) || (Ai == NULL) || (Ax == NULL)) + return SUNMAT_MEM_FAIL; + + /* access vector data (return if failure) */ + xd = N_VGetArrayPointer(x); + yd = N_VGetArrayPointer(y); + if ((xd == NULL) || (yd == NULL) || (xd == yd) ) + return SUNMAT_MEM_FAIL; + + /* initialize result */ + for (i=0; i 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_nonlinearsolver.h" + + +#include "sunnonlinsol/sunnonlinsol_fixedpoint.h" + +SWIGEXPORT SUNNonlinearSolver _wrap_FSUNNonlinSol_FixedPoint(N_Vector farg1, int const *farg2) { + SUNNonlinearSolver fresult ; + N_Vector arg1 = (N_Vector) 0 ; + int arg2 ; + SUNNonlinearSolver result; + + arg1 = (N_Vector)(farg1); + arg2 = (int)(*farg2); + result = (SUNNonlinearSolver)SUNNonlinSol_FixedPoint(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT SUNNonlinearSolver _wrap_FSUNNonlinSol_FixedPointSens(int const *farg1, N_Vector farg2, int const *farg3) { + SUNNonlinearSolver fresult ; + int arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + int arg3 ; + SUNNonlinearSolver result; + + arg1 = (int)(*farg1); + arg2 = (N_Vector)(farg2); + arg3 = (int)(*farg3); + result = (SUNNonlinearSolver)SUNNonlinSol_FixedPointSens(arg1,arg2,arg3); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolGetType_FixedPoint(SUNNonlinearSolver farg1) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + SUNNonlinearSolver_Type result; + + arg1 = (SUNNonlinearSolver)(farg1); + result = (SUNNonlinearSolver_Type)SUNNonlinSolGetType_FixedPoint(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolInitialize_FixedPoint(SUNNonlinearSolver farg1) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + result = (int)SUNNonlinSolInitialize_FixedPoint(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSolve_FixedPoint(SUNNonlinearSolver farg1, N_Vector farg2, N_Vector farg3, N_Vector farg4, double const *farg5, int const *farg6, void *farg7) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + realtype arg5 ; + int arg6 ; + void *arg7 = (void *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + arg4 = (N_Vector)(farg4); + arg5 = (realtype)(*farg5); + arg6 = (int)(*farg6); + arg7 = (void *)(farg7); + result = (int)SUNNonlinSolSolve_FixedPoint(arg1,arg2,arg3,arg4,arg5,arg6,arg7); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolFree_FixedPoint(SUNNonlinearSolver farg1) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + result = (int)SUNNonlinSolFree_FixedPoint(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSetSysFn_FixedPoint(SUNNonlinearSolver farg1, SUNNonlinSolSysFn farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + SUNNonlinSolSysFn arg2 = (SUNNonlinSolSysFn) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (SUNNonlinSolSysFn)(farg2); + result = (int)SUNNonlinSolSetSysFn_FixedPoint(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSetConvTestFn_FixedPoint(SUNNonlinearSolver farg1, SUNNonlinSolConvTestFn farg2, void *farg3) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + SUNNonlinSolConvTestFn arg2 = (SUNNonlinSolConvTestFn) 0 ; + void *arg3 = (void *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (SUNNonlinSolConvTestFn)(farg2); + arg3 = (void *)(farg3); + result = (int)SUNNonlinSolSetConvTestFn_FixedPoint(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSetMaxIters_FixedPoint(SUNNonlinearSolver farg1, int const *farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNNonlinSolSetMaxIters_FixedPoint(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSetDamping_FixedPoint(SUNNonlinearSolver farg1, double const *farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + realtype arg2 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (realtype)(*farg2); + result = (int)SUNNonlinSolSetDamping_FixedPoint(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolGetNumIters_FixedPoint(SUNNonlinearSolver farg1, long *farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (long *)(farg2); + result = (int)SUNNonlinSolGetNumIters_FixedPoint(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolGetCurIter_FixedPoint(SUNNonlinearSolver farg1, int *farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + int *arg2 = (int *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (int *)(farg2); + result = (int)SUNNonlinSolGetCurIter_FixedPoint(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolGetNumConvFails_FixedPoint(SUNNonlinearSolver farg1, long *farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (long *)(farg2); + result = (int)SUNNonlinSolGetNumConvFails_FixedPoint(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolGetSysFn_FixedPoint(SUNNonlinearSolver farg1, void *farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + SUNNonlinSolSysFn *arg2 = (SUNNonlinSolSysFn *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (SUNNonlinSolSysFn *)(farg2); + result = (int)SUNNonlinSolGetSysFn_FixedPoint(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/sunnonlinsol/fixedpoint/fsunnonlinsol_fixedpoint.c b/bazaar/plugin/sundials/src/sunnonlinsol/fixedpoint/fsunnonlinsol_fixedpoint.c new file mode 100644 index 000000000..77314bde9 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunnonlinsol/fixedpoint/fsunnonlinsol_fixedpoint.c @@ -0,0 +1,95 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *----------------------------------------------------------------------------- + * This file contains the implementation of functions needed for initialization + * of the SUNNonlinearSolver fixed point module operations in Fortran. + *---------------------------------------------------------------------------*/ + +#include +#include + +#include "fsunnonlinsol_fixedpoint.h" + +/* Define global nonlinsol variables */ + +SUNNonlinearSolver F2C_CVODE_nonlinsol; +SUNNonlinearSolver F2C_IDA_nonlinsol; +SUNNonlinearSolver F2C_ARKODE_nonlinsol; + +/* Declarations of external global variables */ + +extern N_Vector F2C_CVODE_vec; +extern N_Vector F2C_IDA_vec; +extern N_Vector F2C_ARKODE_vec; + +/* Fortran callable interfaces */ + +void FSUNFIXEDPOINT_INIT(int *code, int *m, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (F2C_CVODE_nonlinsol) SUNNonlinSolFree(F2C_CVODE_nonlinsol); + F2C_CVODE_nonlinsol = NULL; + F2C_CVODE_nonlinsol = SUNNonlinSol_FixedPoint(F2C_CVODE_vec, *m); + if (F2C_CVODE_nonlinsol == NULL) *ier = -1; + break; + case FCMIX_IDA: + if (F2C_IDA_nonlinsol) SUNNonlinSolFree(F2C_IDA_nonlinsol); + F2C_IDA_nonlinsol = NULL; + F2C_IDA_nonlinsol = SUNNonlinSol_FixedPoint(F2C_IDA_vec, *m); + if (F2C_IDA_nonlinsol == NULL) *ier = -1; + break; + case FCMIX_ARKODE: + if (F2C_ARKODE_nonlinsol) SUNNonlinSolFree(F2C_ARKODE_nonlinsol); + F2C_ARKODE_nonlinsol = NULL; + F2C_ARKODE_nonlinsol = SUNNonlinSol_FixedPoint(F2C_ARKODE_vec, *m); + if (F2C_ARKODE_nonlinsol == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + + +void FSUNFIXEDPOINT_SETMAXITERS(int *code, int *maxiters, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (!F2C_CVODE_nonlinsol) { + *ier = -1; + return; + } + *ier = SUNNonlinSolSetMaxIters(F2C_CVODE_nonlinsol, *maxiters); + break; + case FCMIX_IDA: + if (!F2C_IDA_nonlinsol) { + *ier = -1; + return; + } + *ier = SUNNonlinSolSetMaxIters(F2C_IDA_nonlinsol, *maxiters); + break; + case FCMIX_ARKODE: + if (!F2C_ARKODE_nonlinsol) { + *ier = -1; + return; + } + *ier = SUNNonlinSolSetMaxIters(F2C_ARKODE_nonlinsol, *maxiters); + break; + default: + *ier = -1; + } +} diff --git a/bazaar/plugin/sundials/src/sunnonlinsol/fixedpoint/fsunnonlinsol_fixedpoint.h b/bazaar/plugin/sundials/src/sunnonlinsol/fixedpoint/fsunnonlinsol_fixedpoint.h new file mode 100644 index 000000000..e84e96201 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunnonlinsol/fixedpoint/fsunnonlinsol_fixedpoint.h @@ -0,0 +1,56 @@ +/*----------------------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *----------------------------------------------------------------------------- + * This file contains the definitions needed for initialization of the + * SUNNonlinearSolver fixed-point moudule operations in Fortran. + *---------------------------------------------------------------------------*/ + +#ifndef _FSUNNONLINSOL_FIXEDPOINT_H +#define _FSUNNONLINSOL_FIXEDPOINT_H + +#include /* FCMIX_* solver IDs */ +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#if defined(SUNDIALS_F77_FUNC) +#define FSUNFIXEDPOINT_INIT SUNDIALS_F77_FUNC(fsunfixedpointinit, FSUNFIXEDPOINTINIT) +#define FSUNFIXEDPOINT_SETMAXITERS SUNDIALS_F77_FUNC(fsunfixedpointsetmaxiters, FSUNFIXEDPOINTSETMAXITERS) +#else +#define FSUNFIXEDPOINT_INIT fsunfixedpointinit_ +#define FSUNFIXEDPOINT_SETMAXITERS fsunfixedpointsetmaxiters_ +#endif + +/* Declarations of global variables */ + +extern SUNNonlinearSolver F2C_CVODE_nonlinsol; +extern SUNNonlinearSolver F2C_IDA_nonlinsol; +extern SUNNonlinearSolver F2C_ARKODE_nonlinsol; + +/*----------------------------------------------------------------------------- + Prototypes of exported functions + + FSUNFIXEDPOINT_INIT - initializes fixed point nonlinear solver for main problem + FSUNFIXEDPOINT_SETMAXITERS - sets the maximum number of nonlinear iterations + ---------------------------------------------------------------------------*/ + +void FSUNFIXEDPOINT_INIT(int *code, int *m, int *ier); +void FSUNFIXEDPOINT_SETMAXITERS(int *code, int *maxiters, int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/sunnonlinsol/fixedpoint/sunnonlinsol_fixedpoint.c b/bazaar/plugin/sundials/src/sunnonlinsol/fixedpoint/sunnonlinsol_fixedpoint.c new file mode 100644 index 000000000..0c299dca9 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunnonlinsol/fixedpoint/sunnonlinsol_fixedpoint.c @@ -0,0 +1,700 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------------------- + * This is the implementation file for the SUNNonlinearSolver module + * implementation of the Anderson-accelerated Fixed-Point method. + * ---------------------------------------------------------------------------*/ + +#include +#include +#include + +#include +#include +#include + +/* Internal utility routines */ +static int AndersonAccelerate(SUNNonlinearSolver NLS, N_Vector gval, N_Vector x, + N_Vector xold, int iter); + +static int AllocateContent(SUNNonlinearSolver NLS, N_Vector tmpl); +static void FreeContent(SUNNonlinearSolver NLS); + +/* Content structure accessibility macros */ +#define FP_CONTENT(S) ( (SUNNonlinearSolverContent_FixedPoint)(S->content) ) + +/* Constant macros */ +#define ONE RCONST(1.0) +#define ZERO RCONST(0.0) + +/*============================================================================== + Constructor to create a new fixed point solver + ============================================================================*/ + +SUNNonlinearSolver SUNNonlinSol_FixedPoint(N_Vector y, int m) +{ + SUNNonlinearSolver NLS; + SUNNonlinearSolverContent_FixedPoint content; + int retval; + + /* Check that the supplied N_Vector is non-NULL */ + if (y == NULL) return(NULL); + + /* Check that the supplied N_Vector supports all required operations */ + if ( (y->ops->nvclone == NULL) || + (y->ops->nvdestroy == NULL) || + (y->ops->nvscale == NULL) || + (y->ops->nvlinearsum == NULL) || + (y->ops->nvdotprod == NULL) ) + return(NULL); + + /* Create nonlinear linear solver */ + NLS = NULL; + NLS = SUNNonlinSolNewEmpty(); + if (NLS == NULL) return(NULL); + + /* Attach operations */ + NLS->ops->gettype = SUNNonlinSolGetType_FixedPoint; + NLS->ops->initialize = SUNNonlinSolInitialize_FixedPoint; + NLS->ops->solve = SUNNonlinSolSolve_FixedPoint; + NLS->ops->free = SUNNonlinSolFree_FixedPoint; + NLS->ops->setsysfn = SUNNonlinSolSetSysFn_FixedPoint; + NLS->ops->setctestfn = SUNNonlinSolSetConvTestFn_FixedPoint; + NLS->ops->setmaxiters = SUNNonlinSolSetMaxIters_FixedPoint; + NLS->ops->getnumiters = SUNNonlinSolGetNumIters_FixedPoint; + NLS->ops->getcuriter = SUNNonlinSolGetCurIter_FixedPoint; + NLS->ops->getnumconvfails = SUNNonlinSolGetNumConvFails_FixedPoint; + + /* Create nonlinear solver content structure */ + content = NULL; + content = (SUNNonlinearSolverContent_FixedPoint) malloc(sizeof *content); + if (content == NULL) { SUNNonlinSolFree(NLS); return(NULL); } + + /* Initialize all components of content to 0/NULL */ + memset(content, 0, sizeof(struct _SUNNonlinearSolverContent_FixedPoint)); + + /* Attach content */ + NLS->content = content; + + /* Fill general content */ + content->Sys = NULL; + content->CTest = NULL; + content->m = m; + content->damping = SUNFALSE; + content->beta = ONE; + content->curiter = 0; + content->maxiters = 3; + content->niters = 0; + content->nconvfails = 0; + content->ctest_data = NULL; + + /* Fill allocatable content */ + retval = AllocateContent(NLS, y); + if (retval != SUN_NLS_SUCCESS) { SUNNonlinSolFree(NLS); return(NULL); } + + return(NLS); +} + + +/*============================================================================== + Constructor wrapper to create a new fixed point solver for sensitivity solvers + ============================================================================*/ + +SUNNonlinearSolver SUNNonlinSol_FixedPointSens(int count, N_Vector y, int m) +{ + SUNNonlinearSolver NLS; + N_Vector w; + + /* create sensitivity vector wrapper */ + w = N_VNew_SensWrapper(count, y); + + /* create nonlinear solver using sensitivity vector wrapper */ + NLS = SUNNonlinSol_FixedPoint(w, m); + + /* free sensitivity vector wrapper */ + N_VDestroy(w); + + /* return NLS object */ + return(NLS); +} + + +/*============================================================================== + GetType, Initialize, Setup, Solve, and Free operations + ============================================================================*/ + +SUNNonlinearSolver_Type SUNNonlinSolGetType_FixedPoint(SUNNonlinearSolver NLS) +{ + return(SUNNONLINEARSOLVER_FIXEDPOINT); +} + + +int SUNNonlinSolInitialize_FixedPoint(SUNNonlinearSolver NLS) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) return(SUN_NLS_MEM_NULL); + + /* check that all required function pointers have been set */ + if ( (FP_CONTENT(NLS)->Sys == NULL) || (FP_CONTENT(NLS)->CTest == NULL) ) + return(SUN_NLS_MEM_NULL); + + /* reset the total number of iterations and convergence failures */ + FP_CONTENT(NLS)->niters = 0; + FP_CONTENT(NLS)->nconvfails = 0; + + return(SUN_NLS_SUCCESS); +} + + +/*----------------------------------------------------------------------------- + SUNNonlinSolSolve_FixedPoint: Performs the fixed-point solve g(y) = y + + Successful solve return code: + SUN_NLS_SUCCESS = 0 + + Recoverable failure return codes (positive): + SUN_NLS_CONV_RECVR + *_RHSFUNC_RECVR (ODEs) or *_RES_RECVR (DAEs) + + Unrecoverable failure return codes (negative): + *_MEM_NULL + *_RHSFUNC_FAIL (ODEs) or *_RES_FAIL (DAEs) + + Note that return values beginning with * are package specific values returned + by the Sys function provided to the nonlinear solver. + ---------------------------------------------------------------------------*/ +int SUNNonlinSolSolve_FixedPoint(SUNNonlinearSolver NLS, N_Vector y0, + N_Vector ycor, N_Vector w, realtype tol, + booleantype callSetup, void* mem) +{ + /* local variables */ + int retval; + N_Vector yprev, gy, delta; + + /* check that the inputs are non-null */ + if ( (NLS == NULL) || + (y0 == NULL) || + (ycor == NULL) || + (w == NULL) || + (mem == NULL) ) + return(SUN_NLS_MEM_NULL); + + /* check that all required function pointers have been set */ + if ( (FP_CONTENT(NLS)->Sys == NULL) || (FP_CONTENT(NLS)->CTest == NULL) ) + return(SUN_NLS_MEM_NULL); + + /* check that all required function pointers have been set */ + if ( (FP_CONTENT(NLS)->Sys == NULL) || (FP_CONTENT(NLS)->CTest == NULL) ) + return(SUN_NLS_MEM_NULL); + + /* set local shortcut variables */ + yprev = FP_CONTENT(NLS)->yprev; + gy = FP_CONTENT(NLS)->gy; + delta = FP_CONTENT(NLS)->delta; + + /* Looping point for attempts at solution of the nonlinear system: + Evaluate fixed-point function (store in gy). + Performs the accelerated fixed-point iteration. + Performs stopping tests. */ + for( FP_CONTENT(NLS)->curiter = 0; + FP_CONTENT(NLS)->curiter < FP_CONTENT(NLS)->maxiters; + FP_CONTENT(NLS)->curiter++ ) { + + /* update previous solution guess */ + N_VScale(ONE, ycor, yprev); + + /* compute fixed-point iteration function, store in gy */ + retval = FP_CONTENT(NLS)->Sys(ycor, gy, mem); + if (retval != SUN_NLS_SUCCESS) break; + + /* perform fixed point update, based on choice of acceleration or not */ + if (FP_CONTENT(NLS)->m == 0) { /* basic fixed-point solver */ + N_VScale(ONE, gy, ycor); + } else { /* Anderson-accelerated solver */ + retval = AndersonAccelerate(NLS, gy, ycor, yprev, FP_CONTENT(NLS)->curiter); + } + + /* increment nonlinear solver iteration counter */ + FP_CONTENT(NLS)->niters++; + + /* compute change in solution, and call the convergence test function */ + N_VLinearSum(ONE, ycor, -ONE, yprev, delta); + + /* test for convergence */ + retval = FP_CONTENT(NLS)->CTest(NLS, ycor, delta, tol, w, + FP_CONTENT(NLS)->ctest_data); + + /* return if successful */ + if (retval == SUN_NLS_SUCCESS) return(SUN_NLS_SUCCESS); + + /* check if the iterations should continue; otherwise increment the + convergence failure count and return error flag */ + if (retval != SUN_NLS_CONTINUE) { + FP_CONTENT(NLS)->nconvfails++; + return(retval); + } + + } + + /* if we've reached this point, then we exhausted the iteration limit; + increment the convergence failure count and return */ + FP_CONTENT(NLS)->nconvfails++; + return(SUN_NLS_CONV_RECVR); +} + + +int SUNNonlinSolFree_FixedPoint(SUNNonlinearSolver NLS) +{ + /* return if NLS is already free */ + if (NLS == NULL) return(SUN_NLS_SUCCESS); + + /* free items from content structure, then the structure itself */ + if (NLS->content) { + FreeContent(NLS); + free(NLS->content); + NLS->content = NULL; + } + + /* free the ops structure */ + if (NLS->ops) { + free(NLS->ops); + NLS->ops = NULL; + } + + /* free the overall NLS structure */ + free(NLS); + + return(SUN_NLS_SUCCESS); +} + + +/*============================================================================== + Set functions + ============================================================================*/ + +int SUNNonlinSolSetSysFn_FixedPoint(SUNNonlinearSolver NLS, SUNNonlinSolSysFn SysFn) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + /* check that the nonlinear system function is non-null */ + if (SysFn == NULL) + return(SUN_NLS_ILL_INPUT); + + FP_CONTENT(NLS)->Sys = SysFn; + return(SUN_NLS_SUCCESS); +} + +int SUNNonlinSolSetConvTestFn_FixedPoint(SUNNonlinearSolver NLS, + SUNNonlinSolConvTestFn CTestFn, + void* ctest_data) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + /* check that the convergence test function is non-null */ + if (CTestFn == NULL) + return(SUN_NLS_ILL_INPUT); + + FP_CONTENT(NLS)->CTest = CTestFn; + + /* attach convergence test data */ + FP_CONTENT(NLS)->ctest_data = ctest_data; + + return(SUN_NLS_SUCCESS); +} + +int SUNNonlinSolSetMaxIters_FixedPoint(SUNNonlinearSolver NLS, int maxiters) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + /* check that maxiters is a vaild */ + if (maxiters < 1) + return(SUN_NLS_ILL_INPUT); + + FP_CONTENT(NLS)->maxiters = maxiters; + return(SUN_NLS_SUCCESS); +} + +int SUNNonlinSolSetDamping_FixedPoint(SUNNonlinearSolver NLS, realtype beta) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + /* check that beta is a vaild */ + if (beta <= ZERO) + return(SUN_NLS_ILL_INPUT); + + if (beta < ONE) { + /* enable damping */ + FP_CONTENT(NLS)->beta = beta; + FP_CONTENT(NLS)->damping = SUNTRUE; + } else { + /* disable damping */ + FP_CONTENT(NLS)->beta = ONE; + FP_CONTENT(NLS)->damping = SUNFALSE; + } + + return(SUN_NLS_SUCCESS); +} + + +/*============================================================================== + Get functions + ============================================================================*/ + +int SUNNonlinSolGetNumIters_FixedPoint(SUNNonlinearSolver NLS, long int *niters) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + /* return the total number of nonlinear iterations */ + *niters = FP_CONTENT(NLS)->niters; + return(SUN_NLS_SUCCESS); +} + + +int SUNNonlinSolGetCurIter_FixedPoint(SUNNonlinearSolver NLS, int *iter) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + /* return the current nonlinear solver iteration count */ + *iter = FP_CONTENT(NLS)->curiter; + return(SUN_NLS_SUCCESS); +} + + +int SUNNonlinSolGetNumConvFails_FixedPoint(SUNNonlinearSolver NLS, long int *nconvfails) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + /* return the total number of nonlinear convergence failures */ + *nconvfails = FP_CONTENT(NLS)->nconvfails; + return(SUN_NLS_SUCCESS); +} + + +int SUNNonlinSolGetSysFn_FixedPoint(SUNNonlinearSolver NLS, SUNNonlinSolSysFn *SysFn) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + /* return the nonlinear system defining function */ + *SysFn = FP_CONTENT(NLS)->Sys; + return(SUN_NLS_SUCCESS); +} + + +/*============================================================================= + Utility routines + ===========================================================================*/ + +/*--------------------------------------------------------------- + AndersonAccelerate + + This routine computes the Anderson-accelerated fixed point + iterate. Upon entry, the predicted solution is held in xold; + this array is never changed throughout this routine. + + The result of the routine is held in x. + + Possible return values: + SUN_NLS_MEM_NULL --> a required item was missing from memory + SUN_NLS_SUCCESS --> successful completion + -------------------------------------------------------------*/ +static int AndersonAccelerate(SUNNonlinearSolver NLS, N_Vector gval, + N_Vector x, N_Vector xold, int iter) +{ + /* local variables */ + int nvec, retval, i_pt, i, j, lAA, maa, *ipt_map; + realtype a, b, rtemp, c, s, beta, onembeta, *cvals, *R, *gamma; + N_Vector fv, vtemp, gold, fold, *df, *dg, *Q, *Xvecs; + booleantype damping; + + /* local shortcut variables */ + vtemp = x; /* use result as temporary vector */ + ipt_map = FP_CONTENT(NLS)->imap; + maa = FP_CONTENT(NLS)->m; + gold = FP_CONTENT(NLS)->gold; + fold = FP_CONTENT(NLS)->fold; + df = FP_CONTENT(NLS)->df; + dg = FP_CONTENT(NLS)->dg; + Q = FP_CONTENT(NLS)->q; + cvals = FP_CONTENT(NLS)->cvals; + Xvecs = FP_CONTENT(NLS)->Xvecs; + R = FP_CONTENT(NLS)->R; + gamma = FP_CONTENT(NLS)->gamma; + fv = FP_CONTENT(NLS)->delta; + damping = FP_CONTENT(NLS)->damping; + beta = FP_CONTENT(NLS)->beta; + + /* reset ipt_map, i_pt */ + for (i = 0; i < maa; i++) ipt_map[i]=0; + i_pt = iter-1 - ((iter-1)/maa)*maa; + + /* update dg[i_pt], df[i_pt], fv, gold and fold*/ + N_VLinearSum(ONE, gval, -ONE, xold, fv); + if (iter > 0) { + N_VLinearSum(ONE, gval, -ONE, gold, dg[i_pt]); /* dg_new = gval - gold */ + N_VLinearSum(ONE, fv, -ONE, fold, df[i_pt]); /* df_new = fv - fold */ + } + N_VScale(ONE, gval, gold); + N_VScale(ONE, fv, fold); + + /* on first iteration, just do basic fixed-point update */ + if (iter == 0) { + N_VScale(ONE, gval, x); + return(SUN_NLS_SUCCESS); + } + + /* update data structures based on current iteration index */ + + if (iter == 1) { /* second iteration */ + + R[0] = SUNRsqrt( N_VDotProd(df[i_pt], df[i_pt]) ); + N_VScale(ONE/R[0], df[i_pt], Q[i_pt]); + ipt_map[0] = 0; + + } else if (iter <= maa) { /* another iteration before we've reached maa */ + + N_VScale(ONE, df[i_pt], vtemp); + for (j = 0; j < iter-1; j++) { + ipt_map[j] = j; + R[(iter-1)*maa+j] = N_VDotProd(Q[j], vtemp); + N_VLinearSum(ONE, vtemp, -R[(iter-1)*maa+j], Q[j], vtemp); + } + R[(iter-1)*maa+iter-1] = SUNRsqrt( N_VDotProd(vtemp, vtemp) ); + if (R[(iter-1)*maa+iter-1] == ZERO) { + N_VScale(ZERO, vtemp, Q[i_pt]); + } else { + N_VScale((ONE/R[(iter-1)*maa+iter-1]), vtemp, Q[i_pt]); + } + ipt_map[iter-1] = iter-1; + + } else { /* we've filled the acceleration subspace, so start recycling */ + + /* delete left-most column vector from QR factorization */ + for (i = 0; i < maa-1; i++) { + a = R[(i+1)*maa + i]; + b = R[(i+1)*maa + i+1]; + rtemp = SUNRsqrt(a*a + b*b); + c = a / rtemp; + s = b / rtemp; + R[(i+1)*maa + i] = rtemp; + R[(i+1)*maa + i+1] = ZERO; + if (i < maa-1) { + for (j = i+2; j < maa; j++) { + a = R[j*maa + i]; + b = R[j*maa + i+1]; + rtemp = c * a + s * b; + R[j*maa + i+1] = -s*a + c*b; + R[j*maa + i] = rtemp; + } + } + N_VLinearSum(c, Q[i], s, Q[i+1], vtemp); + N_VLinearSum(-s, Q[i], c, Q[i+1], Q[i+1]); + N_VScale(ONE, vtemp, Q[i]); + } + + /* ahift R to the left by one */ + for (i = 1; i < maa; i++) + for (j = 0; j < maa-1; j++) + R[(i-1)*maa + j] = R[i*maa + j]; + + /* add the new df vector */ + N_VScale(ONE, df[i_pt], vtemp); + for (j = 0; j < maa-1; j++) { + R[(maa-1)*maa+j] = N_VDotProd(Q[j], vtemp); + N_VLinearSum(ONE, vtemp, -R[(maa-1)*maa+j], Q[j], vtemp); + } + R[(maa-1)*maa+maa-1] = SUNRsqrt( N_VDotProd(vtemp, vtemp) ); + N_VScale((ONE/R[(maa-1)*maa+maa-1]), vtemp, Q[maa-1]); + + /* update the iteration map */ + j = 0; + for (i = i_pt+1; i < maa; i++) + ipt_map[j++] = i; + for (i = 0; i < i_pt+1; i++) + ipt_map[j++] = i; + } + + /* solve least squares problem and update solution */ + lAA = iter; + if (maa < iter) lAA = maa; + retval = N_VDotProdMulti(lAA, fv, Q, gamma); + if (retval != 0) return(SUN_NLS_VECTOROP_ERR); + + /* set arrays for fused vector operation */ + cvals[0] = ONE; + Xvecs[0] = gval; + nvec = 1; + for (i = lAA-1; i > -1; i--) { + for (j = i+1; j < lAA; j++) + gamma[i] -= R[j*maa+i]*gamma[j]; + if (gamma[i] == ZERO) { + gamma[i] = ZERO; + } else { + gamma[i] /= R[i*maa+i]; + } + cvals[nvec] = -gamma[i]; + Xvecs[nvec] = dg[ipt_map[i]]; + nvec += 1; + } + + /* if enabled, apply damping */ + if (damping) { + onembeta = (ONE - beta); + cvals[nvec] = -onembeta; + Xvecs[nvec] = fv; + nvec += 1; + for (i = lAA - 1; i > -1; i--) { + cvals[nvec] = onembeta * gamma[i]; + Xvecs[nvec] = df[ipt_map[i]]; + nvec += 1; + } + } + + /* update solution */ + retval = N_VLinearCombination(nvec, cvals, Xvecs, x); + if (retval != 0) return(SUN_NLS_VECTOROP_ERR); + + return(SUN_NLS_SUCCESS); +} + +static int AllocateContent(SUNNonlinearSolver NLS, N_Vector y) +{ + int m = FP_CONTENT(NLS)->m; + + FP_CONTENT(NLS)->yprev = N_VClone(y); + if (FP_CONTENT(NLS)->yprev == NULL) { FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } + + FP_CONTENT(NLS)->gy = N_VClone(y); + if (FP_CONTENT(NLS)->gy == NULL) { FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } + + FP_CONTENT(NLS)->delta = N_VClone(y); + if (FP_CONTENT(NLS)->delta == NULL) { FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } + + /* Allocate all m-dependent content */ + if (m > 0) { + + FP_CONTENT(NLS)->fold = N_VClone(y); + if (FP_CONTENT(NLS)->fold == NULL) { + FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } + + FP_CONTENT(NLS)->gold = N_VClone(y); + if (FP_CONTENT(NLS)->gold == NULL) { + FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } + + FP_CONTENT(NLS)->imap = (int *) malloc(m * sizeof(int)); + if (FP_CONTENT(NLS)->imap == NULL) { + FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } + + FP_CONTENT(NLS)->R = (realtype *) malloc((m*m) * sizeof(realtype)); + if (FP_CONTENT(NLS)->R == NULL) { + FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } + + FP_CONTENT(NLS)->gamma = (realtype *) malloc(m * sizeof(realtype)); + if (FP_CONTENT(NLS)->gamma == NULL) { + FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } + + FP_CONTENT(NLS)->cvals = (realtype *) malloc(2*(m+1) * sizeof(realtype)); + if (FP_CONTENT(NLS)->cvals == NULL) { + FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } + + FP_CONTENT(NLS)->df = N_VCloneVectorArray(m, y); + if (FP_CONTENT(NLS)->df == NULL) { + FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } + + FP_CONTENT(NLS)->dg = N_VCloneVectorArray(m, y); + if (FP_CONTENT(NLS)->dg == NULL) { + FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } + + FP_CONTENT(NLS)->q = N_VCloneVectorArray(m, y); + if (FP_CONTENT(NLS)->q == NULL) { + FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } + + FP_CONTENT(NLS)->Xvecs = (N_Vector *) malloc(2*(m+1) * sizeof(N_Vector)); + if (FP_CONTENT(NLS)->Xvecs == NULL) { + FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } + } + + return(SUN_NLS_SUCCESS); +} + +static void FreeContent(SUNNonlinearSolver NLS) +{ + if (FP_CONTENT(NLS)->yprev) { + N_VDestroy(FP_CONTENT(NLS)->yprev); + FP_CONTENT(NLS)->yprev = NULL; } + + if (FP_CONTENT(NLS)->gy) { + N_VDestroy(FP_CONTENT(NLS)->gy); + FP_CONTENT(NLS)->gy = NULL; } + + if (FP_CONTENT(NLS)->fold) { + N_VDestroy(FP_CONTENT(NLS)->fold); + FP_CONTENT(NLS)->fold = NULL; } + + if (FP_CONTENT(NLS)->gold) { + N_VDestroy(FP_CONTENT(NLS)->gold); + FP_CONTENT(NLS)->gold = NULL; } + + if (FP_CONTENT(NLS)->delta) { + N_VDestroy(FP_CONTENT(NLS)->delta); + FP_CONTENT(NLS)->delta = NULL; } + + if (FP_CONTENT(NLS)->imap) { + free(FP_CONTENT(NLS)->imap); + FP_CONTENT(NLS)->imap = NULL; } + + if (FP_CONTENT(NLS)->R) { + free(FP_CONTENT(NLS)->R); + FP_CONTENT(NLS)->R = NULL; } + + if (FP_CONTENT(NLS)->gamma) { + free(FP_CONTENT(NLS)->gamma); + FP_CONTENT(NLS)->gamma = NULL; } + + if (FP_CONTENT(NLS)->cvals) { + free(FP_CONTENT(NLS)->cvals); + FP_CONTENT(NLS)->cvals = NULL; } + + if (FP_CONTENT(NLS)->df) { + N_VDestroyVectorArray(FP_CONTENT(NLS)->df, FP_CONTENT(NLS)->m); + FP_CONTENT(NLS)->df = NULL; } + + if (FP_CONTENT(NLS)->dg) { + N_VDestroyVectorArray(FP_CONTENT(NLS)->dg, FP_CONTENT(NLS)->m); + FP_CONTENT(NLS)->dg = NULL; } + + if (FP_CONTENT(NLS)->q) { + N_VDestroyVectorArray(FP_CONTENT(NLS)->q, FP_CONTENT(NLS)->m); + FP_CONTENT(NLS)->q = NULL; } + + if (FP_CONTENT(NLS)->Xvecs) { + free(FP_CONTENT(NLS)->Xvecs); + FP_CONTENT(NLS)->Xvecs = NULL; } + + return; +} diff --git a/bazaar/plugin/sundials/src/sunnonlinsol/newton/fmod/fsunnonlinsol_newton_mod.c b/bazaar/plugin/sundials/src/sunnonlinsol/newton/fmod/fsunnonlinsol_newton_mod.c new file mode 100644 index 000000000..6b295a425 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunnonlinsol/newton/fmod/fsunnonlinsol_newton_mod.c @@ -0,0 +1,425 @@ +/* ---------------------------------------------------------------------------- + * This file was automatically generated by SWIG (http://www.swig.org). + * Version 4.0.0 + * + * This file is not intended to be easily readable and contains a number of + * coding conventions designed to improve portability and efficiency. Do not make + * changes to this file unless you know what you are doing--modify the SWIG + * interface file instead. + * ----------------------------------------------------------------------------- */ + +/* --------------------------------------------------------------- + * Programmer(s): Auto-generated by swig. + * --------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * -------------------------------------------------------------*/ + +/* ----------------------------------------------------------------------------- + * This section contains generic SWIG labels for method/variable + * declarations/attributes, and other compiler dependent labels. + * ----------------------------------------------------------------------------- */ + +/* template workaround for compilers that cannot correctly implement the C++ standard */ +#ifndef SWIGTEMPLATEDISAMBIGUATOR +# if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560) +# define SWIGTEMPLATEDISAMBIGUATOR template +# elif defined(__HP_aCC) +/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */ +/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */ +# define SWIGTEMPLATEDISAMBIGUATOR template +# else +# define SWIGTEMPLATEDISAMBIGUATOR +# endif +#endif + +/* inline attribute */ +#ifndef SWIGINLINE +# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__)) +# define SWIGINLINE inline +# else +# define SWIGINLINE +# endif +#endif + +/* attribute recognised by some compilers to avoid 'unused' warnings */ +#ifndef SWIGUNUSED +# if defined(__GNUC__) +# if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +# elif defined(__ICC) +# define SWIGUNUSED __attribute__ ((__unused__)) +# else +# define SWIGUNUSED +# endif +#endif + +#ifndef SWIG_MSC_UNSUPPRESS_4505 +# if defined(_MSC_VER) +# pragma warning(disable : 4505) /* unreferenced local function has been removed */ +# endif +#endif + +#ifndef SWIGUNUSEDPARM +# ifdef __cplusplus +# define SWIGUNUSEDPARM(p) +# else +# define SWIGUNUSEDPARM(p) p SWIGUNUSED +# endif +#endif + +/* internal SWIG method */ +#ifndef SWIGINTERN +# define SWIGINTERN static SWIGUNUSED +#endif + +/* internal inline SWIG method */ +#ifndef SWIGINTERNINLINE +# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE +#endif + +/* qualifier for exported *const* global data variables*/ +#ifndef SWIGEXTERN +# ifdef __cplusplus +# define SWIGEXTERN extern +# else +# define SWIGEXTERN +# endif +#endif + +/* exporting methods */ +#if defined(__GNUC__) +# if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# ifndef GCC_HASCLASSVISIBILITY +# define GCC_HASCLASSVISIBILITY +# endif +# endif +#endif + +#ifndef SWIGEXPORT +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# if defined(STATIC_LINKED) +# define SWIGEXPORT +# else +# define SWIGEXPORT __declspec(dllexport) +# endif +# else +# if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY) +# define SWIGEXPORT __attribute__ ((visibility("default"))) +# else +# define SWIGEXPORT +# endif +# endif +#endif + +/* calling conventions for Windows */ +#ifndef SWIGSTDCALL +# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) +# define SWIGSTDCALL __stdcall +# else +# define SWIGSTDCALL +# endif +#endif + +/* Deal with Microsoft's attempt at deprecating C standard runtime functions */ +#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE) +# define _CRT_SECURE_NO_DEPRECATE +#endif + +/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */ +#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE) +# define _SCL_SECURE_NO_DEPRECATE +#endif + +/* Deal with Apple's deprecated 'AssertMacros.h' from Carbon-framework */ +#if defined(__APPLE__) && !defined(__ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES) +# define __ASSERT_MACROS_DEFINE_VERSIONS_WITHOUT_UNDERSCORES 0 +#endif + +/* Intel's compiler complains if a variable which was never initialised is + * cast to void, which is a common idiom which we use to indicate that we + * are aware a variable isn't used. So we just silence that warning. + * See: https://github.com/swig/swig/issues/192 for more discussion. + */ +#ifdef __INTEL_COMPILER +# pragma warning disable 592 +#endif + +/* Errors in SWIG */ +#define SWIG_UnknownError -1 +#define SWIG_IOError -2 +#define SWIG_RuntimeError -3 +#define SWIG_IndexError -4 +#define SWIG_TypeError -5 +#define SWIG_DivisionByZero -6 +#define SWIG_OverflowError -7 +#define SWIG_SyntaxError -8 +#define SWIG_ValueError -9 +#define SWIG_SystemError -10 +#define SWIG_AttributeError -11 +#define SWIG_MemoryError -12 +#define SWIG_NullReferenceError -13 + + + + +#include +#define SWIG_exception_impl(DECL, CODE, MSG, RETURNNULL) \ + { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } + + +#include +#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) +# ifndef snprintf +# define snprintf _snprintf +# endif +#endif + + +/* Support for the `contract` feature. + * + * Note that RETURNNULL is first because it's inserted via a 'Replaceall' in + * the fortran.cxx file. + */ +#define SWIG_contract_assert(RETURNNULL, EXPR, MSG) \ + if (!(EXPR)) { SWIG_exception_impl("$decl", SWIG_ValueError, MSG, RETURNNULL); } + + +#define SWIGVERSION 0x040000 +#define SWIG_VERSION SWIGVERSION + + +#define SWIG_as_voidptr(a) (void *)((const void *)(a)) +#define SWIG_as_voidptrptr(a) ((void)SWIG_as_voidptr(*a),(void**)(a)) + + +#include "sundials/sundials_nonlinearsolver.h" + + +#include "sunnonlinsol/sunnonlinsol_newton.h" + +SWIGEXPORT SUNNonlinearSolver _wrap_FSUNNonlinSol_Newton(N_Vector farg1) { + SUNNonlinearSolver fresult ; + N_Vector arg1 = (N_Vector) 0 ; + SUNNonlinearSolver result; + + arg1 = (N_Vector)(farg1); + result = (SUNNonlinearSolver)SUNNonlinSol_Newton(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT SUNNonlinearSolver _wrap_FSUNNonlinSol_NewtonSens(int const *farg1, N_Vector farg2) { + SUNNonlinearSolver fresult ; + int arg1 ; + N_Vector arg2 = (N_Vector) 0 ; + SUNNonlinearSolver result; + + arg1 = (int)(*farg1); + arg2 = (N_Vector)(farg2); + result = (SUNNonlinearSolver)SUNNonlinSol_NewtonSens(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolGetType_Newton(SUNNonlinearSolver farg1) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + SUNNonlinearSolver_Type result; + + arg1 = (SUNNonlinearSolver)(farg1); + result = (SUNNonlinearSolver_Type)SUNNonlinSolGetType_Newton(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolInitialize_Newton(SUNNonlinearSolver farg1) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + result = (int)SUNNonlinSolInitialize_Newton(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSolve_Newton(SUNNonlinearSolver farg1, N_Vector farg2, N_Vector farg3, N_Vector farg4, double const *farg5, int const *farg6, void *farg7) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + realtype arg5 ; + int arg6 ; + void *arg7 = (void *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + arg4 = (N_Vector)(farg4); + arg5 = (realtype)(*farg5); + arg6 = (int)(*farg6); + arg7 = (void *)(farg7); + result = (int)SUNNonlinSolSolve_Newton(arg1,arg2,arg3,arg4,arg5,arg6,arg7); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolFree_Newton(SUNNonlinearSolver farg1) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + result = (int)SUNNonlinSolFree_Newton(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSetSysFn_Newton(SUNNonlinearSolver farg1, SUNNonlinSolSysFn farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + SUNNonlinSolSysFn arg2 = (SUNNonlinSolSysFn) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (SUNNonlinSolSysFn)(farg2); + result = (int)SUNNonlinSolSetSysFn_Newton(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSetLSetupFn_Newton(SUNNonlinearSolver farg1, SUNNonlinSolLSetupFn farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + SUNNonlinSolLSetupFn arg2 = (SUNNonlinSolLSetupFn) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (SUNNonlinSolLSetupFn)(farg2); + result = (int)SUNNonlinSolSetLSetupFn_Newton(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSetLSolveFn_Newton(SUNNonlinearSolver farg1, SUNNonlinSolLSolveFn farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + SUNNonlinSolLSolveFn arg2 = (SUNNonlinSolLSolveFn) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (SUNNonlinSolLSolveFn)(farg2); + result = (int)SUNNonlinSolSetLSolveFn_Newton(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSetConvTestFn_Newton(SUNNonlinearSolver farg1, SUNNonlinSolConvTestFn farg2, void *farg3) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + SUNNonlinSolConvTestFn arg2 = (SUNNonlinSolConvTestFn) 0 ; + void *arg3 = (void *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (SUNNonlinSolConvTestFn)(farg2); + arg3 = (void *)(farg3); + result = (int)SUNNonlinSolSetConvTestFn_Newton(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolSetMaxIters_Newton(SUNNonlinearSolver farg1, int const *farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + int arg2 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (int)(*farg2); + result = (int)SUNNonlinSolSetMaxIters_Newton(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolGetNumIters_Newton(SUNNonlinearSolver farg1, long *farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (long *)(farg2); + result = (int)SUNNonlinSolGetNumIters_Newton(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolGetCurIter_Newton(SUNNonlinearSolver farg1, int *farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + int *arg2 = (int *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (int *)(farg2); + result = (int)SUNNonlinSolGetCurIter_Newton(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolGetNumConvFails_Newton(SUNNonlinearSolver farg1, long *farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (long *)(farg2); + result = (int)SUNNonlinSolGetNumConvFails_Newton(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNNonlinSolGetSysFn_Newton(SUNNonlinearSolver farg1, void *farg2) { + int fresult ; + SUNNonlinearSolver arg1 = (SUNNonlinearSolver) 0 ; + SUNNonlinSolSysFn *arg2 = (SUNNonlinSolSysFn *) 0 ; + int result; + + arg1 = (SUNNonlinearSolver)(farg1); + arg2 = (SUNNonlinSolSysFn *)(farg2); + result = (int)SUNNonlinSolGetSysFn_Newton(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + + diff --git a/bazaar/plugin/sundials/src/sunnonlinsol/newton/fsunnonlinsol_newton.c b/bazaar/plugin/sundials/src/sunnonlinsol/newton/fsunnonlinsol_newton.c new file mode 100644 index 000000000..b1028f136 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunnonlinsol/newton/fsunnonlinsol_newton.c @@ -0,0 +1,95 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------------------- + * This file contains the implementation of functions needed for initialization + * of the SUNNonlinearSolver Newton moudule operations in Fortran. + * ---------------------------------------------------------------------------*/ + +#include +#include + +#include "fsunnonlinsol_newton.h" + +/* Define global nonlinsol variables */ + +SUNNonlinearSolver F2C_CVODE_nonlinsol; +SUNNonlinearSolver F2C_IDA_nonlinsol; +SUNNonlinearSolver F2C_ARKODE_nonlinsol; + +/* Declarations of external global variables */ + +extern N_Vector F2C_CVODE_vec; +extern N_Vector F2C_IDA_vec; +extern N_Vector F2C_ARKODE_vec; + +/* Fortran callable interfaces */ + +void FSUNNEWTON_INIT(int *code, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (F2C_CVODE_nonlinsol) SUNNonlinSolFree(F2C_CVODE_nonlinsol); + F2C_CVODE_nonlinsol = NULL; + F2C_CVODE_nonlinsol = SUNNonlinSol_Newton(F2C_CVODE_vec); + if (F2C_CVODE_nonlinsol == NULL) *ier = -1; + break; + case FCMIX_IDA: + if (F2C_IDA_nonlinsol) SUNNonlinSolFree(F2C_IDA_nonlinsol); + F2C_IDA_nonlinsol = NULL; + F2C_IDA_nonlinsol = SUNNonlinSol_Newton(F2C_IDA_vec); + if (F2C_IDA_nonlinsol == NULL) *ier = -1; + break; + case FCMIX_ARKODE: + if (F2C_ARKODE_nonlinsol) SUNNonlinSolFree(F2C_ARKODE_nonlinsol); + F2C_ARKODE_nonlinsol = NULL; + F2C_ARKODE_nonlinsol = SUNNonlinSol_Newton(F2C_ARKODE_vec); + if (F2C_ARKODE_nonlinsol == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + + +void FSUNNEWTON_SETMAXITERS(int *code, int *maxiters, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + if (!F2C_CVODE_nonlinsol) { + *ier = -1; + return; + } + *ier = SUNNonlinSolSetMaxIters(F2C_CVODE_nonlinsol, *maxiters); + break; + case FCMIX_IDA: + if (!F2C_IDA_nonlinsol) { + *ier = -1; + return; + } + *ier = SUNNonlinSolSetMaxIters(F2C_IDA_nonlinsol, *maxiters); + break; + case FCMIX_ARKODE: + if (!F2C_ARKODE_nonlinsol) { + *ier = -1; + return; + } + *ier = SUNNonlinSolSetMaxIters(F2C_ARKODE_nonlinsol, *maxiters); + break; + default: + *ier = -1; + } +} diff --git a/bazaar/plugin/sundials/src/sunnonlinsol/newton/fsunnonlinsol_newton.h b/bazaar/plugin/sundials/src/sunnonlinsol/newton/fsunnonlinsol_newton.h new file mode 100644 index 000000000..ffc844337 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunnonlinsol/newton/fsunnonlinsol_newton.h @@ -0,0 +1,56 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------------------- + * This file contains the definitions needed for initialization of the + * SUNNonlinearSolver Newton moudule operations in Fortran. + * ---------------------------------------------------------------------------*/ + +#ifndef _FSUNNONLINSOL_NEWTON_H +#define _FSUNNONLINSOL_NEWTON_H + +#include /* FCMIX_* solver IDs */ +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#if defined(SUNDIALS_F77_FUNC) +#define FSUNNEWTON_INIT SUNDIALS_F77_FUNC(fsunnewtoninit, FSUNNEWTONINIT) +#define FSUNNEWTON_SETMAXITERS SUNDIALS_F77_FUNC(fsunnewtonsetmaxiters, FSUNNEWTONSETMAXITERS) +#else +#define FSUNNEWTON_INIT fsunnewtoninit_ +#define FSUNNEWTON_SETMAXITERS fsunnewtonsetmaxiters_ +#endif + +/* Declarations of global variables */ + +extern SUNNonlinearSolver F2C_CVODE_nonlinsol; +extern SUNNonlinearSolver F2C_IDA_nonlinsol; +extern SUNNonlinearSolver F2C_ARKODE_nonlinsol; + +/* ----------------------------------------------------------------------------- + * Prototypes of exported functions + * + * FSUNNEWTON_INIT - initializes Newton nonlinear solver for main problem + * FSUNNEWTON_SETMAXITERS - sets the maximum number of nonlinear iterations + * ---------------------------------------------------------------------------*/ + +void FSUNNEWTON_INIT(int *code, int *ier); +void FSUNNEWTON_SETMAXITERS(int *code, int *maxiters, int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/bazaar/plugin/sundials/src/sunnonlinsol/newton/sunnonlinsol_newton.c b/bazaar/plugin/sundials/src/sunnonlinsol/newton/sunnonlinsol_newton.c new file mode 100644 index 000000000..a7cdca427 --- /dev/null +++ b/bazaar/plugin/sundials/src/sunnonlinsol/newton/sunnonlinsol_newton.c @@ -0,0 +1,460 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2020, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------------------- + * This is the implementation file for the SUNNonlinearSolver module + * implementation of Newton's method. + * ---------------------------------------------------------------------------*/ + +#include +#include +#include + +#include +#include +#include + +/* Content structure accessibility macros */ +#define NEWTON_CONTENT(S) ( (SUNNonlinearSolverContent_Newton)(S->content) ) + +/* Constant macros */ +#define ZERO RCONST(0.0) /* real 0.0 */ +#define ONE RCONST(1.0) /* real 1.0 */ + +/*============================================================================== + Constructor to create a new Newton solver + ============================================================================*/ + +SUNNonlinearSolver SUNNonlinSol_Newton(N_Vector y) +{ + SUNNonlinearSolver NLS; + SUNNonlinearSolverContent_Newton content; + + /* Check that the supplied N_Vector is non-NULL */ + if (y == NULL) return(NULL); + + /* Check that the supplied N_Vector supports all required operations */ + if ( (y->ops->nvclone == NULL) || + (y->ops->nvdestroy == NULL) || + (y->ops->nvscale == NULL) || + (y->ops->nvlinearsum == NULL) ) + return(NULL); + + /* Create an empty nonlinear linear solver object */ + NLS = NULL; + NLS = SUNNonlinSolNewEmpty(); + if (NLS == NULL) return(NULL); + + /* Attach operations */ + NLS->ops->gettype = SUNNonlinSolGetType_Newton; + NLS->ops->initialize = SUNNonlinSolInitialize_Newton; + NLS->ops->solve = SUNNonlinSolSolve_Newton; + NLS->ops->free = SUNNonlinSolFree_Newton; + NLS->ops->setsysfn = SUNNonlinSolSetSysFn_Newton; + NLS->ops->setlsetupfn = SUNNonlinSolSetLSetupFn_Newton; + NLS->ops->setlsolvefn = SUNNonlinSolSetLSolveFn_Newton; + NLS->ops->setctestfn = SUNNonlinSolSetConvTestFn_Newton; + NLS->ops->setmaxiters = SUNNonlinSolSetMaxIters_Newton; + NLS->ops->getnumiters = SUNNonlinSolGetNumIters_Newton; + NLS->ops->getcuriter = SUNNonlinSolGetCurIter_Newton; + NLS->ops->getnumconvfails = SUNNonlinSolGetNumConvFails_Newton; + + /* Create content */ + content = NULL; + content = (SUNNonlinearSolverContent_Newton) malloc(sizeof *content); + if (content == NULL) { SUNNonlinSolFree(NLS); return(NULL); } + + /* Initialize all components of content to 0/NULL */ + memset(content, 0, sizeof(struct _SUNNonlinearSolverContent_Newton)); + + /* Attach content */ + NLS->content = content; + + /* Fill general content */ + content->Sys = NULL; + content->LSetup = NULL; + content->LSolve = NULL; + content->CTest = NULL; + content->jcur = SUNFALSE; + content->curiter = 0; + content->maxiters = 3; + content->niters = 0; + content->nconvfails = 0; + content->ctest_data = NULL; + + /* Fill allocatable content */ + content->delta = N_VClone(y); + if (content->delta == NULL) { SUNNonlinSolFree(NLS); return(NULL); } + + return(NLS); +} + + +/*============================================================================== + Constructor wrapper to create a new Newton solver for sensitivity solvers + ============================================================================*/ + +SUNNonlinearSolver SUNNonlinSol_NewtonSens(int count, N_Vector y) +{ + SUNNonlinearSolver NLS; + N_Vector w; + + /* create sensitivity vector wrapper */ + w = N_VNew_SensWrapper(count, y); + + /* create nonlinear solver using sensitivity vector wrapper */ + NLS = SUNNonlinSol_Newton(w); + + /* free sensitivity vector wrapper */ + N_VDestroy(w); + + /* return NLS object */ + return(NLS); +} + + +/*============================================================================== + GetType, Initialize, Setup, Solve, and Free operations + ============================================================================*/ + +SUNNonlinearSolver_Type SUNNonlinSolGetType_Newton(SUNNonlinearSolver NLS) +{ + return(SUNNONLINEARSOLVER_ROOTFIND); +} + + +int SUNNonlinSolInitialize_Newton(SUNNonlinearSolver NLS) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) return(SUN_NLS_MEM_NULL); + + /* check that all required function pointers have been set */ + if ( (NEWTON_CONTENT(NLS)->Sys == NULL) || + (NEWTON_CONTENT(NLS)->LSolve == NULL) || + (NEWTON_CONTENT(NLS)->CTest == NULL) ) { + return(SUN_NLS_MEM_NULL); + } + + /* reset the total number of iterations and convergence failures */ + NEWTON_CONTENT(NLS)->niters = 0; + NEWTON_CONTENT(NLS)->nconvfails = 0; + + /* reset the Jacobian status */ + NEWTON_CONTENT(NLS)->jcur = SUNFALSE; + + return(SUN_NLS_SUCCESS); +} + + +/*------------------------------------------------------------------------------ + SUNNonlinSolSolve_Newton: Performs the nonlinear solve F(y) = 0 + + Successful solve return code: + SUN_NLS_SUCCESS = 0 + + Recoverable failure return codes (positive): + SUN_NLS_CONV_RECVR + *_RHSFUNC_RECVR (ODEs) or *_RES_RECVR (DAEs) + *_LSETUP_RECVR + *_LSOLVE_RECVR + + Unrecoverable failure return codes (negative): + *_MEM_NULL + *_RHSFUNC_FAIL (ODEs) or *_RES_FAIL (DAEs) + *_LSETUP_FAIL + *_LSOLVE_FAIL + + Note return values beginning with * are package specific values returned by + the Sys, LSetup, and LSolve functions provided to the nonlinear solver. + ----------------------------------------------------------------------------*/ +int SUNNonlinSolSolve_Newton(SUNNonlinearSolver NLS, + N_Vector y0, N_Vector ycor, + N_Vector w, realtype tol, + booleantype callLSetup, void* mem) +{ + /* local variables */ + int retval; + booleantype jbad; + N_Vector delta; + + /* check that the inputs are non-null */ + if ( (NLS == NULL) || + (y0 == NULL) || + (ycor == NULL) || + (w == NULL) || + (mem == NULL) ) + return(SUN_NLS_MEM_NULL); + + /* check that all required function pointers have been set */ + if ( (NEWTON_CONTENT(NLS)->Sys == NULL) || + (NEWTON_CONTENT(NLS)->LSolve == NULL) || + (callLSetup && (NEWTON_CONTENT(NLS)->LSetup == NULL)) || + (NEWTON_CONTENT(NLS)->CTest == NULL) ) { + return(SUN_NLS_MEM_NULL); + } + + /* set local shortcut variables */ + delta = NEWTON_CONTENT(NLS)->delta; + + /* assume the Jacobian is good */ + jbad = SUNFALSE; + + /* looping point for attempts at solution of the nonlinear system: + Evaluate the nonlinear residual function (store in delta) + Setup the linear solver if necessary + Preform Newton iteraion */ + for(;;) { + + /* compute the nonlinear residual, store in delta */ + retval = NEWTON_CONTENT(NLS)->Sys(ycor, delta, mem); + if (retval != SUN_NLS_SUCCESS) break; + + /* if indicated, setup the linear system */ + if (callLSetup) { + retval = NEWTON_CONTENT(NLS)->LSetup(jbad, + &(NEWTON_CONTENT(NLS)->jcur), + mem); + if (retval != SUN_NLS_SUCCESS) break; + } + + /* initialize counter curiter */ + NEWTON_CONTENT(NLS)->curiter = 0; + + /* looping point for Newton iteration. Break out on any error. */ + for(;;) { + + /* increment nonlinear solver iteration counter */ + NEWTON_CONTENT(NLS)->niters++; + + /* compute the negative of the residual for the linear system rhs */ + N_VScale(-ONE, delta, delta); + + /* solve the linear system to get Newton update delta */ + retval = NEWTON_CONTENT(NLS)->LSolve(delta, mem); + if (retval != SUN_NLS_SUCCESS) break; + + /* update the Newton iterate */ + N_VLinearSum(ONE, ycor, ONE, delta, ycor); + + /* test for convergence */ + retval = NEWTON_CONTENT(NLS)->CTest(NLS, ycor, delta, tol, w, + NEWTON_CONTENT(NLS)->ctest_data); + + /* if successful update Jacobian status and return */ + if (retval == SUN_NLS_SUCCESS) { + NEWTON_CONTENT(NLS)->jcur = SUNFALSE; + return(SUN_NLS_SUCCESS); + } + + /* check if the iteration should continue; otherwise exit Newton loop */ + if (retval != SUN_NLS_CONTINUE) break; + + /* not yet converged. Increment curiter and test for max allowed. */ + NEWTON_CONTENT(NLS)->curiter++; + if (NEWTON_CONTENT(NLS)->curiter >= NEWTON_CONTENT(NLS)->maxiters) { + retval = SUN_NLS_CONV_RECVR; + break; + } + + /* compute the nonlinear residual, store in delta */ + retval = NEWTON_CONTENT(NLS)->Sys(ycor, delta, mem); + if (retval != SUN_NLS_SUCCESS) break; + + } /* end of Newton iteration loop */ + + /* all errors go here */ + + /* If there is a recoverable convergence failure and the Jacobian-related + data appears not to be current, increment the convergence failure count, + reset the initial correction to zero, and loop again with a call to + lsetup in which jbad is TRUE. Otherwise break out and return. */ + if ((retval > 0) && !(NEWTON_CONTENT(NLS)->jcur) && (NEWTON_CONTENT(NLS)->LSetup)) { + NEWTON_CONTENT(NLS)->nconvfails++; + callLSetup = SUNTRUE; + jbad = SUNTRUE; + N_VConst(ZERO, ycor); + continue; + } else { + break; + } + + } /* end of setup loop */ + + /* increment number of convergence failures */ + NEWTON_CONTENT(NLS)->nconvfails++; + + /* all error returns exit here */ + return(retval); +} + + +int SUNNonlinSolFree_Newton(SUNNonlinearSolver NLS) +{ + /* return if NLS is already free */ + if (NLS == NULL) + return(SUN_NLS_SUCCESS); + + /* free items from contents, then the generic structure */ + if (NLS->content) { + + if (NEWTON_CONTENT(NLS)->delta) + N_VDestroy(NEWTON_CONTENT(NLS)->delta); + NEWTON_CONTENT(NLS)->delta = NULL; + + free(NLS->content); + NLS->content = NULL; + } + + /* free the ops structure */ + if (NLS->ops) { + free(NLS->ops); + NLS->ops = NULL; + } + + /* free the nonlinear solver */ + free(NLS); + + return(SUN_NLS_SUCCESS); +} + + +/*============================================================================== + Set functions + ============================================================================*/ + +int SUNNonlinSolSetSysFn_Newton(SUNNonlinearSolver NLS, SUNNonlinSolSysFn SysFn) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + /* check that the nonlinear system function is non-null */ + if (SysFn == NULL) + return(SUN_NLS_ILL_INPUT); + + NEWTON_CONTENT(NLS)->Sys = SysFn; + return(SUN_NLS_SUCCESS); +} + + +int SUNNonlinSolSetLSetupFn_Newton(SUNNonlinearSolver NLS, SUNNonlinSolLSetupFn LSetupFn) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + NEWTON_CONTENT(NLS)->LSetup = LSetupFn; + return(SUN_NLS_SUCCESS); +} + + +int SUNNonlinSolSetLSolveFn_Newton(SUNNonlinearSolver NLS, SUNNonlinSolLSolveFn LSolveFn) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + /* check that the linear solver solve function is non-null */ + if (LSolveFn == NULL) + return(SUN_NLS_ILL_INPUT); + + NEWTON_CONTENT(NLS)->LSolve = LSolveFn; + return(SUN_NLS_SUCCESS); +} + + +int SUNNonlinSolSetConvTestFn_Newton(SUNNonlinearSolver NLS, + SUNNonlinSolConvTestFn CTestFn, + void* ctest_data) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + /* check that the convergence test function is non-null */ + if (CTestFn == NULL) + return(SUN_NLS_ILL_INPUT); + + NEWTON_CONTENT(NLS)->CTest = CTestFn; + + /* attach convergence test data */ + NEWTON_CONTENT(NLS)->ctest_data = ctest_data; + + return(SUN_NLS_SUCCESS); +} + + +int SUNNonlinSolSetMaxIters_Newton(SUNNonlinearSolver NLS, int maxiters) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + /* check that maxiters is a vaild */ + if (maxiters < 1) + return(SUN_NLS_ILL_INPUT); + + NEWTON_CONTENT(NLS)->maxiters = maxiters; + return(SUN_NLS_SUCCESS); +} + + +/*============================================================================== + Get functions + ============================================================================*/ + +int SUNNonlinSolGetNumIters_Newton(SUNNonlinearSolver NLS, long int *niters) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + /* return the total number of nonlinear iterations */ + *niters = NEWTON_CONTENT(NLS)->niters; + return(SUN_NLS_SUCCESS); +} + + +int SUNNonlinSolGetCurIter_Newton(SUNNonlinearSolver NLS, int *iter) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + /* return the current nonlinear solver iteration count */ + *iter = NEWTON_CONTENT(NLS)->curiter; + return(SUN_NLS_SUCCESS); +} + + +int SUNNonlinSolGetNumConvFails_Newton(SUNNonlinearSolver NLS, long int *nconvfails) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + /* return the total number of nonlinear convergence failures */ + *nconvfails = NEWTON_CONTENT(NLS)->nconvfails; + return(SUN_NLS_SUCCESS); +} + + +int SUNNonlinSolGetSysFn_Newton(SUNNonlinearSolver NLS, SUNNonlinSolSysFn *SysFn) +{ + /* check that the nonlinear solver is non-null */ + if (NLS == NULL) + return(SUN_NLS_MEM_NULL); + + /* return the nonlinear system defining function */ + *SysFn = NEWTON_CONTENT(NLS)->Sys; + return(SUN_NLS_SUCCESS); +} diff --git a/bazaar/plugin/sundials/sundials.upp b/bazaar/plugin/sundials/sundials.upp new file mode 100644 index 000000000..5a8b1a43d --- /dev/null +++ b/bazaar/plugin/sundials/sundials.upp @@ -0,0 +1,231 @@ +description "SUNDIALS: SUite of Nonlinear and DIfferential/ALgebraic Equation Solvers\377"; + +uses + Core; + +include + include, + src/ida, + src/kinsol; + +file + include\ida readonly separator, + include\ida\ida.h, + include\ida\ida_bbdpre.h, + include\ida\ida_direct.h, + include\ida\ida_ls.h, + include\ida\ida_spils.h, + include\nvector readonly separator, + include\nvector\nvector_cuda.h, + include\nvector\nvector_manyvector.h, + include\nvector\nvector_openmp.h, + include\nvector\nvector_openmpdev.h, + include\nvector\nvector_raja.h, + include\nvector\nvector_serial.h, + include\nvector\nvector_trilinos.h, + include\nvector\cuda readonly separator, + include\nvector\cuda\ThreadPartitioning.hpp, + include\nvector\cuda\Vector.hpp, + include\nvector\raja readonly separator, + include\nvector\raja\Vector.hpp, + include\nvector\trilinos readonly separator, + include\sundials readonly separator, + include\sundials\sundials_band.h, + include\sundials\sundials_config.h, + include\sundials\sundials_dense.h, + include\sundials\sundials_direct.h, + include\sundials\sundials_fconfig.h, + include\sundials\sundials_fnvector.h, + include\sundials\sundials_futils.h, + include\sundials\sundials_iterative.h, + include\sundials\sundials_lapack.h, + include\sundials\sundials_linearsolver.h, + include\sundials\sundials_math.h, + include\sundials\sundials_matrix.h, + include\sundials\sundials_mpi_types.h, + include\sundials\sundials_nonlinearsolver.h, + include\sundials\sundials_nvector.h, + include\sundials\sundials_nvector_senswrapper.h, + include\sundials\sundials_types.h, + include\sundials\sundials_version.h, + include\sunlinsol readonly separator, + include\sunlinsol\sunlinsol_band.h, + include\sunlinsol\sunlinsol_cusolversp_batchqr.h, + include\sunlinsol\sunlinsol_dense.h, + include\sunlinsol\sunlinsol_lapackband.h, + include\sunlinsol\sunlinsol_lapackdense.h, + include\sunlinsol\sunlinsol_pcg.h, + include\sunlinsol\sunlinsol_spbcgs.h, + include\sunlinsol\sunlinsol_spfgmr.h, + include\sunlinsol\sunlinsol_spgmr.h, + include\sunlinsol\sunlinsol_sptfqmr.h, + include\sunlinsol\sunlinsol_superludist.h, + include\sunmatrix readonly separator, + include\sunmatrix\sunmatrix_band.h, + include\sunmatrix\sunmatrix_cusparse.h, + include\sunmatrix\sunmatrix_dense.h, + include\sunmatrix\sunmatrix_sparse.h, + include\sunnonlinsol readonly separator, + include\sunnonlinsol\sunnonlinsol_fixedpoint.h, + include\sunnonlinsol\sunnonlinsol_newton.h, + include\sunnonlinsol\sunnonlinsol_petscsnes.h, + src\ida readonly separator, + src\ida\ida.c, + src\ida\ida_bbdpre.c, + src\ida\ida_bbdpre_impl.h, + src\ida\ida_direct.c, + src\ida\ida_ic.c, + src\ida\ida_impl.h, + src\ida\ida_io.c, + src\ida\ida_ls.c, + src\ida\ida_ls_impl.h, + src\ida\ida_nls.c, + src\ida\ida_spils.c, + src\ida\fcmix readonly separator, + src\ida\fmod readonly separator, + src\nvector\manyvector readonly separator, + src\nvector\manyvector\nvector_manyvector.c, + src\nvector\manyvector\fmod readonly separator, + src\nvector\manyvector\fmod\fnvector_manyvector_mod.c, + src\nvector\mpiplusx readonly separator, + src\nvector\mpiplusx\fmod readonly separator, + src\nvector\openmp readonly separator, + src\nvector\openmp\fmod readonly separator, + src\nvector\openmpdev readonly separator, + src\nvector\parallel readonly separator, + src\nvector\parallel\fmod readonly separator, + src\nvector\parhyp readonly separator, + src\nvector\petsc readonly separator, + src\nvector\pthreads readonly separator, + src\nvector\pthreads\fmod readonly separator, + src\nvector\serial readonly separator, + src\nvector\serial\fnvector_serial.c, + src\nvector\serial\fnvector_serial.h, + src\nvector\serial\nvector_serial.c, + src\nvector\serial\fmod readonly separator, + src\nvector\serial\fmod\fnvector_serial_mod.c, + src\nvector\trilinos readonly separator, + src\sundials readonly separator, + src\sundials\sundials_band.c, + src\sundials\sundials_cuda.h, + src\sundials\sundials_debug.h, + src\sundials\sundials_dense.c, + src\sundials\sundials_direct.c, + src\sundials\sundials_futils.c, + src\sundials\sundials_iterative.c, + src\sundials\sundials_linearsolver.c, + src\sundials\sundials_math.c, + src\sundials\sundials_matrix.c, + src\sundials\sundials_nonlinearsolver.c, + src\sundials\sundials_nvector.c, + src\sundials\sundials_nvector_senswrapper.c, + src\sundials\sundials_version.c, + src\sundials\fmod readonly separator, + src\sundials\fmod\fsundials_futils_mod.c, + src\sundials\fmod\fsundials_linearsolver_mod.c, + src\sundials\fmod\fsundials_matrix_mod.c, + src\sundials\fmod\fsundials_nonlinearsolver_mod.c, + src\sundials\fmod\fsundials_nvector_mod.c, + src\sundials\fmod\fsundials_types_mod.c, + src\sunlinsol\band readonly separator, + src\sunlinsol\band\fsunlinsol_band.c, + src\sunlinsol\band\fsunlinsol_band.h, + src\sunlinsol\band\sunlinsol_band.c, + src\sunlinsol\band\fmod readonly separator, + src\sunlinsol\band\fmod\fsunlinsol_band_mod.c, + src\sunlinsol\dense readonly separator, + src\sunlinsol\dense\fsunlinsol_dense.c, + src\sunlinsol\dense\fsunlinsol_dense.h, + src\sunlinsol\dense\sunlinsol_dense.c, + src\sunlinsol\dense\fmod readonly separator, + src\sunlinsol\dense\fmod\fsunlinsol_dense_mod.c, + src\sunlinsol\klu readonly separator, + src\sunlinsol\klu\fmod readonly separator, + src\sunlinsol\lapackband readonly separator, + src\sunlinsol\lapackdense readonly separator, + src\sunlinsol\pcg readonly separator, + src\sunlinsol\pcg\fsunlinsol_pcg.c, + src\sunlinsol\pcg\fsunlinsol_pcg.h, + src\sunlinsol\pcg\sunlinsol_pcg.c, + src\sunlinsol\pcg\fmod readonly separator, + src\sunlinsol\pcg\fmod\fsunlinsol_pcg_mod.c, + src\sunlinsol\spbcgs readonly separator, + src\sunlinsol\spbcgs\fsunlinsol_spbcgs.c, + src\sunlinsol\spbcgs\fsunlinsol_spbcgs.h, + src\sunlinsol\spbcgs\sunlinsol_spbcgs.c, + src\sunlinsol\spbcgs\fmod readonly separator, + src\sunlinsol\spbcgs\fmod\fsunlinsol_spbcgs_mod.c, + src\sunlinsol\spfgmr readonly separator, + src\sunlinsol\spfgmr\fsunlinsol_spfgmr.c, + src\sunlinsol\spfgmr\fsunlinsol_spfgmr.h, + src\sunlinsol\spfgmr\sunlinsol_spfgmr.c, + src\sunlinsol\spfgmr\fmod readonly separator, + src\sunlinsol\spfgmr\fmod\fsunlinsol_spfgmr_mod.c, + src\sunlinsol\spgmr readonly separator, + src\sunlinsol\spgmr\fsunlinsol_spgmr.c, + src\sunlinsol\spgmr\fsunlinsol_spgmr.h, + src\sunlinsol\spgmr\sunlinsol_spgmr.c, + src\sunlinsol\spgmr\fmod readonly separator, + src\sunlinsol\spgmr\fmod\fsunlinsol_spgmr_mod.c, + src\sunlinsol\sptfqmr readonly separator, + src\sunlinsol\sptfqmr\fsunlinsol_sptfqmr.c, + src\sunlinsol\sptfqmr\fsunlinsol_sptfqmr.h, + src\sunlinsol\sptfqmr\sunlinsol_sptfqmr.c, + src\sunlinsol\sptfqmr\fmod readonly separator, + src\sunlinsol\sptfqmr\fmod\fsunlinsol_sptfqmr_mod.c, + src\sunlinsol\superludist readonly separator, + src\sunlinsol\superlumt readonly separator, + src\sunmatrix\band readonly separator, + src\sunmatrix\band\fsunmatrix_band.c, + src\sunmatrix\band\fsunmatrix_band.h, + src\sunmatrix\band\sunmatrix_band.c, + src\sunmatrix\band\fmod readonly separator, + src\sunmatrix\band\fmod\fsunmatrix_band_mod.c, + src\sunmatrix\dense readonly separator, + src\sunmatrix\dense\fsunmatrix_dense.c, + src\sunmatrix\dense\fsunmatrix_dense.h, + src\sunmatrix\dense\sunmatrix_dense.c, + src\sunmatrix\dense\fmod readonly separator, + src\sunmatrix\dense\fmod\fsunmatrix_dense_mod.c, + src\sunmatrix\slunrloc readonly separator, + src\sunmatrix\sparse readonly separator, + src\sunmatrix\sparse\fsunmatrix_sparse.c, + src\sunmatrix\sparse\fsunmatrix_sparse.h, + src\sunmatrix\sparse\sunmatrix_sparse.c, + src\sunmatrix\sparse\fmod readonly separator, + src\sunmatrix\sparse\fmod\fsunmatrix_sparse_mod.c, + src\sunnonlinsol\fixedpoint readonly separator, + src\sunnonlinsol\fixedpoint\fsunnonlinsol_fixedpoint.c, + src\sunnonlinsol\fixedpoint\fsunnonlinsol_fixedpoint.h, + src\sunnonlinsol\fixedpoint\sunnonlinsol_fixedpoint.c, + src\sunnonlinsol\fixedpoint\fmod readonly separator, + src\sunnonlinsol\fixedpoint\fmod\fsunnonlinsol_fixedpoint_mod.c, + src\sunnonlinsol\newton readonly separator, + src\sunnonlinsol\newton\fsunnonlinsol_newton.c, + src\sunnonlinsol\newton\fsunnonlinsol_newton.h, + src\sunnonlinsol\newton\sunnonlinsol_newton.c, + src\sunnonlinsol\newton\fmod readonly separator, + src\sunnonlinsol\newton\fmod\fsunnonlinsol_newton_mod.c, + include\kinsol readonly separator, + include\kinsol\kinsol.h, + include\kinsol\kinsol_bbdpre.h, + include\kinsol\kinsol_direct.h, + include\kinsol\kinsol_ls.h, + include\kinsol\kinsol_spils.h, + src\kinsol readonly separator, + src\kinsol\kinsol.c, + src\kinsol\kinsol_bbdpre.c, + src\kinsol\kinsol_bbdpre_impl.h, + src\kinsol\kinsol_direct.c, + src\kinsol\kinsol_impl.h, + src\kinsol\kinsol_io.c, + src\kinsol\kinsol_ls.c, + src\kinsol\kinsol_ls_impl.h, + src\kinsol\kinsol_spils.c, + src\kinsol\fcmix readonly separator, + src\kinsol\fcmix\fkinbbd.h, + src\kinsol\fcmix\fkinsol.h, + src\kinsol\fmod readonly separator, + src\kinsol\fmod\fkinsol_mod.c; + + spellcheck_comments "EN-GB" \ No newline at end of file