diff --git a/.gitignore b/.gitignore index 3e9185713d..f15dc31fd1 100644 --- a/.gitignore +++ b/.gitignore @@ -19,6 +19,7 @@ /.pydevproject .vscode compile_commands.json +.clangd # custom test environment setup script /test/env/env.sh @@ -59,6 +60,7 @@ compile_commands.json /doc/*/*.log # directories created by/for Sphinx documentation +/doc/.venv /doc/.pyvenv /doc/*/guide/build/ /doc/*/examples/build/ diff --git a/CHANGELOG.md b/CHANGELOG.md index 7a2184439e..7e3db65f48 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,12 @@ ### New Features and Enhancements +Added the `SUNStepper` base class to represent a generic solution procedure for +IVPs. This is used by the SplittingStep and ForcingStep modules of ARKODE. A +SUNStepper can be created from an ARKODE memory block with the new function +`ARKodeCreateSUNStepper`. To enable interoperability with `MRIStepInnerStepper`, +the function `MRIStepInnerStepper_CreateFromSUNStepper` was added. + The following DIRK schemes now have coefficients accurate to quad precision: * `ARKODE_BILLINGTON_3_3_2` * `ARKODE_KVAERNO_4_2_3` diff --git a/doc/arkode/guide/source/Constants.rst b/doc/arkode/guide/source/Constants.rst index 22363ef243..2a7ffa8177 100644 --- a/doc/arkode/guide/source/Constants.rst +++ b/doc/arkode/guide/source/Constants.rst @@ -538,6 +538,11 @@ contains the ARKODE output constants. | :index:`ARK_STEPPER_UNSUPPORTED` | -48 | An operation was not supported by the current | | | | time-stepping module. | +-------------------------------------+------+------------------------------------------------------------+ + | :index:`ARK_SUNSTEPPER_ERR` | -49 | An error occurred in the SUNStepper module. | + +-------------------------------------+------+------------------------------------------------------------+ + | :index:`ARK_ADJ_RECOMPUTE_FAIL` | -50 | An occurred recomputing steps during the adjoint | + | | | integration. | + +-------------------------------------+------+------------------------------------------------------------+ | :index:`ARK_UNRECOGNIZED_ERROR` | -99 | An unknown error was encountered. | +-------------------------------------+------+------------------------------------------------------------+ | | diff --git a/doc/arkode/guide/source/Mathematics.rst b/doc/arkode/guide/source/Mathematics.rst index 9d9835c53d..f677957786 100644 --- a/doc/arkode/guide/source/Mathematics.rst +++ b/doc/arkode/guide/source/Mathematics.rst @@ -2126,3 +2126,111 @@ by :math:`\eta_\text{rf}`. For more information on utilizing relaxation Runge--Kutta methods, see :numref:`ARKODE.Usage.Relaxation`. + + +.. _ARKODE.Mathematics.ASA: + +Adjoint Sensitivity Analysis +============================ + +Consider :eq:`ARKODE_IVP_simple_explicit`, but where the ODE also depends on some parameters +:math:`p` (that is, we have :math:`f(t,y,p)`). Now, suppose we have a functional :math:`g(y(t_f),p)` +for which we would like to compute the gradients :math:`\partial g(y(t_f),p)/\partial y(t_0)` +and/or :math:`\partial g(y(t_f),p)/\partial p`. This most often arises in the form of an +optimization problem such as + +.. math:: + \min_{\xi} \bar{\Psi}(\xi) = g(y(t_f), p) + :label: ARKODE_OPTIMIZATION_PROBLEM + +where :math:`\xi \subset \{y(t_0), p\}`. The adjoint method is one approach to obtaining the +gradients that is particularly efficient when there are relatively few functionals and a large +number of parameters. While :ref:`CVODES ` and +:ref:`IDAS ` *continuous* adjoint methods +(differentiate-then-discretize), ARKODE provides *discrete* adjoint methods +(discretize-then-differentiate). For the continuous approach, we derive and solve the adjoint ODE +backwards in time + +.. math:: + \lambda'(t) &= -f_y^T(t, y, p) \lambda,\quad \lambda(t_F) = g_y^T(y(t_f), p), \\ + \mu'(t) &= -f_p^T(t, y, p) \mu,\quad \mu(t_F) = g_p^T(y(t_f), p), \quad t_f \geq t \geq t_0, \\ + :label: ARKODE_CONTINUOUS_ADJOINT_ODE + +where :math:`\lambda(t) \in \mathbb{R}^N`, :math:`\mu(t) \in \mathbb{R}^{N_s}` +:math:`f_y \equiv \partial f/\partial y \in \mathbb{R}^{N \times N}` is the Jacobian with respect to the dependent variable, +and :math:`f_p \equiv \partial f/\partial p \in \mathbb{R}^{N \times N_s}` is the Jacobian with respect to the parameters +(:math:`N` is the size of the original ODE, :math:`N_s` is the number of parameters). +When solved with a numerical time integration scheme, the solution to the continuous adjoint ODE +are numerical approximations of the continuous adjoint sensitivities + +.. math:: + \lambda(t_0) \approx g_y^T(y(t_0), p),\quad \mu(t_0) \approx g_p^T(y(t_0), p) + :label: ARKODE_CONTINUOUS_ADJOINT_SOLUTION + +For the discrete adjoint approach, we first numerically discretize the original ODE :eq:`ARKODE_IVP_simple_explicit`. +In the context of ARKODE, this is done with a one-step time integration scheme :math:`\varphi` so that + +.. math:: + y_0 = y(t_0),\quad y_n = \varphi(y_{n-1}). + :label: ARKODE_DISCRETE_ODE + +Reformulating the optimization problem for the discrete case, we have + +.. math:: + \min_{\xi} \Psi(\xi) = g(y_n, p) + :label: ARKODE_DISCRETE_OPTIMIZATION_PROBLEM + +The gradients of :eq:`ARKODE_DISCRETE_OPTIMIZATION_PROBLEM` can be computed using the transposed chain +rule backwards in time to obtain the discete adjoint variables :math:`\lambda_n, \lambda_{n-1}, \cdots, \lambda_0` +and :math:`\mu_n, \mu_{n-1}, \cdots, \mu_0`, + +.. math:: + \lambda_n &= g_y^T(y_n, p), \quad \lambda_k = \left(\frac{\partial \varphi}{\partial y_k}(y_k, p)\right)^T \lambda_{k+1} \\ + \mu_n &= g_p^T(y_n, p), \quad \mu_k = \left(\frac{\partial \varphi}{\partial p}(y_k, p)\right)^T \lambda_{k+1}, + \quad k = n - 1, \cdots, 0. + :label: ARKODE_DISCRETE_ADJOINT + +The solution of the discrete adjoint equations :eq:`ARKODE_DISCRETE_ADJOINT` is the sensitivities of the discrete cost function +:eq:`ARKODE_DISCRETE_OPTIMIZATION_PROBLEM` with respect to changes in the discretized ODE :eq:`ARKODE_DISCRETE_ODE`. + +.. math:: + \lambda_0 = g_y^T(y_0, p), \quad \mu_0 = g_p^T(y_0, p). + :label: ARKODE_DISCRETE_ADJOINT_SOLUTION + +Given an s-stage explicit Runge--Kutta method (as in :eq:`ARKODE_ERK`, but without the embedding), the discrete adjoint +to compute :math:`\lambda_n` and :math:`\mu_n` starting from :math:`\lambda_{n+1}` and +:math:`\mu_{n+1}` is given by + +.. math:: + \Lambda_i &= h_n f_y^T(t_{n,i}, z_i) \left(b_i \lambda_{n+1} + \sum_{j=i+1}^s a_{j,i} + \Lambda_j \right), \quad \quad i = s, \dots, 1,\\ + \nu_i &= h_n f_p^T(t_{n,i}, z_i, p) \left(b_i \lambda_{n+1} + \sum_{j=i}^{s} a_{ji} \Lambda_j \right), \\ + \lambda_n &= \lambda_{n+1} + \sum_{j=1}^{s} \Lambda_j, \\ + \mu_n &= \mu_{n+1} + \sum_{j=1}^{s} \nu_j. + :label: ARKODE_ERK_ADJOINT + +For more information on performing discrete adjoint sensitivity analysis using ARKODE see, +:numref:`ARKODE.Usage.ARKStep.ASA`. + +For a detailed derivation of the discrete adjoint methods see :cite:p:`hager2000runge,sanduDiscrete2006`. +For a detailed derivation of the continuous adjoint method see :ref:`CVODES `, +or :cite:p:`CLPS:03`. + + +Discrete vs. Continuous Adjoint Method +-------------------------------------- + +It is understood that the continuous adjoint method can be problematic in the context of +optimization problems because the continuous adjoint method provides an approximation to the +gradient of a continuous cost function while the optimizer is expecting the gradient of the discrete +cost function. The discrepancy means that the optimizer can fail to converge further once it is near +a local minimum :cite:p:`giles2000introduction`. On the other hand, the discrete adjoint method +provides the exact gradient of the discrete cost function allowing the optimizer to fully converge. +Consequently, the discrete adjoint method is often preferable in optimization despite its own +drawbacks -- such as its (relatively) increased memory usage and the possible introduction of +unphysical computational modes :cite:p:`sirkes1997finite`. This is not to say that the discrete +adjoint approach is always the better choice over the continuous adjoint approach in optimization. +Computational efficiency and stability of one approach over the other can be both problem and method +dependent. Section 8 in the paper :cite:p:`rackauckas2020universal` discusses the tradeoffs further +and provides numerous references that may help inform users in choosing between the discrete and +continuous adjoint approaches. diff --git a/doc/arkode/guide/source/Usage/ARKStep/ASA.rst b/doc/arkode/guide/source/Usage/ARKStep/ASA.rst new file mode 100644 index 0000000000..25e2b6454a --- /dev/null +++ b/doc/arkode/guide/source/Usage/ARKStep/ASA.rst @@ -0,0 +1,58 @@ +.. _ARKODE.Usage.ARKStep.ASA: + +Adjoint Sensitivity Analysis +============================ + +The previous sections discuss using ARKStep for the integration of forward ODE models. +This section discusses how to use ARKStep for adjoint sensitivity analysis as introduced +in :numref:`ARKODE.Mathematics.ASA`. To use ARKStep for adjoint sensitivity analysis (ASA), users simply setup the forward +integration as usual (following :numref:`ARKODE.Usage.Skeleton`) with one exception: +a :c:type:`SUNAdjointCheckpointScheme` object must be created and passed to +:c:func:`ARKodeSetAdjointCheckpointScheme` before the call to the :c:func:`ARKodeEvolve` +function. After the forward model integration code, a :c:type:`SUNAdjointStepper` object +can be created for the adjoint model integration by calling :c:func:`ARKStepCreateAdjointStepper`. +The code snippet below demonstrates these steps in brief and the example code +``examples/arkode/C_serial/ark_lotka_volterra_asa.c`` demonstrates these steps in detail. + +.. code-block:: C + + // 1. Create a SUNAdjointCheckpointScheme object + + // 2. Setup ARKStep for forward integration + + // 3. Attach the SUNAdjointCheckpointScheme + + // 4. Evolve the forward model + + // 5. Create the SUNAdjointStepper + + // 6. Setup the adjoint model + + // 7. Evolve the adjoint model + + // 8. Cleanup + + + +User Callable Functions +----------------------- + +This section describes ARKStep-specific user-callable functions for performing +adjoint sensitivity analysis with methods with ARKStep. + +.. c:function:: int ARKStepCreateAdjointStepper(void* arkode_mem, N_Vector sf, SUNAdjointStepper* adj_stepper_ptr) + + Creates a :c:type:`SUNAdjointStepper` object compatible with the provided ARKStep instance for + integrating the adjoint sensitivity system :eq:`ARKODE_DISCRETE_ADJOINT`. + + :param arkode_mem: a pointer to the ARKStep memory block. + :param sf: the sensitivity vector holding the adjoint system terminal condition. + This must be an instance of the ManyVector ``N_Vector`` implementation with at + least one subvector (depending on if sensitivities to parameters should be computed). + The first subvector must be :math:`\partial g_y(y(t_f)) \in \mathbb{R}^N`. If sensitivities to parameters should be computed, then the second subvector must be :math:`g_p(y(t_f), p) \in \mathbb{R}^{N_s}`. + :param adj_stepper_ptr: the newly created :c:type:`SUNAdjointStepper` object. + + :return: + * ``ARK_SUCCESS`` if successful + * ``ARK_MEM_FAIL`` if a memory allocation failed + * ``ARK_ILL_INPUT`` if an argument has an illegal value. diff --git a/doc/arkode/guide/source/Usage/ARKStep/User_callable.rst b/doc/arkode/guide/source/Usage/ARKStep/User_callable.rst index bef540030c..cc0e21aefa 100644 --- a/doc/arkode/guide/source/Usage/ARKStep/User_callable.rst +++ b/doc/arkode/guide/source/Usage/ARKStep/User_callable.rst @@ -35,6 +35,11 @@ ARKStep supports *all categories*: * non-identity mass matrices * relaxation Runge--Kutta methods +ARKStep also has forcing function support when converted to a +:c:type:`SUNStepper` or :c:type:`MRIStepInnerStepper`. See +:c:func:`ARKodeCreateSUNStepper` and :c:func:`ARKStepCreateMRIStepInnerStepper` +for additional details. + .. _ARKODE.Usage.ARKStep.Initialization: diff --git a/doc/arkode/guide/source/Usage/ARKStep/index.rst b/doc/arkode/guide/source/Usage/ARKStep/index.rst index 3edc8baf51..128686ea7d 100644 --- a/doc/arkode/guide/source/Usage/ARKStep/index.rst +++ b/doc/arkode/guide/source/Usage/ARKStep/index.rst @@ -30,3 +30,4 @@ are specific to ARKStep. User_callable Relaxation XBraid + ASA diff --git a/doc/arkode/guide/source/Usage/ERKStep/User_callable.rst b/doc/arkode/guide/source/Usage/ERKStep/User_callable.rst index 6c7b7b9cdf..958fe308c3 100644 --- a/doc/arkode/guide/source/Usage/ERKStep/User_callable.rst +++ b/doc/arkode/guide/source/Usage/ERKStep/User_callable.rst @@ -33,6 +33,10 @@ ERKStep supports the following categories: * temporal adaptivity * relaxation Runge--Kutta methods +ERKStep does not have forcing function support when converted to a +:c:type:`SUNStepper` or :c:type:`MRIStepInnerStepper`. See +:c:func:`ARKodeCreateSUNStepper` and :c:func:`ARKStepCreateMRIStepInnerStepper` +for additional details. .. _ARKODE.Usage.ERKStep.Initialization: diff --git a/doc/arkode/guide/source/Usage/MRIStep/Custom_Inner_Stepper/Description.rst b/doc/arkode/guide/source/Usage/MRIStep/Custom_Inner_Stepper/Description.rst index 523bd8a7be..f327d5a76c 100644 --- a/doc/arkode/guide/source/Usage/MRIStep/Custom_Inner_Stepper/Description.rst +++ b/doc/arkode/guide/source/Usage/MRIStep/Custom_Inner_Stepper/Description.rst @@ -79,6 +79,32 @@ Creating and Destroying an Object for details on how to attach member data and method function pointers. +.. c:function:: int MRIStepInnerStepper_CreateFromSUNStepper(SUNStepper sunstepper, MRIStepInnerStepper* stepper) + + This utility function wraps a :c:type:`SUNStepper` as an + :c:type:`MRIStepInnerStepper`. + + :param sunctx: the SUNDIALS simulation context. + :param sunstepper: the c:type:`SUNStepper` to wrap. + :param stepper: a pointer to an MRI inner stepper object. + + :retval ARK_SUCCESS: if successful + :retval ARK_MEM_FAIL: if a memory allocation error occurs + + **Example usage:** + + .. code-block:: C + + SUNStepper sunstepper = NULL; + SUNStepper_Create(ctx, &sunstepper); + /* Attach content and functions to the SUNStepper... */ + + MRIStepInnerStepper inner_stepper = NULL; + flag = MRIStepInnerStepper_CreateFromSUNStepper(sunstepper, &inner_stepper); + + .. versionadded:: x.y.z + + .. c:function:: int MRIStepInnerStepper_Free(MRIStepInnerStepper *stepper) This function destroys an :c:type:`MRIStepInnerStepper` object. diff --git a/doc/arkode/guide/source/Usage/MRIStep/User_callable.rst b/doc/arkode/guide/source/Usage/MRIStep/User_callable.rst index a6354a6037..3e587b7e36 100644 --- a/doc/arkode/guide/source/Usage/MRIStep/User_callable.rst +++ b/doc/arkode/guide/source/Usage/MRIStep/User_callable.rst @@ -33,6 +33,10 @@ MRIStep supports the following categories: * implicit nonlinear and/or linear solvers +MRIStep does not have forcing function support when converted to a +:c:type:`SUNStepper` or :c:type:`MRIStepInnerStepper`. See +:c:func:`ARKodeCreateSUNStepper` and :c:func:`ARKStepCreateMRIStepInnerStepper` +for additional details. .. _ARKODE.Usage.MRIStep.Initialization: diff --git a/doc/arkode/guide/source/Usage/SPRKStep/User_callable.rst b/doc/arkode/guide/source/Usage/SPRKStep/User_callable.rst index 73bde21f90..9696bbfb31 100644 --- a/doc/arkode/guide/source/Usage/SPRKStep/User_callable.rst +++ b/doc/arkode/guide/source/Usage/SPRKStep/User_callable.rst @@ -30,6 +30,11 @@ SPRKStep supports only the basic set of user-callable functions, and does not support any of the restricted groups (time adaptivity, implicit solvers, etc.). +SPRKStep does not have forcing function support when converted to a +:c:type:`SUNStepper` or :c:type:`MRIStepInnerStepper`. See +:c:func:`ARKodeCreateSUNStepper` and :c:func:`ARKStepCreateMRIStepInnerStepper` +for additional details. + .. _ARKODE.Usage.SPRKStep.Initialization: diff --git a/doc/arkode/guide/source/Usage/User_callable.rst b/doc/arkode/guide/source/Usage/User_callable.rst index 98de3a33b6..446838641c 100644 --- a/doc/arkode/guide/source/Usage/User_callable.rst +++ b/doc/arkode/guide/source/Usage/User_callable.rst @@ -867,29 +867,30 @@ Optional inputs for ARKODE .. cssclass:: table-bordered -================================================ ======================================= ======================= -Optional input Function name Default -================================================ ======================================= ======================= -Return ARKODE parameters to their defaults :c:func:`ARKodeSetDefaults` internal -Set integrator method order :c:func:`ARKodeSetOrder` 4 -Set dense output interpolation type (SPRKStep) :c:func:`ARKodeSetInterpolantType` ``ARK_INTERP_LAGRANGE`` -Set dense output interpolation type (others) :c:func:`ARKodeSetInterpolantType` ``ARK_INTERP_HERMITE`` -Set dense output polynomial degree :c:func:`ARKodeSetInterpolantDegree` 5 -Disable time step adaptivity (fixed-step mode) :c:func:`ARKodeSetFixedStep` disabled -Supply an initial step size to attempt :c:func:`ARKodeSetInitStep` estimated -Maximum no. of warnings for :math:`t_n+h = t_n` :c:func:`ARKodeSetMaxHnilWarns` 10 -Maximum no. of internal steps before *tout* :c:func:`ARKodeSetMaxNumSteps` 500 -Maximum absolute step size :c:func:`ARKodeSetMaxStep` :math:`\infty` -Minimum absolute step size :c:func:`ARKodeSetMinStep` 0.0 -Set a value for :math:`t_{stop}` :c:func:`ARKodeSetStopTime` undefined -Interpolate at :math:`t_{stop}` :c:func:`ARKodeSetInterpolateStopTime` ``SUNFALSE`` -Disable the stop time :c:func:`ARKodeClearStopTime` N/A -Supply a pointer for user data :c:func:`ARKodeSetUserData` ``NULL`` -Maximum no. of ARKODE error test failures :c:func:`ARKodeSetMaxErrTestFails` 7 -Set inequality constraints on solution :c:func:`ARKodeSetConstraints` ``NULL`` -Set max number of constraint failures :c:func:`ARKodeSetMaxNumConstrFails` 10 -================================================ ======================================= ======================= - +================================================= ========================================== ======================= +Optional input Function name Default +================================================= ========================================== ======================= +Return ARKODE parameters to their defaults :c:func:`ARKodeSetDefaults` internal +Set integrator method order :c:func:`ARKodeSetOrder` 4 +Set dense output interpolation type (SPRKStep) :c:func:`ARKodeSetInterpolantType` ``ARK_INTERP_LAGRANGE`` +Set dense output interpolation type (others) :c:func:`ARKodeSetInterpolantType` ``ARK_INTERP_HERMITE`` +Set dense output polynomial degree :c:func:`ARKodeSetInterpolantDegree` 5 +Disable time step adaptivity (fixed-step mode) :c:func:`ARKodeSetFixedStep` disabled +Supply an initial step size to attempt :c:func:`ARKodeSetInitStep` estimated +Maximum no. of warnings for :math:`t_n+h = t_n` :c:func:`ARKodeSetMaxHnilWarns` 10 +Maximum no. of internal steps before *tout* :c:func:`ARKodeSetMaxNumSteps` 500 +Maximum absolute step size :c:func:`ARKodeSetMaxStep` :math:`\infty` +Minimum absolute step size :c:func:`ARKodeSetMinStep` 0.0 +Set a value for :math:`t_{stop}` :c:func:`ARKodeSetStopTime` undefined +Interpolate at :math:`t_{stop}` :c:func:`ARKodeSetInterpolateStopTime` ``SUNFALSE`` +Disable the stop time :c:func:`ARKodeClearStopTime` N/A +Supply a pointer for user data :c:func:`ARKodeSetUserData` ``NULL`` +Maximum no. of ARKODE error test failures :c:func:`ARKodeSetMaxErrTestFails` 7 +Set inequality constraints on solution :c:func:`ARKodeSetConstraints` ``NULL`` +Set max number of constraint failures :c:func:`ARKodeSetMaxNumConstrFails` 10 +Set the checkpointing scheme to use (for adjoint) :c:func:`ARKodeSetAdjointCheckpointScheme` ``NULL`` +Set the checkpointing step index (for adjoint) :c:func:`ARKodeSetAdjointCheckpointIndex` 0 +================================================= ========================================== ======================= @@ -1397,6 +1398,34 @@ Set max number of constraint failures :c:func:`ARKodeSetMaxNumConstr .. versionadded:: 6.1.0 +.. c:function:: int ARKodeSetAdjointCheckpointScheme(void* arkode_mem, SUNAdjointCheckpointScheme checkpoint_scheme) + + Specifies the :c:type:`SUNAdjointCheckpointScheme` to use for saving states + during the forward integration, and loading states during backward integration + of an adjoint system. + + :param arkode_mem: pointer to the ARKODE memory block. + :param checkpoint_scheme: the checkpoint scheme to use. + + :retval ARK_SUCCESS: the function exited successfully. + :retval ARK_MEM_NULL: ``arkode_mem`` was ``NULL``. + + .. versionadded:: x.y.z + +.. c:function:: int ARKodeSetAdjointCheckpointIndex(void* arkode_mem, int64_t step_index) + + Specifies the step index (that is step number) to insert the next checkpoint at. + This is incremented along with the step count, but it is useful to be able to reset + this index during recomputations of missing states during the backward adjoint integration. + + :param arkode_mem: pointer to the ARKODE memory block. + :param step_idx: the step to insert the next checkpoint at. + + :retval ARK_SUCCESS: the function exited successfully. + :retval ARK_MEM_NULL: ``arkode_mem`` was ``NULL``. + + .. versionadded:: x.y.z + .. _ARKODE.Usage.ARKodeAdaptivityInputTable: @@ -4719,3 +4748,31 @@ rescale the upcoming time step by the specified factor. If a value * ``examples/arkode/C_serial/ark_heat1D_adapt.c`` .. versionadded:: 6.1.0 + + + +.. _ARKODE.Usage.SUNStepperInterface: + +Using an ARKODE solver as a SUNStepper +-------------------------------------- + +The utility function :c:func:`ARKodeCreateSUNStepper` wraps an ARKODE memory +block as a :c:type:`SUNStepper`. + +.. c:function:: int ARKodeCreateSUNStepper(void *inner_arkode_mem, SUNStepper *stepper) + + Wraps an ARKODE integrator as a :c:type:`SUNStepper`. + + :param arkode_mem: pointer to the ARKODE memory block. + :param stepper: the :c:type:`SUNStepper` object. + + :retval ARK_SUCCESS: the function exited successfully. + :retval ARK_MEM_FAIL: a memory allocation failed. + :retval ARK_SUNSTEPPER_ERR: the :c:type:`SUNStepper` initialization failed. + + .. warning:: + Currently, ``stepper`` will be equipped with an implementation for the + :c:func:`SUNStepper_SetForcing` function only if ``inner_arkode_mem`` is + an ARKStep integrator. + + .. versionadded:: x.y.z diff --git a/doc/arkode/guide/source/index.rst b/doc/arkode/guide/source/index.rst index e809010fd0..2fda4fdca8 100644 --- a/doc/arkode/guide/source/index.rst +++ b/doc/arkode/guide/source/index.rst @@ -65,6 +65,8 @@ with support by the `US Department of Energy `_, sunlinsol/index.rst sunnonlinsol/index.rst sunadaptcontroller/index.rst + sunstepper/index.rst + sunadjoint/index.rst sunmemory/index.rst sundials/Install_link.rst Constants diff --git a/doc/arkode/guide/source/sunadjoint/SUNAdjoint_links.rst b/doc/arkode/guide/source/sunadjoint/SUNAdjoint_links.rst new file mode 100644 index 0000000000..c006c1f2a0 --- /dev/null +++ b/doc/arkode/guide/source/sunadjoint/SUNAdjoint_links.rst @@ -0,0 +1,14 @@ +.. ---------------------------------------------------------------- + SUNDIALS Copyright Start + Copyright (c) 2002-2024, 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 + ---------------------------------------------------------------- + +.. include:: ../../../../shared/sunadjoint/SUNAdjointCheckpointScheme.rst +.. include:: ../../../../shared/sunadjoint/SUNAdjointStepper.rst diff --git a/doc/arkode/guide/source/sunadjoint/index.rst b/doc/arkode/guide/source/sunadjoint/index.rst new file mode 100644 index 0000000000..a14998fd3b --- /dev/null +++ b/doc/arkode/guide/source/sunadjoint/index.rst @@ -0,0 +1,19 @@ +.. + ---------------------------------------------------------------- + SUNDIALS Copyright Start + Copyright (c) 2002-2024, 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 + ---------------------------------------------------------------- + +.. include:: ../../../../shared/sunadjoint/SUNAdjoint_Introduction.rst + +.. toctree:: + :maxdepth: 1 + + SUNAdjoint_links.rst diff --git a/doc/arkode/guide/source/sunmemory/SUNMemory_links.rst b/doc/arkode/guide/source/sunmemory/SUNMemory_links.rst index 2316e91e6e..35bb6be436 100644 --- a/doc/arkode/guide/source/sunmemory/SUNMemory_links.rst +++ b/doc/arkode/guide/source/sunmemory/SUNMemory_links.rst @@ -11,6 +11,7 @@ ---------------------------------------------------------------- .. include:: ../../../../shared/sunmemory/SUNMemory_Description.rst +.. include:: ../../../../shared/sunmemory/SUNMemory_System.rst .. include:: ../../../../shared/sunmemory/SUNMemory_CUDA.rst .. include:: ../../../../shared/sunmemory/SUNMemory_HIP.rst .. include:: ../../../../shared/sunmemory/SUNMemory_SYCL.rst diff --git a/doc/arkode/guide/source/sunstepper/SUNStepper_links.rst b/doc/arkode/guide/source/sunstepper/SUNStepper_links.rst new file mode 100644 index 0000000000..938c5f5d9d --- /dev/null +++ b/doc/arkode/guide/source/sunstepper/SUNStepper_links.rst @@ -0,0 +1,14 @@ +.. ---------------------------------------------------------------- + SUNDIALS Copyright Start + Copyright (c) 2002-2024, 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 + ---------------------------------------------------------------- + +.. include:: ../../../../shared/sunstepper/SUNStepper_Description.rst +.. include:: ../../../../shared/sunstepper/SUNStepper_Implementing.rst diff --git a/doc/arkode/guide/source/sunstepper/index.rst b/doc/arkode/guide/source/sunstepper/index.rst new file mode 100644 index 0000000000..86e89bd4c0 --- /dev/null +++ b/doc/arkode/guide/source/sunstepper/index.rst @@ -0,0 +1,20 @@ +.. ---------------------------------------------------------------- + Programmer(s): Steven B. Roberts @ LLNL + ---------------------------------------------------------------- + SUNDIALS Copyright Start + Copyright (c) 2002-2024, 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 + ---------------------------------------------------------------- + +.. include:: ../../../../shared/sunstepper/SUNStepper_Structure.rst + +.. toctree:: + :maxdepth: 1 + + SUNStepper_links.rst diff --git a/doc/cvode/guide/source/sunmemory/SUNMemory_links.rst b/doc/cvode/guide/source/sunmemory/SUNMemory_links.rst index 2316e91e6e..35bb6be436 100644 --- a/doc/cvode/guide/source/sunmemory/SUNMemory_links.rst +++ b/doc/cvode/guide/source/sunmemory/SUNMemory_links.rst @@ -11,6 +11,7 @@ ---------------------------------------------------------------- .. include:: ../../../../shared/sunmemory/SUNMemory_Description.rst +.. include:: ../../../../shared/sunmemory/SUNMemory_System.rst .. include:: ../../../../shared/sunmemory/SUNMemory_CUDA.rst .. include:: ../../../../shared/sunmemory/SUNMemory_HIP.rst .. include:: ../../../../shared/sunmemory/SUNMemory_SYCL.rst diff --git a/doc/cvodes/guide/source/sunmemory/SUNMemory_links.rst b/doc/cvodes/guide/source/sunmemory/SUNMemory_links.rst index 2316e91e6e..35bb6be436 100644 --- a/doc/cvodes/guide/source/sunmemory/SUNMemory_links.rst +++ b/doc/cvodes/guide/source/sunmemory/SUNMemory_links.rst @@ -11,6 +11,7 @@ ---------------------------------------------------------------- .. include:: ../../../../shared/sunmemory/SUNMemory_Description.rst +.. include:: ../../../../shared/sunmemory/SUNMemory_System.rst .. include:: ../../../../shared/sunmemory/SUNMemory_CUDA.rst .. include:: ../../../../shared/sunmemory/SUNMemory_HIP.rst .. include:: ../../../../shared/sunmemory/SUNMemory_SYCL.rst diff --git a/doc/ida/guide/source/sunmemory/SUNMemory_links.rst b/doc/ida/guide/source/sunmemory/SUNMemory_links.rst index 2316e91e6e..35bb6be436 100644 --- a/doc/ida/guide/source/sunmemory/SUNMemory_links.rst +++ b/doc/ida/guide/source/sunmemory/SUNMemory_links.rst @@ -11,6 +11,7 @@ ---------------------------------------------------------------- .. include:: ../../../../shared/sunmemory/SUNMemory_Description.rst +.. include:: ../../../../shared/sunmemory/SUNMemory_System.rst .. include:: ../../../../shared/sunmemory/SUNMemory_CUDA.rst .. include:: ../../../../shared/sunmemory/SUNMemory_HIP.rst .. include:: ../../../../shared/sunmemory/SUNMemory_SYCL.rst diff --git a/doc/idas/guide/source/sunmemory/SUNMemory_links.rst b/doc/idas/guide/source/sunmemory/SUNMemory_links.rst index 2316e91e6e..35bb6be436 100644 --- a/doc/idas/guide/source/sunmemory/SUNMemory_links.rst +++ b/doc/idas/guide/source/sunmemory/SUNMemory_links.rst @@ -11,6 +11,7 @@ ---------------------------------------------------------------- .. include:: ../../../../shared/sunmemory/SUNMemory_Description.rst +.. include:: ../../../../shared/sunmemory/SUNMemory_System.rst .. include:: ../../../../shared/sunmemory/SUNMemory_CUDA.rst .. include:: ../../../../shared/sunmemory/SUNMemory_HIP.rst .. include:: ../../../../shared/sunmemory/SUNMemory_SYCL.rst diff --git a/doc/kinsol/guide/source/sunmemory/SUNMemory_links.rst b/doc/kinsol/guide/source/sunmemory/SUNMemory_links.rst index 2316e91e6e..35bb6be436 100644 --- a/doc/kinsol/guide/source/sunmemory/SUNMemory_links.rst +++ b/doc/kinsol/guide/source/sunmemory/SUNMemory_links.rst @@ -11,6 +11,7 @@ ---------------------------------------------------------------- .. include:: ../../../../shared/sunmemory/SUNMemory_Description.rst +.. include:: ../../../../shared/sunmemory/SUNMemory_System.rst .. include:: ../../../../shared/sunmemory/SUNMemory_CUDA.rst .. include:: ../../../../shared/sunmemory/SUNMemory_HIP.rst .. include:: ../../../../shared/sunmemory/SUNMemory_SYCL.rst diff --git a/doc/shared/RecentChanges.rst b/doc/shared/RecentChanges.rst index 2be479f59c..8543df881c 100644 --- a/doc/shared/RecentChanges.rst +++ b/doc/shared/RecentChanges.rst @@ -2,6 +2,19 @@ **New Features and Enhancements** +Added the :c:type:`SUNStepper` base class to represent a generic solution +procedure for IVPs. + +.. This is used by the +.. :ref:`SplittingStep ` and +.. :ref:`ForcingStep ` modules of ARKODE. + +A SUNStepper +can be created from an ARKODE memory block with the new function +:c:func:`ARKodeCreateSUNStepper`. To enable interoperability with +:c:type:`MRIStepInnerStepper`, the function +:c:func:`MRIStepInnerStepper_CreateFromSUNStepper` was added. + The following DIRK schemes now have coefficients accurate to quad precision: * ``ARKODE_BILLINGTON_3_3_2`` diff --git a/doc/shared/figs/sunadjoint_ckpt_fixed.png b/doc/shared/figs/sunadjoint_ckpt_fixed.png new file mode 100644 index 0000000000..faa7e03fc4 Binary files /dev/null and b/doc/shared/figs/sunadjoint_ckpt_fixed.png differ diff --git a/doc/shared/sunadjoint/SUNAdjointCheckpointScheme.rst b/doc/shared/sunadjoint/SUNAdjointCheckpointScheme.rst new file mode 100644 index 0000000000..efe1031323 --- /dev/null +++ b/doc/shared/sunadjoint/SUNAdjointCheckpointScheme.rst @@ -0,0 +1,231 @@ +.. ---------------------------------------------------------------- + SUNDIALS Copyright Start + Copyright (c) 2002-2024, 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 + ---------------------------------------------------------------- + +.. _SUNAdjoint.CheckpointScheme: + +The SUNAdjointCheckpointScheme API +================================== + +.. versionadded:: x.y.z + +The :c:type:`SUNAdjointCheckpointScheme` base class provides an interface for checkpointing +states during forward integration and accessing them as needed during the backwards integration +of the adjoint model. + +.. c:enum:: SUNDataIOMode + +.. c:enumerator:: SUNDATAIOMODE_INMEM + + The IO mode for data that is stored in addressable random access memory. + The location of the memory (e.g., CPU or GPU) is not specified by this mode. + + +A :c:type:`SUNAdjointCheckpointScheme` is a pointer to the +:c:struct:`SUNAdjointCheckpointScheme_` structure: + +.. c:type:: struct SUNAdjointCheckpointScheme_ *SUNAdjointCheckpointScheme + +.. c:struct:: SUNAdjointCheckpointScheme_ + + .. c:member:: SUNAdjointCheckpointScheme_Ops ops + + The ops structure holds the vtable of function pointers for the base class. + + .. c:member:: void* content + + Pointer to derived class specific member data. + + .. c:member:: SUNContext sunctx + + The SUNDIALS simulation context. + + +.. c:type:: struct SUNAdjointCheckpointScheme_Ops_ *SUNAdjointCheckpointScheme_Ops + + +.. c:struct:: SUNAdjointCheckpointScheme_Ops_ + + .. c:member:: SUNErrCode (*shouldWeSave)(SUNAdjointCheckpointScheme cs, int64_t step_num, int64_t stage_num, sunrealtype t, sunbooleantype* yes_or_no) + + Function pointer to determine if a checkpoint should be saved at the current timestep. + + .. c:member:: SUNErrCode (*shouldWeDelete)(SUNAdjointCheckpointScheme cs, int64_t step_num, int64_t stage_num, sunbooleantype* yes_or_no) + + Function pointer to determine if a checkpoint should be deleted at the current timestep. + + .. c:member:: SUNErrCode (*insertVector)(SUNAdjointCheckpointScheme cs, int64_t step_num, int64_t stage_num, sunrealtype t, N_Vector state) + + Function pointer to insert a checkpoint state represented as a :c:type:`N_Vector`. + + .. c:member:: SUNErrCode (*loadVector)(SUNAdjointCheckpointScheme cs, int64_t step_num, int64_t stage_num, sunbooleantype peek, N_Vector* out, sunrealtype* tout) + + Function pointer to load a checkpoint state represented as a :c:type:`N_Vector`. + + .. c:member:: SUNErrCode (*removeVector)(SUNAdjointCheckpointScheme cs, int64_t step_num, int64_t stage_num, N_Vector* out) + + Function pointer to remove a checkpoint state represented as a :c:type:`N_Vector`. + + .. c:member:: SUNErrCode (*destroy)(SUNAdjointCheckpointScheme*) + + Function pointer to destroy and free the memory for the :c:type:`SUNAdjointCheckpointScheme` object. + + .. c:member:: SUNErrCode (*enableDense)(SUNAdjointCheckpointScheme cs, sunbooleantype on_or_off) + + Function pointer to enable or disable dense checkpointing, saving all steps. + + +.. c:function:: SUNErrCode SUNAdjointCheckpointScheme_NewEmpty(SUNContext sunctx, \ + SUNAdjointCheckpointScheme* cs_ptr) + + Allocates a new object but without any content. + + :param sunctx: The SUNDIALS simulation context + :param cs_ptr: on output, the pointer to the new :c:type:`SUNAdjointCheckpointScheme` object + + :return: A :c:type:`SUNErrCode` indicating failure or success. + +.. c:function:: SUNErrCode SUNAdjointCheckpointScheme_ShouldWeSave(SUNAdjointCheckpointScheme cs, \ + int64_t step_num, int64_t stage_num, sunrealtype t, sunbooleantype* yes_or_no) + + Determines if the (step_num, stage_num) should be checkpointed or not. + + :param cs: The :c:type:`SUNAdjointCheckpointScheme` object + :param step_num: the step number of the checkpoint + :param stage_num: the stage number of the checkpoint + :param t: the time of the checkpoint + :param yes_or_no: boolean indicating if the checkpoint should be saved or not + + :return: A :c:type:`SUNErrCode` indicating failure or success. + +.. c:function:: SUNErrCode SUNAdjointCheckpointScheme_ShouldWeDelete(SUNAdjointCheckpointScheme cs, \ + int64_t step_num, int64_t stage_num, sunbooleantype* yes_or_no) + + Determines if the (step_num, stage_num) checkpoint should be deleted or not. + + :param cs: The :c:type:`SUNAdjointCheckpointScheme` object + :param step_num: the step number of the checkpoint + :param stage_num: the stage number of the checkpoint + :param t: the time of the checkpoint + :param yes_or_no: boolean indicating if the checkpoint should be deleted or not + + :return: A :c:type:`SUNErrCode` indicating failure or success. + +.. c:function:: SUNErrCode SUNAdjointCheckpointScheme_InsertVector(SUNAdjointCheckpointScheme cs, \ + int64_t step_num, int64_t stage_num, sunrealtype t, N_Vector state) + + Inserts the vector as the checkpoint for (step_num, stage_num). + + :param cs: The :c:type:`SUNAdjointCheckpointScheme` object + :param step_num: the step number of the checkpoint + :param stage_num: the stage number of the checkpoint + :param t: the time of the checkpoint + :param state: the state vector to checkpoint + + :return: A :c:type:`SUNErrCode` indicating failure or success. + +.. c:function:: SUNErrCode SUNAdjointCheckpointScheme_LoadVector(SUNAdjointCheckpointScheme cs, \ + int64_t step_num, int64_t stage_num, sunbooleantype peek, N_Vector* out, sunrealtype* tout) + + Loads the checkpointed vector for (step_num, stage_num). + + :param cs: The :c:type:`SUNAdjointCheckpointScheme` object + :param step_num: the step number of the checkpoint + :param stage_num: the stage number of the checkpoint + :param peek: if true, then the checkpoint will be loaded but not deleted regardless + of other implementation-specific settings. If false, then the checkpoint may be + deleted depending on the implementation. + :param out: the loaded state vector + :param tout: on output, the time of the checkpoint + + :return: A :c:type:`SUNErrCode` indicating failure or success. + +.. c:function:: SUNErrCode SUNAdjointCheckpointScheme_RemoveVector(SUNAdjointCheckpointScheme cs, \ + int64_t step_num, int64_t stage_num, N_Vector* out) + + Removes the checkpointed vector for (step_num, stage_num). + + :param cs: The :c:type:`SUNAdjointCheckpointScheme` object + :param step_num: the step number of the checkpoint + :param stage_num: the stage number of the checkpoint + :param out: the loaded state vector + + :return: A :c:type:`SUNErrCode` indicating failure or success. + +.. c:function:: SUNErrCode SUNAdjointCheckpointScheme_EnableDense(SUNAdjointCheckpointScheme cs, \ + sunbooleantype on_or_off) + + Enables or disables dense checkpointing (checkpointing every step/stage). + + :param cs: The :c:type:`SUNAdjointCheckpointScheme` object + :param on_or_off: if true, dense checkpointing will be turned on, if false it will be turned off. + + :return: A :c:type:`SUNErrCode` indicating failure or success. + +.. c:function:: SUNErrCode SUNAdjointCheckpointScheme_Destroy(SUNAdjointCheckpointScheme* cs_ptr) + + Destroys (deallocates) the SUNAdjointCheckpointScheme object. + + :param cs_ptr: pointer to a :c:type:`SUNAdjointCheckpointScheme` object + + :return: A :c:type:`SUNErrCode` indicating failure or success. + + +.. _SUNAdjoint.CheckpointScheme.Fixed: + +The SUNAdjointCheckpointScheme_Fixed Module +=========================================== + +The SUNAdjointCheckpointScheme_Fixed module implements a scheme where a checkpoint is saved at some +fixed interval (in timesteps). The module supports checkpointing of time step states only, or timestep +states with intermediate stage states as well (for multistage methods). When used with a +fixed timestep size then the number of checkpoints that will be saved is fixed. However, with +adaptive timesteps the number of checkpoints stored with this scheme is unbounded. + +The diagram below illustrates how checkpoints are stored with this scheme: + +.. figure:: /figs/sunadjoint_ckpt_fixed.png + :width: 75 % + :align: center + + +Base-class Method Overrides +^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +The ``SUNAdjointCheckpointScheme_Fixed`` module implements the following :c:type:`SUNAdjointCheckpointScheme` functions: + +* :c:func:`SUNAdjointCheckpointScheme_ShouldWeSave` +* :c:func:`SUNAdjointCheckpointScheme_InsertVector` +* :c:func:`SUNAdjointCheckpointScheme_ShouldWeDelete` +* :c:func:`SUNAdjointCheckpointScheme_RemoveVector` +* :c:func:`SUNAdjointCheckpointScheme_LoadVector` +* :c:func:`SUNAdjointCheckpointScheme_Destroy` +* :c:func:`SUNAdjointCheckpointScheme_EnableDense` + + +Implementation Specific Methods +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +The ``SUNAdjointCheckpointScheme_Fixed`` module also implements the following module-specific functions: + +.. c:function:: SUNErrCode SUNAdjointCheckpointScheme_Create_Fixed(SUNDataIOMode io_mode, SUNMemoryHelper mem_helper, int64_t interval, int64_t estimate, sunbooleantype save_stages, sunbooleantype keep, SUNContext sunctx, SUNAdjointCheckpointScheme* check_scheme_ptr) + + Creates a new :c:type:`SUNAdjointCheckpointScheme` object that checkpoints at a fixed interval. + + :param io_mode: The IO mode used for storing the checkpoints. + :param mem_helper: Memory helper for managing memory. + :param interval: The interval (in steps) between checkpoints. + :param estimate: An estimate of the total number of checkpoints needed. + :param save_stages: If using a multistage method, should stages be saved with the step. + :param keep: Keep data stored even after it is not needed anymore. + :param sunctx: The :c:type:`SUNContext` for the simulation. + :param check_scheme_ptr: Pointer to the newly constructed object. + :return: A :c:type:`SUNErrCode` indicating success or failure. diff --git a/doc/shared/sunadjoint/SUNAdjointStepper.rst b/doc/shared/sunadjoint/SUNAdjointStepper.rst new file mode 100644 index 0000000000..1055522911 --- /dev/null +++ b/doc/shared/sunadjoint/SUNAdjointStepper.rst @@ -0,0 +1,256 @@ +.. + ---------------------------------------------------------------- + SUNDIALS Copyright Start + Copyright (c) 2002-2024, 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 + ---------------------------------------------------------------- + +.. _SUNAdjoint.Stepper: + +The SUNAdjointStepper API +========================= + +.. versionadded:: x.y.z + +The :c:type:`SUNAdjointStepper` API provides a package-agnostic interface to SUNDIALS ASA +capabilities. It currently only supports the discrete ASA capabilities in the ARKODE +package, but in the future this support may be expanded. + +A :c:type:`SUNAdjointStepper` is a pointer to the +:c:struct:`SUNAdjointStepper_` structure: + +.. c:type:: struct SUNAdjointStepper_ *SUNAdjointStepper + +.. c:struct:: SUNAdjointStepper_ + + .. c:member:: SUNStepper adj_sunstepper + + The :c:type:`SUNStepper` object used for backwards time stepping of the adjoint ODE system. + + .. c:member:: SUNStepper fwd_sunstepper + + The :c:type:`SUNStepper` object used for forward time stepping of the original ODE system if any recomputation of missing + state data is required during the backwards integration. + + .. c:member:: sunrealtype tf + + The terminal time of the backwards adjoint ODE. + + .. c:member:: int64_t step_idx + + The index of the current backward integration step with respect to the forward integration. + + .. c:member:: int64_t final_step_idx + + The index of the final step in the forward integration (corresponds to ``tf``). + + .. c:member:: SUNMatrix Jac + + Matrix data for the Jacobian :math:`df/dy`. + + .. c:member:: SUNMatrix JacP + + Matrix data for the Jacobian :math:`df/dp`. + + .. c:member:: SUNRhsJacFn JacFn + + Jacobian function pointer to evaluate :math:`df/dy`. + + .. c:member:: SUNRhsJacFn JacPFn + + Jacobian function pointer to evaluate :math:`df/dp`. + + .. c:member:: SUNRhsJacTimesFn JvpFn + + Jacobian-times-vector function pointer to evaluate :math:`(df/dy)^T v`. + + .. c:member:: SUNRhsJacTimesFn JPvpFn + + Jacobian-times-vector function pointer to evaluate :math:`(df/dp)^T v`. + + .. c:member:: SUNRhsJacTimesFn vJpFn + + Jacobian-times-vector function pointer to evaluate :math:`v^T(df/dy)`. + + .. c:member:: SUNRhsJacTimesFn vJPpFn + + Jacobian-times-vector function pointer to evaluate :math:`v^T(df/dp)`. + + .. c:member:: int64_t nst + + Holds the count of the number of backwards steps taken. + + .. c:member:: int64_t njeval + + Holds the count of the number of :math:`df/dy` evaluations. + + .. c:member:: int64_t njpeval + + Holds the count of the number of :math:`df/dp` evaluations. + + .. c:member:: int64_t njtimesv + + Holds the count of the number of :math:`(df/dy)^T v` evaluations. + + .. c:member:: int64_t njptimesv + + Holds the count of the number of :math:`(df/dp)^T v` evaluations. + + .. c:member:: int64_t nvtimesj + + Holds the count of the number of :math:`v^T(df/dy)` evaluations. + + .. c:member:: int64_t nvtimesjp + + Holds the count of the number of :math:`v^T(df/dp)` evaluations. + + .. c:member:: int64_t nrecompute + + .. c:member:: void* user_data + + A pointer that is passed back to user-supplied functions + + .. c:member:: void* content + + Pointer to derived class specific member data + + .. c:member:: SUNContext sunctx + + The SUNDIALS simulation context + + +The :c:type:`SUNAdjointStepper` class has the following functions: + +.. c:function:: SUNErrCode SUNAdjointStepper_Create(SUNStepper fwd_sunstepper, SUNStepper adj_sunstepper, \ + int64_t final_step_idx, N_Vector sf, sunrealtype tf, SUNAdjointCheckpointScheme checkpoint_scheme, \ + SUNContext sunctx, SUNAdjointStepper* adj_stepper) + + Creates the ``SUNAdjointStepper`` object needed to solve the adjoint problem. + + :param fwd_sunstepper: The :c:type:`SUNStepper` to be used for forward computations of the original ODE. + :param adj_sunstepper: The :c:type:`SUNStepper` to be usef for the backward integration of the adjoint ODE. + :param final_step_idx: The index (step number) of the step corresponding to ``t_f`` for the forward ODE. + :param sf: The terminal condition for the adjoint ODE. + :param tf: The terminal time for the forward ODE and (which is the initial time for the adjoint ODE). + :param checkpoint_scheme: The :c:type:`SUNAdjointCheckpointScheme` object that determines the checkpointing strategy to use. This should be the same scheme provided to the forward integrator/stepper. + :param sunctx: The :c:type:`SUNContext` for the simulation context. + + +.. c:function:: SUNErrCode SUNAdjointStepper_ReInit(SUNAdjointStepper adj, N_Vector sf, sunrealtype tf) + + Reinitializes the adjoint stepper to solve a new problem of the same size. + + :param adj_stepper: The adjoint solver object. + :param sf: The terminal condition vector of sensitivity solutions :math:`dg/dy_0`` and :math:`dg/dp`. + :param tf: The time to start integrating the adjoint system from. + + :return: A :c:type:`SUNErrCode` indicating failure or success. + + +.. c:function:: SUNErrCode SUNAdjointStepper_Evolve(SUNAdjointStepper adj_stepper, sunrealtype tout,\ + N_Vector sens, sunrealtype* tret) + + Integrates the adjoint system. + + :param adj_stepper: The adjoint solver object. + :param tout: The time at which the adjoint solution is desired. + :param sens: The vector of sensitivity solutions :math:`dg/dy_0`` and :math:`dg/dp`. + :param tret: On return, the time reached by the adjoint solver. + + :return: A :c:type:`SUNErrCode` indicating failure or success. + + +.. c:function:: SUNErrCode SUNAdjointStepper_OneStep(SUNAdjointStepper adj_stepper, sunrealtype tout,\ + N_Vector sens, sunrealtype* tret) + + Evolves the adjoint system backwards one step. + + :param adj_stepper: The adjoint solver object. + :param tout: The time at which the adjoint solution is desired. + :param sens: The vector of sensitivity solutions :math:`dg/dy_0` and :math:`dg/dp`. + :param tret: On return, the time reached by the adjoint solver. + + :return: A :c:type:`SUNErrCode` indicating failure or success. + + +.. c:function:: SUNErrCode SUNAdjointStepper_RecomputeFwd(SUNAdjointStepper adj_stepper, int64_t start_idx,\ + sunrealtype t0, sunrealtype tf, N_Vector y0) + + Evolves the forward system in time from (``start_idx``, ``t0``) to (``stop_idx``, ``tf``) with dense checkpointing. + + :param adj_stepper: The SUNAdjointStepper object. + :param start_idx: the index of the step, w.r.t. the original forward integration, to begin forward integration from. + :param t0: the initial time, w.r.t. the original forward integration, to start forward integration from. + :param tf: the final time, w.r.t. the original forward integration, to stop forward integration. + :param y0: the initial state, w.r.t. the original forward integration, to start forward integration. + + :return: A :c:type:`SUNErrCode` indicating failure or success. + + +.. c:function:: SUNErrCode SUNAdjointStepper_SetJacFn(SUNAdjointStepper adj_stepper, SUNRhsJacFn JacFn, \ + SUNMatrix Jac, SUNRhsJacFn JacPFn, SUNMatrix JacP) + + Sets the function pointers and matrices needed to evaluate and store :math:`df/dy` and + :math:`df/dp`. ``Jac`` should have dimensions ``neq x neq`` where ``neq`` is the number of states + in the forward problem. ``JacP`` should have dimensions ``nparams x neq`` where ``nparams`` is the + number of parameters in the model to get sensitivities for. + + :param adj_stepper: The SUNAdjointStepper object. + :param JacFn: the function that evaluates :math:`df/dy`. + :param Jac: a :c:type:`SUNMatrix` that will hold :math:`df/dy`. + :param JacPFn: the function that evaluates :math:`df/dp`. + :param JacP: a :c:type:`SUNMatrix` that will hold :math:`df/dp`. + + :return: A :c:type:`SUNErrCode` indicating failure or success. + +.. c:function:: SUNErrCode SUNAdjointStepper_SetVecTimesJacFn(SUNAdjointStepper adj_stepper, SUNRhsJacTimesFn Jvp, SUNRhsJacTimesFn JPvp) + + + Sets the function pointers to evaluate :math:`(df/dy)^T v` and :math:`(df/dp)^T v` + + :param adj_stepper: The SUNAdjointStepper object. + :param Jvp: function that evaluates :math:`(df/dy)^T v`. + :param JPvp: function that evaluates :math:`(df/dp)^T v`. + + :return: A :c:type:`SUNErrCode` indicating failure or success. + + +.. c:function:: SUNErrCode SUNAdjointStepper_SetJacTimesVecFn(SUNAdjointStepper adj_stepper, SUNRhsJacTimesFn Jvp, SUNRhsJacTimesFn JPvp) + + + Sets the function pointers to evaluate :math:`v^T (df/dy)` and :math:`v^T (df/dp)` + + :param adj_stepper: The SUNAdjointStepper object. + :param Jvp: function that evaluates :math:`v^T (df/dy)`. + :param JPvp: function that evaluates :math:`v^T (df/dp)`. + + :return: A :c:type:`SUNErrCode` indicating failure or success. + + +.. c:function:: SUNErrCode SUNAdjointStepper_SetUserData(SUNAdjointStepper adj_stepper, void* user_data) + + Sets the user data pointer. + + :param adj_stepper: The SUNAdjointStepper object. + :param user_data: the user data pointer that will be passed back to user-supplied callback functions. + + :return: A :c:type:`SUNErrCode` indicating failure or success. + + +.. c:function:: SUNErrCode SUNAdjointStepper_PrintAllStats(SUNAdjointStepper adj_stepper, \ + FILE* outfile, SUNOutputFormat fmt) + + Prints the adjoint stepper statistics/counters in a human-readable table format or CSV format. + + :param adj_stepper: The SUNAdjointStepper object. + :param outfile: A file to write the output to. + :param fmt: the format to write in (:c:type:`SUN_OUTPUTFORMAT_TABLE` or :c:type:`SUN_OUTPUTFORMAT_CSV`). + + :return: A :c:type:`SUNErrCode` indicating failure or success. + diff --git a/doc/shared/sunadjoint/SUNAdjoint_Introduction.rst b/doc/shared/sunadjoint/SUNAdjoint_Introduction.rst new file mode 100644 index 0000000000..bb6fde253a --- /dev/null +++ b/doc/shared/sunadjoint/SUNAdjoint_Introduction.rst @@ -0,0 +1,86 @@ + +.. _SUNAdjoint: + +############################ +Adjoint Sensitivity Analysis +############################ + +This section presents the ``SUNAdjointStepper`` and ``SUNAdjointCheckpointScheme`` classes. +The ``SUNAdjointStepper`` represents a generic adjoint sensitivity analysis (ASA) procedure +to obtain the adjoint sensitivities of an IVP of the form + +.. math:: + \dot{y}(t) = f(t, y, p), \qquad y(t_0) = y_0, \qquad y \in \mathbb{R}^N, + :label: SUNADJOINT_IVP + +where :math:`p` is some set of :math:`N_s` problem parameters. + +.. note:: + The API itself does not implement ASA, but it provides a common + interface for ASA capabilities implemented in the SUNDIALS packages. Right now it supports :ref:`the + ASA capabilities in ARKODE `, while the ASA capabilities in :ref:`CVODES + ` and :ref:`IDAS ` must be used directly. + +Suppose we have a functional :math:`g(y(t_f),p)` for which we would like to compute the gradients +:math:`\partial g(y(t_f),p)/\partial y(t_0)` and/or :math:`\partial g(y(t_f),p)/\partial p`. This +most often arises in the form of an optimization problem such as + +.. math:: + \min_{\xi} \bar{\Psi}(\xi) = g(y(t_f), p) + :label: SUNADJOINT_OPTIMIZATION_PROBLEM + +where :math:`\xi \subset \{y(t_0), p\}`. The adjoint method is one approach to obtaining the +gradients that is particularly efficient when there are relatively few functionals and a large +number of parameters. While :ref:`CVODES ` and +:ref:`IDAS ` *continuous* adjoint methods +(differentiate-then-discretize), ARKODE provides *discrete* adjoint methods +(discretize-then-differentiate). For the continuous approach, we derive and solve the adjoint IVP +backwards in time + +.. math:: + \lambda'(t) &= -f_y^T(t, y, p) \lambda,\quad \lambda(t_F) = g_y^T(y(t_f), p), \\ + \mu'(t) &= -f_p^T(t, y, p) \mu,\quad \mu(t_F) = g_p^T(y(t_f), p), \quad t_f \geq t \geq t_0, \\ + :label: SUNADJOINT_CONTINUOUS_ADJOINT_IVP + +where :math:`\lambda(t) \in \mathbb{R}^N`, :math:`\mu(t) \in \mathbb{R}^{N_s}` +:math:`f_y \equiv \partial f/\partial y \in \mathbb{R}^{N \times N}` is the Jacobian with respect to the dependent variable, +and :math:`f_p \equiv \partial f/\partial p \in \mathbb{R}^{N \times N_s}` is the Jacobian with respect to the parameters +(:math:`N` is the size of the original IVP, :math:`N_s` is the number of parameters). +When solved with a numerical time integration scheme, the solution to the continuous adjoint IVP +are numerical approximations of the continuous adjoint sensitivities + +.. math:: + \lambda(t_0) \approx g_y^T(y(t_0), p),\quad \mu(t_0) \approx g_p^T(y(t_0), p) + :label: SUNADJOINT_CONTINUOUS_ADJOINT_SOLUTION + +For the discrete adjoint approach, we first numerically discretize the original IVP :eq:`SUNADJOINT_IVP` +using either a time integration scheme :math:`\varphi` so that + +.. math:: + y_0 = y(t_0),\quad y_n = \varphi(y_{n-k}, \cdots, y_{n-1}, p), \quad k = n, \cdots, 1. + :label: SUNADJOINT_DISCRETE_IVP + +For linear multistep methods :math:`k \geq 1` and for one step methods :math:`k = 1`. +Reformulating the optimization problem for the discrete case, we have + +.. math:: + \min_{\xi} \Psi(\xi) = g(y_n, p) + :label: SUNADJOINT_DISCRETE_OPTIMIZATION_PROBLEM + +The gradients of :eq:`SUNADJOINT_DISCRETE_OPTIMIZATION_PROBLEM` can be computed using the transposed chain +rule backwards in time to obtain the discete adjoint variables :math:`\lambda_n, \lambda_{n-1}, \cdots, \lambda_0` +and :math:`\mu_n, \mu_{n-1}, \cdots, \mu_0`, + +.. math:: + \lambda_n &= g_y^T(y_n, p), \quad \lambda_k = 0, \quad \mu_n = g_y^T(y_n, p), \quad \mu_k = 0, \quad k = n - 1, \cdots, 0, \\ + \lambda_{\ell} &= \lambda_{\ell} + \left(\frac{\partial \varphi}{\partial y_{\ell}}(y_0, \cdots, y_{k-1}, p)\right)^T \lambda_{k}, + \quad \mu_{\ell} = \mu_{\ell} + \left(\frac{\partial \varphi}{\partial p}(y_0, \cdots, y_{k-1}, p)\right)^T \lambda_{k}, \\ + \quad & \quad \ell = k - 1, \cdots, 0, \quad k = n, \cdots, 0. + :label: SUNADJOINT_DISCRETE_ADJOINT + +The solution of the discrete adjoint equations :eq:`SUNADJOINT_DISCRETE_ADJOINT` is the sensitivities of the discrete cost function +:eq:`SUNADJOINT_DISCRETE_OPTIMIZATION_PROBLEM` with respect to changes in the discretized IVP :eq:`SUNADJOINT_DISCRETE_IVP`. + +.. math:: + \lambda_0 = g_y^T(y_0, p), \quad \mu_0 = g_p^T(y_0, p). + :label: SUNADJOINT_DISCRETE_ADJOINT_SOLUTION diff --git a/doc/shared/sundials.bib b/doc/shared/sundials.bib index b000f2c3dc..afaf2a63f4 100644 --- a/doc/shared/sundials.bib +++ b/doc/shared/sundials.bib @@ -2369,3 +2369,56 @@ @article{edwards2014kokkos issn = {0743-7315}, doi = {10.1016/j.jpdc.2014.07.003} } + +% +% Discrete adjoints +% + +@article{giles2000introduction, + title={An introduction to the adjoint approach to design}, + author={Giles, Michael B and Pierce, Niles A}, + journal={Flow, turbulence and combustion}, + volume={65}, + number={3}, + pages={393--415}, + year={2000}, + publisher={Springer} +} + +@article{sirkes1997finite, + title={Finite difference of adjoint or adjoint of finite difference?}, + author={Sirkes, Ziv and Tziperman, Eli}, + journal={Monthly weather review}, + volume={125}, + number={12}, + pages={3373--3378}, + year={1997} +} + +@article{hager2000runge, + title={{Runge-Kutta} methods in optimal control and the transformed adjoint system}, + author={Hager, William W}, + journal={Numerische Mathematik}, + volume={87}, + pages={247--282}, + year={2000}, + publisher={Springer}, + doi={10.1007/s002110000178} +} + +@article{sanduDiscrete2006, + year = {2006}, + title = {On the Properties of {Runge-Kutta} Discrete Adjoints}, + author = {Sandu, Adrian}, + journal = {Lecture Notes in Computer Science}, + issn = {0302-9743}, + doi = {10.1007/11758549_76}, + pages = {550--557} +} + +@article{rackauckas2020universal, + title={Universal differential equations for scientific machine learning}, + author={Rackauckas, Christopher and Ma, Yingbo and Martensen, Julius and Warner, Collin and Zubov, Kirill and Supekar, Rohit and Skinner, Dominic and Ramadhan, Ali and Edelman, Alan}, + journal={arXiv preprint arXiv:2001.04385}, + year={2020} +} diff --git a/doc/shared/sundials/Profiling.rst b/doc/shared/sundials/Profiling.rst index 2f8f458235..73dbcb08ba 100644 --- a/doc/shared/sundials/Profiling.rst +++ b/doc/shared/sundials/Profiling.rst @@ -237,13 +237,3 @@ It is applicable to any of the SUNDIALS solver packages. } SUNDIALS_MARK_END(profobj, "Integration loop"); PrintFinalStats(cvode_mem); /* Print some final statistics */ - - -.. _SUNDIALS.Profiling.Other: - -Other Considerations --------------------- - -If many regions are being timed, it may be necessary to increase the maximum -number of profiler entries (the default is ``2560``). This can be done -by setting the environment variable ``SUNPROFILER_MAX_ENTRIES``. diff --git a/doc/shared/sundials_vars.py b/doc/shared/sundials_vars.py index 4c5f76c563..f49c7a5deb 100644 --- a/doc/shared/sundials_vars.py +++ b/doc/shared/sundials_vars.py @@ -29,6 +29,7 @@ ('cpp:identifier', 'FILE'), ('c:identifier', 'size_t'), ('cpp:identifier', 'size_t'), + ('c:identifier', 'int64_t'), # CUDA ('cpp:identifier', 'cudaStream_t'), ('c:identifier', 'cusparseHandle_t'), diff --git a/doc/shared/sunmatrix/SUNMatrix_Description.rst b/doc/shared/sunmatrix/SUNMatrix_Description.rst index fe17e6f3f2..9b37e319a0 100644 --- a/doc/shared/sunmatrix/SUNMatrix_Description.rst +++ b/doc/shared/sunmatrix/SUNMatrix_Description.rst @@ -99,6 +99,10 @@ The virtual table structure is defined as The function implementing :c:func:`SUNMatMatvec` + .. c:member:: SUNErrCode (*mattransposevec)(SUNMatrix, N_Vector, N_Vector) + + The function implementing :c:func:`SUNMatMatTransposeVec` + .. c:member:: SUNErrCode (*space)(SUNMatrix, long int*, long int*) The function implementing :c:func:`SUNMatSpace` diff --git a/doc/shared/sunmatrix/SUNMatrix_Operations.rst b/doc/shared/sunmatrix/SUNMatrix_Operations.rst index 984c7a5fcd..433a9ef396 100644 --- a/doc/shared/sunmatrix/SUNMatrix_Operations.rst +++ b/doc/shared/sunmatrix/SUNMatrix_Operations.rst @@ -170,3 +170,20 @@ below. .. code-block:: c retval = SUNMatMatvec(A, x, y); + + +.. c:function:: SUNErrCode SUNMatMatTransposeVec(SUNMatrix A, N_Vector x, N_Vector y) + + Performs the matrix-vector product *y \gets A^Tx*. It should + only be called with vectors *x* and *y* that are compatible with + the matrix *A^T* -- both in storage type and dimensions. The return + value denotes the success/failure of the operation: + + .. math:: + y_i = \sum_{j=1}^n A_{j,i} x_j, \quad i=1,\ldots,m. + + Usage: + + .. code-block:: c + + retval = SUNMatMatTransposeVec(A, x, y); diff --git a/doc/shared/sunmemory/SUNMemory_Description.rst b/doc/shared/sunmemory/SUNMemory_Description.rst index 2efc154aa4..538c130575 100644 --- a/doc/shared/sunmemory/SUNMemory_Description.rst +++ b/doc/shared/sunmemory/SUNMemory_Description.rst @@ -42,6 +42,10 @@ This API consists of three new SUNDIALS types: :c:type:`SUNMemoryType`, The size of the data allocated. + .. c:member:: size_t stride; + + The stride of the data. + .. c:function:: SUNMemory SUNMemoryNewEmpty(SUNContext sunctx) This function returns an empty ``SUNMemory`` object. @@ -112,6 +116,10 @@ This API consists of three new SUNDIALS types: :c:type:`SUNMemoryType`, The function implementing :c:func:`SUNMemoryHelper_Alloc` + .. c:member:: SUNErrCode (*alloc)(SUNMemoryHelper, SUNMemory* memptr, size_t mem_size, size_t stride, SUNMemoryType mem_type, void* queue) + + The function implementing :c:func:`SUNMemoryHelper_AllocStrided` + .. c:member:: SUNErrCode (*dealloc)(SUNMemoryHelper, SUNMemory mem, void* queue) The function implementing :c:func:`SUNMemoryHelper_Dealloc` @@ -171,6 +179,33 @@ must define: * A new :c:type:`SUNMemory` object. +.. c:function:: SUNMemory SUNMemoryHelper_AllocStrided(SUNMemoryHelper helper, \ + SUNMemory* memptr, \ + size_t mem_size, size_t stride, \ + SUNMemoryType mem_type, \ + void* queue) + + Allocates a ``SUNMemory`` object whose ``ptr`` field is allocated for + ``mem_size`` bytes with the specified stride, and is of type ``mem_type``. + The new object will have ownership of ``ptr`` and will be deallocated when + :c:func:`SUNMemoryHelper_Dealloc` is called. + + **Arguments:** + + * ``helper`` -- the ``SUNMemoryHelper`` object. + * ``memptr`` -- pointer to the allocated ``SUNMemory``. + * ``mem_size`` -- the size in bytes of the ``ptr``. + * ``stride`` -- the stride of the memory in bytes + * ``mem_type`` -- the ``SUNMemoryType`` of the ``ptr``. + * ``queue`` -- typically a handle for an object representing an alternate + execution stream (e.g., a CUDA/HIP stream or SYCL queue), but it can + also be any implementation specific data. + + **Returns:** + + * A new :c:type:`SUNMemory` object. + + .. c:function:: SUNErrCode SUNMemoryHelper_Dealloc(SUNMemoryHelper helper, \ SUNMemory mem, void* queue) diff --git a/doc/shared/sunmemory/SUNMemory_System.rst b/doc/shared/sunmemory/SUNMemory_System.rst new file mode 100644 index 0000000000..cd712b191d --- /dev/null +++ b/doc/shared/sunmemory/SUNMemory_System.rst @@ -0,0 +1,42 @@ +.. + ---------------------------------------------------------------- + SUNDIALS Copyright Start + Copyright (c) 2002-2024, 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 + ---------------------------------------------------------------- + +.. _SUNMemory.Sys: + +The SUNMemoryHelper_Sys Implementation +======================================= + +The SUNMemoryHelper_Sys module is an implementation of the ``SUNMemoryHelper`` +API that interfaces with standard library memory management through malloc/free. +The implementation defines the constructor + +.. c:function:: SUNMemoryHelper SUNMemoryHelper_Sys(SUNContext sunctx) + + Allocates and returns a ``SUNMemoryHelper`` object for handling system memory + if successful. Otherwise, it returns ``NULL``. + +.. _SUNMemory.Sys.Operations: + +SUNMemoryHelper_Sys API Functions +---------------------------------- + +The implementation provides the following operations defined by the +``SUNMemoryHelper`` API: + +* :c:func:`SUNMemoryHelper_Alloc` +* :c:func:`SUNMemoryHelper_AllocStrided` +* :c:func:`SUNMemoryHelper_Dealloc` +* :c:func:`SUNMemoryHelper_Copy` +* :c:func:`SUNMemoryHelper_Clone` +* :c:func:`SUNMemoryHelper_GetAllocStats` +* :c:func:`SUNMemoryHelper_Destroy` diff --git a/doc/shared/sunstepper/SUNStepper_Description.rst b/doc/shared/sunstepper/SUNStepper_Description.rst new file mode 100644 index 0000000000..f37379bfed --- /dev/null +++ b/doc/shared/sunstepper/SUNStepper_Description.rst @@ -0,0 +1,397 @@ +.. ---------------------------------------------------------------- + Programmer(s): Steven B. Roberts @LLNL + David J. Gardner @ LLNL + ---------------------------------------------------------------- + SUNDIALS Copyright Start + Copyright (c) 2002-2024, 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 + ---------------------------------------------------------------- + +.. _SUNStepper.Description: + +The SUNStepper API +================== + +.. versionadded:: x.y.z + +As with other SUNDIALS classes, the :c:type:`SUNStepper` abstract base class is +implemented using a C structure containing a ``content`` pointer to the derived +class member data and a structure of function pointers to the derived class +implementations of the virtual methods. + +.. c:type:: SUNStepper + + An object for solving the IVP :eq:`SUNStepper_IVP`. + + The actual definition of the ``SUNStepper`` structure is kept private to + allow for the object internals to change without impacting user code. The + following sections describe the base class methods and the virtual methods + that a must be provided by a derived class. + +.. _SUNStepper.Description.BaseMethods: + +Base Class Methods +------------------ + +This section describes methods provided by the :c:type:`SUNStepper` abstract +base class that aid the user in implementing derived classes. This includes +functions for creating and destroying a generic base class object, attaching and +retrieving the derived class ``content`` pointer, and setting function pointers +to derived class method implementations. + +.. _SUNStepper.Description.BaseMethods.CreateDestroy: + +Creating and Destroying an Object +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +In addition to creating an empty :c:type:`SUNStepper` using +:c:func:`SUNStepper_Create` described below, there is the +:c:func:`ARKodeCreateSUNStepper` function to construct a :c:type:`SUNStepper` +from an ARKODE integrator. + +.. c:function:: SUNErrCode SUNStepper_Create(SUNContext sunctx, SUNStepper *stepper) + + This function creates a :c:type:`SUNStepper` object to which a user should + attach the member data (content) pointer and method function pointers. + + :param sunctx: the SUNDIALS simulation context. + :param stepper: a pointer to a stepper object. + :return: A :c:type:`SUNErrCode` indicating success or failure. + + **Example usage:** + + .. code-block:: C + + /* create an instance of the base class */ + SUNStepper stepper = NULL; + SUNErrCode err = SUNStepper_Create(sunctx, &stepper); + + .. note:: + + See :numref:`SUNStepper.Description.BaseMethods.Content` and + :numref:`SUNStepper.Description.BaseMethods.AttachFunctions` + for details on how to attach member data and method function pointers. + + +.. c:function:: SUNErrCode SUNStepper_Destroy(SUNStepper *stepper) + + This function frees memory allocated by the :c:type:`SUNStepper` base class + and uses the function pointer optionally specified with + :c:func:`SUNStepper_SetDestroyFn` to free the content. + + :param stepper: a pointer to a stepper object. + :return: A :c:type:`SUNErrCode` indicating success or failure. + + .. note:: + + This function only frees memory allocated within the base class and the + base class structure itself. The user is responsible for freeing any + memory allocated for the member data (content). + + +.. _SUNStepper.Description.BaseMethods.SteppingFunctions: + +Stepping Functions +^^^^^^^^^^^^^^^^^^ + +.. c:function:: SUNErrCode SUNStepper_Evolve(SUNStepper stepper, sunrealtype tout, N_Vector vret, sunrealtype* tret) + + This function evolves the ODE :eq:`SUNStepper_IVP` towards the time ``tout`` + and stores the solution at time ``tret`` in ``vret``. + + :param stepper: the stepper object. + :param tout: the time to evolve towards. + :param vret: on output, the state at time ``tret``. + :param tret: the time corresponding to the output value ``vret``. + :return: A :c:type:`SUNErrCode` indicating success or failure. + +.. c:function:: SUNErrCode SUNStepper_OneStep(SUNStepper stepper, sunrealtype tout, N_Vector vret, sunrealtype* tret) + + This function evolves the ODE :eq:`SUNStepper_IVP` *one timestep* towards + the time ``tout`` and stores the solution at time ``tret`` in ``vret``. + + :param stepper: the stepper object. + :param tout: the time to evolve towards. + :param vret: on output, the state at time ``tret``. + :param tret: the time corresponding to the output value ``vret``. + :return: A :c:type:`SUNErrCode` indicating success or failure. + +.. c:function:: SUNErrCode SUNStepper_FullRhs(SUNStepper stepper, sunrealtype t, N_Vector v, N_Vector f, SUNFullRhsMode mode) + + This function computes the full right-hand side function of the ODE, + :math:`f(t, v) + r(t)` in :eq:`SUNStepper_IVP` for a given value of the + independent variable ``t`` and state vector ``v``. + + :param stepper: the stepper object. + :param t: the current value of the independent variable. + :param v: the current value of the dependent variable vector. + :param f: the output vector for the ODE right-hand side, + :math:`f(t, v) + r(t)`, in :eq:`SUNStepper_IVP`. + :param mode: the purpose of the right-hand side evaluation. + :return: A :c:type:`SUNErrCode` indicating success or failure. + + +.. c:function:: SUNErrCode SUNStepper_Reset(SUNStepper stepper, sunrealtype tR, N_Vector vR) + + This function resets the stepper state to the provided independent variable + value and dependent variable vector. + + :param stepper: the stepper object. + :param tR: the value of the independent variable :math:`t_R`. + :param vR: the value of the dependent variable vector :math:`v(t_R)`. + :return: A :c:type:`SUNErrCode` indicating success or failure. + + +.. c:function:: SUNErrCode SUNStepper_SetStopTime(SUNStepper stepper, sunrealtype tstop) + + This function specifies the value of the independent variable :math:`t` past + which the solution is not to proceed. + + :param stepper: the stepper object. + :param tstop: stopping time for the stepper. + :return: A :c:type:`SUNErrCode` indicating success or failure. + + +.. c:function:: SUNErrCode SUNStepper_SetForcing(SUNStepper stepper, sunrealtype tshift, sunrealtype tscale, N_Vector* forcing, int nforcing) + + This function sets the data necessary to compute the forcing term + :eq:`SUNStepper_forcing`. This includes the shift and scaling factors for the + normalized time :math:`\frac{t - t_{\text{shift}}}{t_{\text{scale}}}` and the + array of polynomial coefficient vectors :math:`\widehat{f}_k`. + + :param stepper: a stepper object. + :param tshift: the time shift to apply to the current time when computing + the forcing, :math:`t_{\text{shift}}`. + :param tscale: the time scaling to apply to the current time when computing + the forcing, :math:`t_{\text{scale}}`. + :param forcing: a pointer to an array of forcing vectors, + :math:`\widehat{f}_k`. + :param nforcing: the number of forcing vectors, :math:`n_{\text{forcing}}`. A + value of 0 effectively eliminates the forcing term. + :return: A :c:type:`SUNErrCode` indicating success or failure. + + .. note:: + + When integrating the ODE :eq:`SUNStepper_IVP` the :c:type:`SUNStepper` is + responsible for evaluating ODE right-hand side function :math:`f(t, v)` as + well as computing and applying the forcing term :eq:`SUNStepper_forcing` + to obtain the full right-hand side of the ODE :eq:`SUNStepper_IVP`. + + +.. _SUNStepper.Description.BaseMethods.RhsMode: + +The Right-Hand Side Evaluation Mode +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. c:enum:: SUNFullRhsMode + + A flag indicating the purpose of a right-hand side function evaluation. + + .. c:enumerator:: SUN_FULLRHS_START + + Evaluate at the beginning of the simulation. + + .. c:enumerator:: SUN_FULLRHS_END + + Evaluate at the end of a successful step. + + .. c:enumerator:: SUN_FULLRHS_OTHER + + Evaluate elsewhere, e.g., for dense output. + + +.. _SUNStepper.Description.BaseMethods.Content: + +Attaching and Accessing the Content Pointer +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. c:function:: SUNErrCode SUNStepper_SetContent(SUNStepper stepper, void *content) + + This function attaches a member data (content) pointer to a + :c:type:`SUNStepper` object. + + :param stepper: a stepper object. + :param content: a pointer to the stepper member data. + :return: A :c:type:`SUNErrCode` indicating success or failure. + + +.. c:function:: SUNErrCode SUNStepper_GetContent(SUNStepper stepper, void **content) + + This function retrieves the member data (content) pointer from a + :c:type:`SUNStepper` object. + + :param stepper: a stepper object. + :param content: a pointer to set to the stepper member data pointer. + :return: A :c:type:`SUNErrCode` indicating success or failure. + + +Handling Warnings and Errors +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +An implementation of a :c:type:`SUNStepper` may have a system of warning and error +handling that cannot be encoded as a :c:type:`SUNErrCode` which is the return +type of all :c:type:`SUNStepper` functions. Therefore, we provide the following +function to get and set a separate flag associated with a stepper. + +.. c:function:: SUNErrCode SUNStepper_SetLastFlag(SUNStepper stepper, int last_flag) + + This function sets a flag that can be used by :c:type:`SUNStepper` implementations to + indicate warnings or errors that occurred during an operation, e.g., + :c:func:`SUNStepper_Evolve`. + + :param stepper: the stepper object. + :param last_flag: the flag value. + :return: A :c:type:`SUNErrCode` indicating success or failure. + +.. c:function:: SUNErrCode SUNStepper_GetLastFlag(SUNStepper stepper, int *last_flag) + + This function provides the last value of the flag used by the :c:type:`SUNStepper` + implementation to indicate warnings or errors that occurred during an + operation, e.g., :c:func:`SUNStepper_Evolve`. + + :param stepper: the stepper object. + :param last_flag: A pointer to where the flag value will be written. + :return: A :c:type:`SUNErrCode` indicating success or failure. + + +.. _SUNStepper.Description.BaseMethods.AttachFunctions: + +Setting Member Functions +^^^^^^^^^^^^^^^^^^^^^^^^ + +The functions in this section are used to specify how each operation on a +:c:type:`SUNStepper` implementation is performed. Technically, all of these +functions are optional to call; the functions that need to be attached are +determined by the "consumer" of the :c:type:`SUNStepper`. + +.. c:function:: SUNErrCode SUNStepper_SetEvolveFn(SUNStepper stepper, SUNStepperEvolveFn fn) + + This function attaches a :c:type:`SUNStepperEvolveFn` function to a + :c:type:`SUNStepper` object. + + :param stepper: a stepper object. + :param fn: the :c:type:`SUNStepperEvolveFn` function to attach. + :return: A :c:type:`SUNErrCode` indicating success or failure. + + +.. c:function:: SUNErrCode SUNStepper_SetFullRhsFn(SUNStepper stepper, SUNStepperFullRhsFn fn) + + This function attaches a :c:type:`SUNStepperFullRhsFn` function to a + :c:type:`SUNStepper` object. + + :param stepper: a stepper object. + :param fn: the :c:type:`SUNStepperFullRhsFn` function to attach. + :return: A :c:type:`SUNErrCode` indicating success or failure. + + +.. c:function:: SUNErrCode SUNStepper_SetResetFn(SUNStepper stepper, SUNStepperResetFn fn) + + This function attaches a :c:type:`SUNStepperResetFn` function to a + :c:type:`SUNStepper` object. + + :param stepper: a stepper object. + :param fn: the :c:type:`SUNStepperResetFn` function to attach. + :return: A :c:type:`SUNErrCode` indicating success or failure. + + +.. c:function:: SUNErrCode SUNStepper_SetStopTimeFn(SUNStepper stepper, SUNStepperSetStopTimeFn fn) + + This function attaches a :c:type:`SUNStepperSetStopTimeFn` function to a + :c:type:`SUNStepper` object. + + :param stepper: a stepper object. + :param fn: the :c:type:`SUNStepperSetStopTimeFn` function to attach. + :return: A :c:type:`SUNErrCode` indicating success or failure. + + +.. c:function:: SUNErrCode SUNStepper_SetForcingFn(SUNStepper stepper, SUNStepperSetForcingFn fn) + + This function attaches a :c:type:`SUNStepperSetForcingFn` function to a + :c:type:`SUNStepper` object. + + :param stepper: a stepper object. + :param fn: the :c:type:`SUNStepperSetForcingFn` function to attach. + :return: A :c:type:`SUNErrCode` indicating success or failure. + + +.. c:function:: SUNErrCode SUNStepper_SetDestroyFn(SUNStepper stepper, SUNStepperDestroyFn fn) + + This function attaches a :c:type:`SUNStepperDestroyFn` function to a + :c:type:`SUNStepper`. The provided function is responsible for freeing any + memory allocated for the :c:type:`SUNStepper` content. + + :param stepper: a stepper object. + :param fn: the :c:type:`SUNStepperDestroyFn` function to attach. + :return: A :c:type:`SUNErrCode` indicating success or failure. + + +.. _SUNStepper.Description.ImplMethods: + +Implementation Specific Methods +------------------------------- + +This section describes the virtual methods defined by the :c:type:`SUNStepper` +abstract base class. + + +.. c:type:: SUNErrCode (*SUNStepperEvolveFn)(SUNStepper stepper, sunrealtype tout, N_Vector vret, sunrealtype* tret) + + This type represents a function with the signature of + :c:func:`SUNStepper_Evolve`. + + +.. c:type:: SUNErrCode (*SUNStepperFullRhsFn)(SUNStepper stepper, sunrealtype t, N_Vector v, N_Vector f, SUNFullRhsMode mode) + + This type represents a function with the signature of + :c:func:`SUNStepper_FullRhs`. + + + This type represents a function to compute the full right-hand side function + of the ODE, :math:`f(t, v) + r(t)` in :eq:`SUNStepper_IVP` for a given value + of the independent variable ``t`` and state vector ``v``. + + +.. c:type:: SUNErrCode (*SUNStepperResetFn)(SUNStepper stepper, sunrealtype tR, N_Vector vR) + + This type represents a function with the signature of + :c:func:`SUNStepper_Reset`. + + +.. c:type:: SUNErrCode (*SUNStepperSetStopTimeFn)(SUNStepper stepper, sunrealtype tstop) + + This type represents a function with the signature of + :c:func:`SUNStepper_SetStopTime`. + + +.. c:type:: SUNErrCode (*SUNStepperSetForcingFn)(SUNStepper stepper, sunrealtype tshift, sunrealtype tscale, N_Vector* forcing, int nforcing) + + This type represents a function with the signature of + :c:func:`SUNStepper_SetForcing`. + + +.. c:type:: SUNErrCode (*SUNStepperDestroyFn)(SUNStepper stepper) + + This type represents a function with the signature similar to + :c:func:`SUNStepper_Destroy` for freeing the content associated with a + :c:type:`SUNStepper`. + + +.. _SUNStepper.Description.UserSupplied: + +User-Supplied Function Types +---------------------------- + +This section describes the functions that users may supply. + +.. c:type:: int (*SUNRhsJacFn)(sunrealtype t, N_Vector y, N_Vector fy, SUNMatrix Jac, \ + void* user_data, N_Vector tmp1, N_Vector tmp2, \ + N_Vector tmp3); + +.. c:type:: int (*SUNRhsJacTimesFn)(N_Vector v, N_Vector Jv, sunrealtype t, N_Vector y, \ + N_Vector fy, void* user_data, N_Vector tmp); diff --git a/doc/shared/sunstepper/SUNStepper_Implementing.rst b/doc/shared/sunstepper/SUNStepper_Implementing.rst new file mode 100644 index 0000000000..269621a1cc --- /dev/null +++ b/doc/shared/sunstepper/SUNStepper_Implementing.rst @@ -0,0 +1,58 @@ +.. ---------------------------------------------------------------- + Programmer(s): David J. Gardner @ LLNL + Steven B. Roberts @ LLNL + ---------------------------------------------------------------- + SUNDIALS Copyright Start + Copyright (c) 2002-2024, 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 + ---------------------------------------------------------------- + +.. _SUNStepper.Implementing: + +Implementing a SUNStepper +========================= + +To create a SUNStepper implementation: + +#. Define the stepper-specific content. + + This is typically a user-defined structure in C codes, a user-defined class + or structure in C++ codes, or a user-defined module in Fortran codes. This + content should hold any data necessary to perform the operations defined by + the :c:type:`SUNStepper` member functions. + +#. Define implementations of the required member functions (see + :numref:`SUNStepper.Description.ImplMethods`). + + These are typically user-defined functions in C, member functions of the + user-defined structure or class in C++, or functions contained in the + user-defined module in Fortran. + + Note that all member functions are passed the :c:type:`SUNStepper` object and + the stepper-specific content can, if necessary, be retrieved using + :c:func:`SUNStepper_GetContent`. Stepper-specific warnings and errors can be + recorded with :c:func:`SUNStepper_SetLastFlag`. + +#. In the user code, before creating the outer memory structure that uses the + :c:type:`SUNStepper`, + + .. e.g., with :c:func:`SplittingStepCreate` or :c:func:`ForcingStepCreate`, do the following: + + #. Create a :c:type:`SUNStepper` object with :c:func:`SUNStepper_Create`. + + #. Attach a pointer to the stepper content to the :c:type:`SUNStepper` object + with :c:func:`SUNStepper_SetContent` if necessary, e.g., when the content + is a C structure. + + #. Attach the member function implementations using the functions described + in :numref:`SUNStepper.Description.BaseMethods.AttachFunctions`. + +#. Attach the :c:type:`SUNStepper` object to the outer memory structure, + + .. e.g., with :c:func:`SplittingStepCreate` or :c:func:`ForcingStepCreate`. diff --git a/doc/shared/sunstepper/SUNStepper_Structure.rst b/doc/shared/sunstepper/SUNStepper_Structure.rst new file mode 100644 index 0000000000..bce90f5c57 --- /dev/null +++ b/doc/shared/sunstepper/SUNStepper_Structure.rst @@ -0,0 +1,39 @@ +.. ---------------------------------------------------------------- + Programmer(s): Steven B. Roberts @ LLNL + ---------------------------------------------------------------- + SUNDIALS Copyright Start + Copyright (c) 2002-2024, 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 + ---------------------------------------------------------------- + +.. _SUNStepper: + +##################################### +Stepper Data Structure +##################################### + +This section presents the :c:type:`SUNStepper` base class which represents a +generic solution procedure for IVPs of the form + +.. math:: + \dot{v}(t) = f(t, v) + r(t), \qquad v(t_0) = v_0, + :label: SUNStepper_IVP + +on an interval :math:`t \in [t_0, t_f]`. The time dependent forcing term, +:math:`r_i(t)`, is given by + +.. math:: + r(t) = \sum_{k = 0}^{n_{\text{forcing}}-1} + \left( \frac{t - t_{\text{shift}}}{t_{\text{scale}}} \right)^{k} \widehat{f}_k. + :label: SUNStepper_forcing + +:c:type:`SUNStepper` provides an abstraction over SUNDIALS integrators, custom +integrators, exact solution procedures, or other approaches for solving +:eq:`SUNStepper_IVP`. These are used, for example, in operator splitting and +forcing methods to solve inner IVPs in a flexible way. diff --git a/doc/superbuild/source/developers/style_guide/SourceCode.rst b/doc/superbuild/source/developers/style_guide/SourceCode.rst index 022cffbc7e..bc2b64e506 100644 --- a/doc/superbuild/source/developers/style_guide/SourceCode.rst +++ b/doc/superbuild/source/developers/style_guide/SourceCode.rst @@ -352,7 +352,7 @@ not adhere to all of these rules. #. Conversely, never use ``sunindextype`` for variables that are not specifically related to the dimensions of a vector, matrix, etc.. E.g., if you have a variable that represents the number of integer "words" allocated in a workspace do not use - ``sunindextype`` for it. Instead use the appropriate integer type (e.g., ``uint64_t``) directly. + ``sunindextype`` for it. Instead use the appropriate integer type (e.g., ``int64_t``) directly. Do not use ``sunindextype`` for counters either. #. ``SUNLogger`` statements must be in the format: @@ -374,6 +374,11 @@ not adhere to all of these rules. .. code-block:: c +#. Do not use unsigned integer types except for ``size_t`` when the value you are storing + is a memory size. Unsigned integer types must never be used in parts of the + SUNDIALS API that will be interfaced to Fortran since the Fortran standard does + not include unsigned integers. + .. _Style.Formatting: Formatting diff --git a/doc/superbuild/source/index.rst b/doc/superbuild/source/index.rst index e61162c884..9f691607e3 100644 --- a/doc/superbuild/source/index.rst +++ b/doc/superbuild/source/index.rst @@ -174,6 +174,8 @@ SUNDIALS License and Notices sunlinsol/index.rst sunnonlinsol/index.rst sunadaptcontroller/index.rst + sunstepper/index.rst + sunadjoint/index.rst sunmemory/index.rst History_link.rst Changelog_link.rst diff --git a/doc/superbuild/source/sunadjoint/SUNAdjoint_links.rst b/doc/superbuild/source/sunadjoint/SUNAdjoint_links.rst new file mode 100644 index 0000000000..82e8396968 --- /dev/null +++ b/doc/superbuild/source/sunadjoint/SUNAdjoint_links.rst @@ -0,0 +1,14 @@ +.. ---------------------------------------------------------------- + SUNDIALS Copyright Start + Copyright (c) 2002-2024, 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 + ---------------------------------------------------------------- + +.. include:: ../../../shared/sunadjoint/SUNAdjointStepper.rst +.. include:: ../../../shared/sunadjoint/SUNAdjointCheckpointScheme.rst diff --git a/doc/superbuild/source/sunadjoint/index.rst b/doc/superbuild/source/sunadjoint/index.rst new file mode 100644 index 0000000000..30b347d811 --- /dev/null +++ b/doc/superbuild/source/sunadjoint/index.rst @@ -0,0 +1,19 @@ +.. + ---------------------------------------------------------------- + SUNDIALS Copyright Start + Copyright (c) 2002-2024, 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 + ---------------------------------------------------------------- + +.. include:: ../../../shared/sunadjoint/SUNAdjoint_Introduction.rst + +.. toctree:: + :maxdepth: 1 + + SUNAdjoint_links.rst diff --git a/doc/superbuild/source/sunmemory/SUNMemory_links.rst b/doc/superbuild/source/sunmemory/SUNMemory_links.rst index e36bbec844..c431ed642c 100644 --- a/doc/superbuild/source/sunmemory/SUNMemory_links.rst +++ b/doc/superbuild/source/sunmemory/SUNMemory_links.rst @@ -11,6 +11,7 @@ ---------------------------------------------------------------- .. include:: ../../../shared/sunmemory/SUNMemory_Description.rst +.. include:: ../../../shared/sunmemory/SUNMemory_System.rst .. include:: ../../../shared/sunmemory/SUNMemory_CUDA.rst .. include:: ../../../shared/sunmemory/SUNMemory_HIP.rst .. include:: ../../../shared/sunmemory/SUNMemory_SYCL.rst diff --git a/doc/superbuild/source/sunstepper/SUNStepper_links.rst b/doc/superbuild/source/sunstepper/SUNStepper_links.rst new file mode 100644 index 0000000000..925278111c --- /dev/null +++ b/doc/superbuild/source/sunstepper/SUNStepper_links.rst @@ -0,0 +1,14 @@ +.. ---------------------------------------------------------------- + SUNDIALS Copyright Start + Copyright (c) 2002-2024, 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 + ---------------------------------------------------------------- + +.. include:: ../../../shared/sunstepper/SUNStepper_Description.rst +.. include:: ../../../shared/sunstepper/SUNStepper_Implementing.rst diff --git a/doc/superbuild/source/sunstepper/index.rst b/doc/superbuild/source/sunstepper/index.rst new file mode 100644 index 0000000000..37c94c70d7 --- /dev/null +++ b/doc/superbuild/source/sunstepper/index.rst @@ -0,0 +1,20 @@ +.. ---------------------------------------------------------------- + Programmer(s): Steven B. Roberts @ LLNL + ---------------------------------------------------------------- + SUNDIALS Copyright Start + Copyright (c) 2002-2024, 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 + ---------------------------------------------------------------- + +.. include:: ../../../shared/sunstepper/SUNStepper_Structure.rst + +.. toctree:: + :maxdepth: 1 + + SUNStepper_links.rst diff --git a/examples/arkode/C_serial/CMakeLists.txt b/examples/arkode/C_serial/CMakeLists.txt index fbba99ffb9..d0fdc8c2de 100644 --- a/examples/arkode/C_serial/CMakeLists.txt +++ b/examples/arkode/C_serial/CMakeLists.txt @@ -76,6 +76,8 @@ set(ARKODE_examples "ark_KrylovDemo_prec\;\;exclude-single" "ark_KrylovDemo_prec\;1\;exclude-single" "ark_KrylovDemo_prec\;2\;exclude-single" + "ark_lotka_volterra_ASA\;--check-freq 1\;develop" + "ark_lotka_volterra_ASA\;--check-freq 5\;develop" "ark_onewaycouple_mri\;\;develop" "ark_reaction_diffusion_mri\;\;develop" "ark_robertson_constraints\;\;exclude-single" diff --git a/examples/arkode/C_serial/ark_lotka_volterra_ASA.c b/examples/arkode/C_serial/ark_lotka_volterra_ASA.c new file mode 100644 index 0000000000..131a0b857c --- /dev/null +++ b/examples/arkode/C_serial/ark_lotka_volterra_ASA.c @@ -0,0 +1,359 @@ +/* ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 example solves the Lotka-Volterra ODE with four parameters, + * + * u = [dx/dt] = [ p_0*x - p_1*x*y ] + * [dy/dt] [ -p_2*y + p_3*x*y ]. + * + * The initial condition is u(t_0) = 1.0 and we use the parameters + * p = [1.5, 1.0, 3.0, 1.0]. The integration interval can be controlled via + * the --tf command line argument, but by default it is t \in [0, 10.]. + * An explicit Runge--Kutta method is employed via the ARKStep time stepper + * provided by ARKODE. After solving the forward problem, adjoint sensitivity + * analysis (ASA) is performed using the discrete adjoint method available with + * with ARKStep in order to obtain the gradient of the scalar cost function, + * + * g(u(t_f), p) = || 1 - u(t_f, p) ||^2 / 2 + * + * with respect to the initial condition and the parameters. + * + * ./ark_lotka_volterra_adj options: + * --tf the final simulation time + * --dt the timestep size + * --order the order of the RK method + * --check-freq how often to checkpoint (in steps) + * --no-stages don't checkpoint stages + * --dont-keep don't keep checkpoints around after loading + * --help print these options + * ---------------------------------------------------------------------------*/ + +#include +#include +#include + +#include + +#include +#include +#include +#include +#include +#include + +#include +#include +#include "sundials/sundials_nvector.h" + +typedef struct +{ + sunrealtype tf; + sunrealtype dt; + int order; + int check_freq; + sunbooleantype save_stages; + sunbooleantype keep_checks; +} ProgramArgs; + +static sunrealtype params[4] = {SUN_RCONST(1.5), SUN_RCONST(1.0), + SUN_RCONST(3.0), SUN_RCONST(1.0)}; +static void parse_args(int argc, char* argv[], ProgramArgs* args); +static void print_help(int argc, char* argv[], int exit_code); +static int check_retval(void* retval_ptr, const char* funcname, int opt); +static int lotka_volterra(sunrealtype t, N_Vector uvec, N_Vector udotvec, + void* user_data); +static int vjp(N_Vector vvec, N_Vector Jvvec, sunrealtype t, N_Vector uvec, + N_Vector udotvec, void* user_data, N_Vector tmp); +static int parameter_vjp(N_Vector vvec, N_Vector Jvvec, sunrealtype t, + N_Vector uvec, N_Vector udotvec, void* user_data, + N_Vector tmp); +static void dgdu(N_Vector uvec, N_Vector dgvec, const sunrealtype* p); +static void dgdp(N_Vector uvec, N_Vector dgvec, const sunrealtype* p); + +int main(int argc, char* argv[]) +{ + int retval = 0; + SUNContext sunctx = NULL; + SUNContext_Create(SUN_COMM_NULL, &sunctx); + + ProgramArgs args; + args.tf = SUN_RCONST(10.0); + args.dt = SUN_RCONST(1e-3); + args.order = 4; + args.save_stages = SUNTRUE; + args.keep_checks = SUNTRUE; + args.check_freq = 2; + parse_args(argc, argv, &args); + + // + // Create the initial conditions vector + // + + sunindextype neq = 2; + N_Vector u = N_VNew_Serial(neq, sunctx); + N_Vector u0 = N_VClone(u); + N_VConst(SUN_RCONST(1.0), u0); + N_VConst(SUN_RCONST(1.0), u); + + // + // Create the ARKODE stepper that will be used for the forward evolution. + // + + const sunrealtype dt = args.dt; + sunrealtype t0 = SUN_RCONST(0.0); + sunrealtype tf = args.tf; + const int nsteps = (int)ceil(((tf - t0) / dt + 1)); + const int order = args.order; + void* arkode_mem = ARKStepCreate(lotka_volterra, NULL, t0, u, sunctx); + + retval = ARKodeSetOrder(arkode_mem, order); + if (check_retval(&retval, "ARKodeSetOrder", 1)) { return 1; } + + retval = ARKodeSetMaxNumSteps(arkode_mem, nsteps * 2); + if (check_retval(&retval, "ARKodeSetMaxNumSteps", 1)) { return 1; } + + // Enable checkpointing during the forward solution. + const int check_interval = args.check_freq; + const int ncheck = nsteps * order; + const sunbooleantype save_stages = args.save_stages; + const sunbooleantype keep_check = args.keep_checks; + SUNAdjointCheckpointScheme checkpoint_scheme = NULL; + SUNMemoryHelper mem_helper = SUNMemoryHelper_Sys(sunctx); + + retval = SUNAdjointCheckpointScheme_Create_Fixed(SUNDATAIOMODE_INMEM, + mem_helper, check_interval, + ncheck, save_stages, + keep_check, sunctx, + &checkpoint_scheme); + if (check_retval(&retval, "SUNAdjointCheckpointScheme_Create_Fixed", 1)) + { + return 1; + } + + retval = ARKodeSetAdjointCheckpointScheme(arkode_mem, checkpoint_scheme); + if (check_retval(&retval, "ARKodeSetAdjointCheckpointScheme", 1)) + { + return 1; + } + + // + // Compute the forward solution + // + + printf("Initial condition:\n"); + N_VPrint(u); + + retval = ARKodeSetUserData(arkode_mem, (void*)params); + if (check_retval(&retval, "ARKodeSetUserData", 1)) { return 1; } + + retval = ARKodeSetFixedStep(arkode_mem, dt); + if (check_retval(&retval, "ARKodeSetFixedStep", 1)) { return 1; } + + sunrealtype tret = t0; + while (tret < tf) + { + retval = ARKodeEvolve(arkode_mem, tf, u, &tret, ARK_NORMAL); + if (retval < 0) + { + fprintf(stderr, ">>> ERROR: ARKodeEvolve returned %d\n", retval); + return -1; + } + } + + printf("Forward Solution:\n"); + N_VPrint(u); + + printf("ARKODE Stats for Forward Solution:\n"); + retval = ARKodePrintAllStats(arkode_mem, stdout, SUN_OUTPUTFORMAT_TABLE); + if (check_retval(&retval, "ARKodePrintAllStats", 1)) { return 1; } + printf("\n"); + + // + // Create the adjoint stepper + // + + sunindextype num_params = 4; + N_Vector sensu0 = N_VClone(u); + N_Vector sensp = N_VNew_Serial(num_params, sunctx); + N_Vector sens[2] = {sensu0, sensp}; + N_Vector sf = N_VNew_ManyVector(2, sens, sunctx); + + // Set the terminal condition for the adjoint system, which + // should be the the gradient of our cost function at tf. + dgdu(u, sensu0, params); + dgdp(u, sensp, params); + + printf("Adjoint terminal condition:\n"); + N_VPrint(sf); + + SUNAdjointStepper adj_stepper; + retval = ARKStepCreateAdjointStepper(arkode_mem, sf, &adj_stepper); + if (check_retval(&retval, "ARKStepCreateAdjointStepper", 1)) { return 1; } + + retval = SUNAdjointStepper_SetVecTimesJacFn(adj_stepper, vjp, parameter_vjp); + if (check_retval(&retval, "SUNAdjointStepper_SetVecTimesJacFn", 1)) + { + return 1; + } + + // + // Now compute the adjoint solution + // + + retval = SUNAdjointStepper_Evolve(adj_stepper, t0, sf, &tret); + if (check_retval(&retval, "SUNAdjointStepper_Evolve", 1)) { return 1; } + + printf("Adjoint Solution:\n"); + N_VPrint(sf); + + printf("\nSUNAdjointStepper Stats:\n"); + retval = SUNAdjointStepper_PrintAllStats(adj_stepper, stdout, + SUN_OUTPUTFORMAT_TABLE); + if (check_retval(&retval, "SUNAdjointStepper_PrintAllStats", 1)) { return 1; } + printf("\n"); + + // + // Cleanup + // + + N_VDestroy(u); + N_VDestroy(sf); + SUNAdjointCheckpointScheme_Destroy(&checkpoint_scheme); + SUNAdjointStepper_Destroy(&adj_stepper); + ARKodeFree(&arkode_mem); + SUNContext_Free(&sunctx); + + return 0; +} + +int lotka_volterra(sunrealtype t, N_Vector uvec, N_Vector udotvec, void* user_data) +{ + sunrealtype* p = (sunrealtype*)user_data; + sunrealtype* u = N_VGetArrayPointer(uvec); + sunrealtype* udot = N_VGetArrayPointer(udotvec); + + udot[0] = p[0] * u[0] - p[1] * u[0] * u[1]; + udot[1] = -p[2] * u[1] + p[3] * u[0] * u[1]; + + return 0; +} + +int vjp(N_Vector vvec, N_Vector Jvvec, sunrealtype t, N_Vector uvec, + N_Vector udotvec, void* user_data, N_Vector tmp) +{ + sunrealtype* p = (sunrealtype*)user_data; + sunrealtype* u = N_VGetArrayPointer(uvec); + sunrealtype* v = N_VGetArrayPointer(vvec); + sunrealtype* Jv = N_VGetArrayPointer(Jvvec); + + Jv[0] = (p[0] - p[1] * u[1]) * v[0] + p[3] * u[1] * v[1]; + Jv[1] = -p[1] * u[0] * v[0] + (-p[2] + p[3] * u[0]) * v[1]; + + return 0; +} + +int parameter_vjp(N_Vector vvec, N_Vector Jvvec, sunrealtype t, N_Vector uvec, + N_Vector udotvec, void* user_data, N_Vector tmp) +{ + if (user_data != params) { return -1; } + + sunrealtype* u = N_VGetArrayPointer(uvec); + sunrealtype* v = N_VGetArrayPointer(vvec); + sunrealtype* Jv = N_VGetArrayPointer(Jvvec); + + Jv[0] = u[0] * v[0]; + Jv[1] = -u[0] * u[1] * v[0]; + Jv[2] = -u[1] * v[1]; + Jv[3] = u[0] * u[1] * v[1]; + + return 0; +} + +void dgdu(N_Vector uvec, N_Vector dgvec, const sunrealtype* p) +{ + sunrealtype* u = N_VGetArrayPointer(uvec); + sunrealtype* dg = N_VGetArrayPointer(dgvec); + + dg[0] = -SUN_RCONST(1.0) + u[0]; + dg[1] = -SUN_RCONST(1.0) + u[1]; +} + +void dgdp(N_Vector uvec, N_Vector dgvec, const sunrealtype* p) +{ + sunrealtype* dg = N_VGetArrayPointer(dgvec); + + dg[0] = SUN_RCONST(0.0); + dg[1] = SUN_RCONST(0.0); + dg[2] = SUN_RCONST(0.0); + dg[3] = SUN_RCONST(0.0); +} + +void print_help(int argc, char* argv[], int exit_code) +{ + if (exit_code) { fprintf(stderr, "%s: option not recognized\n", argv[0]); } + else { fprintf(stderr, "%s ", argv[0]); } + fprintf(stderr, "options:\n"); + fprintf(stderr, "--tf the final simulation time\n"); + fprintf(stderr, "--dt the timestep size\n"); + fprintf(stderr, "--order the order of the RK method\n"); + fprintf(stderr, "--check-freq how often to checkpoint (in steps)\n"); + fprintf(stderr, "--no-stages don't checkpoint stages\n"); + fprintf(stderr, + "--dont-keep don't keep checkpoints around after loading\n"); + fprintf(stderr, "--help print these options\n"); + exit(exit_code); +} + +void parse_args(int argc, char* argv[], ProgramArgs* args) +{ + for (int argi = 1; argi < argc; ++argi) + { + const char* arg = argv[argi]; + if (!strcmp(arg, "--tf")) { args->tf = atof(argv[++argi]); } + else if (!strcmp(arg, "--dt")) { args->dt = atof(argv[++argi]); } + else if (!strcmp(arg, "--order")) { args->order = atoi(argv[++argi]); } + else if (!strcmp(arg, "--check-freq")) + { + args->check_freq = atoi(argv[++argi]); + } + else if (!strcmp(arg, "--no-stages")) { args->save_stages = SUNFALSE; } + else if (!strcmp(arg, "--dont-keep")) { args->keep_checks = SUNFALSE; } + else if (!strcmp(arg, "--help")) { print_help(argc, argv, 0); } + else { print_help(argc, argv, 1); } + } +} + +int check_retval(void* retval_ptr, const char* funcname, int opt) +{ + int* retval; + + /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ + if (opt == 0 && retval_ptr == NULL) + { + fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", + funcname); + return 1; + } + + /* Check if retval < 0 */ + else if (opt == 1) + { + retval = (int*)retval_ptr; + if (*retval < 0) + { + fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with retval = %d\n\n", + funcname, *retval); + return 1; + } + } + + return (0); +} diff --git a/examples/arkode/C_serial/ark_lotka_volterra_ASA_--check-freq_1.out b/examples/arkode/C_serial/ark_lotka_volterra_ASA_--check-freq_1.out new file mode 100644 index 0000000000..512207bd66 --- /dev/null +++ b/examples/arkode/C_serial/ark_lotka_volterra_ASA_--check-freq_1.out @@ -0,0 +1,52 @@ +Initial condition: +1.0000000000000000e+00 +1.0000000000000000e+00 + +Forward Solution: +1.0263447675712871e+00 +9.0969107814004269e-01 + +ARKODE Stats for Forward Solution: +Current time = 10.0009999999999 +Steps = 10001 +Step attempts = 10001 +Stability limited steps = 0 +Accuracy limited steps = 0 +Error test fails = 0 +NLS step fails = 0 +Inequality constraint fails = 0 +Initial step size = 0.001 +Last step size = 0.001 +Current step size = 0.001 +Explicit RHS fn evals = 50006 +Implicit RHS fn evals = 0 +NLS iters = 0 +NLS fails = 0 +NLS iters per step = 0 +LS setups = 0 + +Adjoint terminal condition: +1.9360358457113298e+00 +1.9360358457113298e+00 + +0.0000000000000000e+00 +0.0000000000000000e+00 +0.0000000000000000e+00 +0.0000000000000000e+00 + +Adjoint Solution: +-1.4926513048964769e+00 +7.5866467767938539e-01 + +-7.7848751398398628e+00 +-1.0490727707562078e+00 +-2.1661090848372893e+00 +-3.5256325524648946e+00 + + +SUNAdjointStepper Stats: +Num backwards steps = 10001 +Num recompute passes = 0 +v-times-Jac evals = 50005 +v-times-Jacp evals = 50005 + diff --git a/examples/arkode/C_serial/ark_lotka_volterra_ASA_--check-freq_5.out b/examples/arkode/C_serial/ark_lotka_volterra_ASA_--check-freq_5.out new file mode 100644 index 0000000000..80031ffbf5 --- /dev/null +++ b/examples/arkode/C_serial/ark_lotka_volterra_ASA_--check-freq_5.out @@ -0,0 +1,52 @@ +Initial condition: +1.0000000000000000e+00 +1.0000000000000000e+00 + +Forward Solution: +1.0263447675712871e+00 +9.0969107814004269e-01 + +ARKODE Stats for Forward Solution: +Current time = 10.0009999999999 +Steps = 10001 +Step attempts = 10001 +Stability limited steps = 0 +Accuracy limited steps = 0 +Error test fails = 0 +NLS step fails = 0 +Inequality constraint fails = 0 +Initial step size = 0.001 +Last step size = 0.001 +Current step size = 0.001 +Explicit RHS fn evals = 50006 +Implicit RHS fn evals = 0 +NLS iters = 0 +NLS fails = 0 +NLS iters per step = 0 +LS setups = 0 + +Adjoint terminal condition: +1.9360358457113298e+00 +1.9360358457113298e+00 + +0.0000000000000000e+00 +0.0000000000000000e+00 +0.0000000000000000e+00 +0.0000000000000000e+00 + +Adjoint Solution: +-1.4947639071731134e+00 +7.5873448439158087e-01 + +-7.7894652372843973e+00 +-1.0491640634028794e+00 +-2.1671821513999858e+00 +-3.5275142622843187e+00 + + +SUNAdjointStepper Stats: +Num backwards steps = 10001 +Num recompute passes = 3080 +v-times-Jac evals = 50005 +v-times-Jacp evals = 50005 + diff --git a/examples/cvodes/serial/CMakeLists.txt b/examples/cvodes/serial/CMakeLists.txt index b8433dc751..06ce586a00 100644 --- a/examples/cvodes/serial/CMakeLists.txt +++ b/examples/cvodes/serial/CMakeLists.txt @@ -37,6 +37,7 @@ set(CVODES_examples "cvsKrylovDemo_ls\;1\;develop" "cvsKrylovDemo_ls\;2\;develop" "cvsKrylovDemo_prec\;\;develop" + "cvsLotkaVolterra_ASA\;\;develop" "cvsParticle_dns\;\;develop" "cvsPendulum_dns\;\;exclude-single" "cvsRoberts_ASAi_dns\;\;exclude-single" diff --git a/examples/cvodes/serial/cvsLotkaVolterra_ASA.c b/examples/cvodes/serial/cvsLotkaVolterra_ASA.c new file mode 100644 index 0000000000..1a243607e0 --- /dev/null +++ b/examples/cvodes/serial/cvsLotkaVolterra_ASA.c @@ -0,0 +1,326 @@ +/* ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 example solves the Lotka-Volterra ODE with four parameters, + * + * u' = [dx/dt] = [ p_0*x - p_1*x*y ] + * [dy/dt] [ -p_2*y + p_3*x*y ]. + * + * The initial condition is u(t_0) = 1.0 and we use the parameters + * p = [1.5, 1.0, 3.0, 1.0]. The integration interval is t \in [0, 10.]. + * The implicit BDF method from CVODES is used to solve the forward problem. + * Afterwards, the continuous adjoint sensitivity analysis capabilities of CVODES + * are used to obtain the gradient of the cost function, + * + * g(u(t_f), p) = || 1 - u(t_f, p) ||^2 / 2 + * + * with respect to the initial condition and the parameters. + * ----------------------------------------------------------------------------- + */ + +#include +#include +#include +#include +#include +#include "cvodes/cvodes_ls.h" +#include "sundials/sundials_context.h" +#include "sundials/sundials_iterative.h" +#include "sundials/sundials_nvector.h" +#include "sundials/sundials_types.h" +#include "sunlinsol/sunlinsol_dense.h" +#include "sunlinsol/sunlinsol_spgmr.h" + +/* Problem Constants */ +#define NEQ 2 /* number of equations */ +#define NP 4 /* number of params */ +#define T0 SUN_RCONST(0.0) /* initial time */ +#define TF SUN_RCONST(1.0) /* final time */ +#if defined(SUNDIALS_SINGLE_PRECISION) +#define RTOL SUN_RCONST(1.0e-5) /* relative tolerance */ +#define ATOL SUN_RCONST(1.0e-8) /* absolute tolerance */ +#else +#define RTOL SUN_RCONST(1.0e-10) /* relative tolerance */ +#define ATOL SUN_RCONST(1.0e-14) /* absolute tolerance */ +#endif +#define STEPS 5 /* checkpoint interval */ + +static int check_retval(void* retval_ptr, const char* funcname, int opt); + +static sunrealtype params[4] = {1.5, 1.0, 3.0, 1.0}; + +static int vjp(N_Vector vvec, N_Vector Jvvec, sunrealtype t, N_Vector uvec, + void* user_data); + +static int lotka_volterra(sunrealtype t, N_Vector uvec, N_Vector udotvec, + void* user_data); + +static int parameter_vjp(N_Vector vvec, N_Vector Jvvec, sunrealtype t, + N_Vector uvec, void* user_data); + +static void dgdu(N_Vector uvec, N_Vector dgvec); + +static int adjoint_rhs(sunrealtype t, N_Vector uvec, N_Vector lvec, + N_Vector ldotvec, void* user_data); + +static int quad_rhs(sunrealtype t, N_Vector uvec, N_Vector muvec, + N_Vector qBdotvec, void* user_dataB); + +int main(int argc, char* argv[]) +{ + SUNContext sunctx; + sunrealtype reltol, abstol, t, tout; + N_Vector u, uB, qB; + void* cvode_mem; + int which, retval; + + SUNContext_Create(SUN_COMM_NULL, &sunctx); + + /* Allocate memory for the solution vector */ + u = N_VNew_Serial(NEQ, sunctx); + if (check_retval((void*)u, "N_VNew_Serial", 0)) { return 1; } + + /* Initialize the solution vector */ + N_VConst(1.0, u); + + /* Set the tolerances */ + reltol = RTOL; + abstol = ATOL; + + /* Create the CVODES object */ + cvode_mem = CVodeCreate(CV_BDF, sunctx); + if (check_retval((void*)cvode_mem, "CVodeCreate", 0)) { return 1; } + + /* Initialize the CVODES solver */ + retval = CVodeInit(cvode_mem, lotka_volterra, T0, u); + if (check_retval(&retval, "CVodeInit", 1)) { return 1; } + + /* Set the user data */ + retval = CVodeSetUserData(cvode_mem, (void*)params); + if (check_retval(&retval, "CVodeSetUserData", 1)) { return 1; } + + /* Set the tolerances */ + retval = CVodeSStolerances(cvode_mem, reltol, abstol); + if (check_retval(&retval, "CVodeSStolerances", 1)) { return 1; } + + // SUNLinearSolver LS = SUNLinSol_Dense(y, NULL, sunctx); + SUNLinearSolver LS = SUNLinSol_SPGMR(u, SUN_PREC_NONE, 3, sunctx); + + retval = CVodeSetLinearSolver(cvode_mem, LS, NULL); + if (check_retval(&retval, "CVodeSetLinearSolver", 1)) { return 1; } + + retval = CVodeSetMaxNumSteps(cvode_mem, 100000); + if (check_retval(&retval, "CVodeSetMaxNumSteps", 1)) { return 1; } + + /* Initialize ASA */ + retval = CVodeAdjInit(cvode_mem, STEPS, CV_HERMITE); + if (check_retval(&retval, "CVodeAdjInit", 1)) { return 1; } + + /* Integrate the ODE */ + tout = TF; + int ncheck; + retval = CVodeF(cvode_mem, tout, u, &t, CV_NORMAL, &ncheck); + if (check_retval(&retval, "CVode", 1)) { return 1; } + + /* Print the final solution */ + printf("Forward Solution at t = %g:\n", t); + N_VPrint(u); + + /* Allocate memory for the adjoint solution vector */ + uB = N_VNew_Serial(NEQ, sunctx); + if (check_retval((void*)uB, "N_VNew_Serial", 0)) { return 1; } + + /* Allocate memory for the quadrature equations and initialize it to zero */ + qB = N_VNew_Serial(NP, sunctx); + N_VConst(SUN_RCONST(0.0), qB); + + /* Initialize the adjoint solution vector */ + dgdu(u, uB); + + printf("Adjoint terminal condition:\n"); + N_VPrint(uB); + N_VPrint(qB); + + /* Create the CVODES object for the backward problem */ + retval = CVodeCreateB(cvode_mem, CV_BDF, &which); + + /* Initialize the CVODES solver for the backward problem */ + retval = CVodeInitB(cvode_mem, which, adjoint_rhs, TF, uB); + if (check_retval(&retval, "CVodeInitB", 1)) { return 1; } + + /* Set the user data for the backward problem */ + retval = CVodeSetUserDataB(cvode_mem, which, (void*)params); + if (check_retval(&retval, "CVodeSetUserDataB", 1)) { return 1; } + + /* Set the tolerances for the backward problem */ + retval = CVodeSStolerancesB(cvode_mem, which, reltol, abstol); + if (check_retval(&retval, "CVodeSStolerancesB", 1)) { return 1; } + + /* Create the linear solver for the backward problem */ + SUNLinearSolver LSB = SUNLinSol_SPGMR(uB, SUN_PREC_NONE, 3, sunctx); + + retval = CVodeSetLinearSolverB(cvode_mem, which, LSB, NULL); + if (check_retval(&retval, "CVodeSetLinearSolver", 1)) { return 1; } + + /* Call CVodeQuadInitB to allocate internal memory and initialize backward + quadrature integration. This gives the sensitivities w.r.t. the parameters. */ + retval = CVodeQuadInitB(cvode_mem, which, quad_rhs, qB); + if (check_retval(&retval, "CVodeQuadInitB", 1)) { return (1); } + + /* Call CVodeSetQuadErrCon to specify whether or not the quadrature variables + are to be used in the step size control mechanism within CVODES. Call + CVodeQuadSStolerances or CVodeQuadSVtolerances to specify the integration + tolerances for the quadrature variables. */ + retval = CVodeSetQuadErrConB(cvode_mem, which, SUNTRUE); + if (check_retval(&retval, "CVodeSetQuadErrConB", 1)) { return (1); } + + /* Call CVodeQuadSStolerancesB to specify the scalar relative and absolute tolerances + for the backward problem. */ + retval = CVodeQuadSStolerancesB(cvode_mem, which, reltol, abstol); + if (check_retval(&retval, "CVodeQuadSStolerancesB", 1)) { return (1); } + + /* Integrate the adjoint ODE */ + retval = CVodeB(cvode_mem, T0, CV_NORMAL); + if (check_retval(&retval, "CVodeB", 1)) { return 1; } + + /* Get the final adjoint solution */ + retval = CVodeGetB(cvode_mem, which, &t, uB); + if (check_retval(&retval, "CVodeGetB", 1)) { return 1; } + + /* Call CVodeGetQuadB to get the quadrature solution vector after a + successful return from CVodeB. */ + retval = CVodeGetQuadB(cvode_mem, which, &t, qB); + if (check_retval(&retval, "CVodeGetQuadB", 1)) { return (1); } + + /* Print the final adjoint solution */ + printf("Adjoint Solution at t = %g:\n", t); + N_VPrint(uB); + N_VPrint(qB); + + /* Free memory */ + N_VDestroy(u); + N_VDestroy(uB); + N_VDestroy(qB); + SUNLinSolFree(LS); + SUNLinSolFree(LSB); + CVodeFree(&cvode_mem); + SUNContext_Free(&sunctx); + + return 0; +} + +/* Function to compute the ODE right-hand side */ +int lotka_volterra(sunrealtype t, N_Vector uvec, N_Vector udotvec, void* user_data) +{ + sunrealtype* p = (sunrealtype*)user_data; + sunrealtype* u = N_VGetArrayPointer(uvec); + sunrealtype* udot = N_VGetArrayPointer(udotvec); + + udot[0] = p[0] * u[0] - p[1] * u[0] * u[1]; + udot[1] = -p[2] * u[1] + p[3] * u[0] * u[1]; + + return 0; +} + +/* Function to compute v^T (df/du) */ +int vjp(N_Vector vvec, N_Vector Jvvec, sunrealtype t, N_Vector uvec, + void* user_data) +{ + sunrealtype* p = (sunrealtype*)user_data; + sunrealtype* u = N_VGetArrayPointer(uvec); + sunrealtype* v = N_VGetArrayPointer(vvec); + sunrealtype* Jv = N_VGetArrayPointer(Jvvec); + + Jv[0] = (p[0] - p[1] * u[1]) * v[0] + p[3] * u[1] * v[1]; + Jv[1] = -p[1] * u[0] * v[0] + (-p[2] + p[3] * u[0]) * v[1]; + + return 0; +} + +/* Function to compute v^T (df/dp) */ +int parameter_vjp(N_Vector vvec, N_Vector Jvvec, sunrealtype t, N_Vector uvec, + void* user_data) +{ + if (user_data != params) { return -1; } + + sunrealtype* u = N_VGetArrayPointer(uvec); + sunrealtype* v = N_VGetArrayPointer(vvec); + sunrealtype* Jv = N_VGetArrayPointer(Jvvec); + + Jv[0] = u[0] * v[0]; + Jv[1] = -u[0] * u[1] * v[0]; + Jv[2] = -u[1] * v[1]; + Jv[3] = u[0] * u[1] * v[1]; + + return 0; +} + +/* Gradient of the cost function w.r.t to u. + The gradient w.r.t to p is zero since the cost function + does not depend on the parameters. */ +void dgdu(N_Vector uvec, N_Vector dgvec) +{ + sunrealtype* u = N_VGetArrayPointer(uvec); + sunrealtype* dg = N_VGetArrayPointer(dgvec); + + dg[0] = -SUN_RCONST(1.0) + u[0]; + dg[1] = -SUN_RCONST(1.0) + u[1]; +} + +/* Function to compute the adjoint ODE right-hand side: + -mu^T (df/du) + */ +int adjoint_rhs(sunrealtype t, N_Vector uvec, N_Vector lvec, N_Vector ldotvec, + void* user_data) +{ + vjp(lvec, ldotvec, t, uvec, user_data); + N_VScale(-1.0, ldotvec, ldotvec); + + return 0; +} + +/* Function to compute the quadrature right-hand side: + mu^T (df/dp) + */ +int quad_rhs(sunrealtype t, N_Vector uvec, N_Vector muvec, N_Vector qBdotvec, + void* user_dataB) +{ + parameter_vjp(muvec, qBdotvec, t, uvec, user_dataB); + return 0; +} + +/* Check function return value */ +int check_retval(void* retval_ptr, const char* funcname, int opt) +{ + int* retval; + + /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ + if (opt == 0 && retval_ptr == NULL) + { + fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", + funcname); + return 1; + } + + /* Check if retval < 0 */ + else if (opt == 1) + { + retval = (int*)retval_ptr; + if (*retval < 0) + { + fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with retval = %d\n\n", + funcname, *retval); + return 1; + } + } + + return (0); +} diff --git a/examples/cvodes/serial/cvsLotkaVolterra_ASA.out b/examples/cvodes/serial/cvsLotkaVolterra_ASA.out new file mode 100644 index 0000000000..57495742f8 --- /dev/null +++ b/examples/cvodes/serial/cvsLotkaVolterra_ASA.out @@ -0,0 +1,22 @@ +Forward Solution at t = 10 +1.0263448015893779e+00 +9.0969106392430898e-01 + +Adjoint terminal condition: +1.9360358655136869e+00 +1.9360358655136869e+00 + +0.0000000000000000e+00 +0.0000000000000000e+00 +0.0000000000000000e+00 +0.0000000000000000e+00 + +Adjoint Solution at t = 0: +-1.5062028945464851e+00 +7.7496083813398497e-01 + +7.9304147529003224e+00 +9.8623365223362636e-01 +2.2183773121596766e+00 +3.4932432378604874e+00 + diff --git a/examples/sunmatrix/band/test_sunmatrix_band.c b/examples/sunmatrix/band/test_sunmatrix_band.c index 6833724a5c..189c67e819 100644 --- a/examples/sunmatrix/band/test_sunmatrix_band.c +++ b/examples/sunmatrix/band/test_sunmatrix_band.c @@ -24,6 +24,7 @@ #include #include #include +#include #include "test_sunmatrix.h" @@ -44,7 +45,7 @@ int main(int argc, char* argv[]) { int fails = 0; /* counter for test failures */ sunindextype cols, uband, lband; /* matrix columns, bandwidths */ - SUNMatrix A, I; /* test matrices */ + SUNMatrix A, AT, I; /* test matrices */ N_Vector x, y; /* test vectors */ int print_timing; sunindextype i, j, k, kstart, kend, jstart, jend; @@ -101,10 +102,11 @@ int main(int argc, char* argv[]) I = NULL; /* Create matrices and vectors */ - A = SUNBandMatrix(cols, uband, lband, sunctx); - I = SUNBandMatrix(cols, 0, 0, sunctx); - x = N_VNew_Serial(cols, sunctx); - y = N_VNew_Serial(cols, sunctx); + A = SUNBandMatrix(cols, uband, lband, sunctx); + AT = SUNBandMatrix(cols, lband, uband, sunctx); + I = SUNBandMatrix(cols, 0, 0, sunctx); + x = N_VNew_Serial(cols, sunctx); + y = N_VNew_Serial(cols, sunctx); /* Fill matrices */ xdata = N_VGetArrayPointer(x); @@ -125,6 +127,18 @@ int main(int argc, char* argv[]) } } + /* Create A^T */ + for (j = 0; j < cols; j++) + { + for (i = 0; i < cols; i++) + { + if (j - uband <= i && i <= j + lband) + { + SM_ELEMENT_B(AT, j, i) = SM_ELEMENT_B(A, i, j); + } + } + } + /* Fill vectors */ for (i = 0; i < cols; i++) { @@ -146,6 +160,7 @@ int main(int argc, char* argv[]) fails += Test_SUNMatScaleAdd(A, I, 0); fails += Test_SUNMatScaleAddI(A, I, 0); fails += Test_SUNMatMatvec(A, x, y, 0); + fails += Test_SUNMatMatTransposeVec(A, AT, x, y, 0); fails += Test_SUNMatSpace(A, 0); /* Print result */ @@ -154,6 +169,8 @@ int main(int argc, char* argv[]) printf("FAIL: SUNMatrix module failed %i tests \n \n", fails); printf("\nA =\n"); SUNBandMatrix_Print(A, stdout); + printf("\nA^T =\n"); + SUNBandMatrix_Print(AT, stdout); printf("\nI =\n"); SUNBandMatrix_Print(I, stdout); printf("\nx =\n"); @@ -165,6 +182,7 @@ int main(int argc, char* argv[]) /* Free matrices and vectors */ SUNMatDestroy(A); + SUNMatDestroy(AT); SUNMatDestroy(I); N_VDestroy(x); N_VDestroy(y); diff --git a/examples/sunmatrix/dense/test_sunmatrix_dense.c b/examples/sunmatrix/dense/test_sunmatrix_dense.c index 168cfabe54..339d4230f9 100644 --- a/examples/sunmatrix/dense/test_sunmatrix_dense.c +++ b/examples/sunmatrix/dense/test_sunmatrix_dense.c @@ -42,12 +42,12 @@ * --------------------------------------------------------------------*/ int main(int argc, char* argv[]) { - int fails = 0; /* counter for test failures */ - sunindextype matrows, matcols; /* vector length */ - N_Vector x, y; /* test vectors */ - sunrealtype *xdata, *ydata; /* pointers to vector data */ - SUNMatrix A, I; /* test matrices */ - sunrealtype *Adata, *Idata; /* pointers to matrix data */ + int fails = 0; /* counter for test failures */ + sunindextype matrows, matcols; /* vector length */ + N_Vector x, y; /* test vectors */ + sunrealtype *xdata, *ydata; /* pointers to vector data */ + SUNMatrix A, AT, I; /* test matrices */ + sunrealtype *Adata, *ATdata, *Idata; /* pointers to matrix data */ int print_timing, square; sunindextype i, j, m, n; SUNContext sunctx; @@ -94,10 +94,11 @@ int main(int argc, char* argv[]) I = NULL; /* Create vectors and matrices */ - x = N_VNew_Serial(matcols, sunctx); - y = N_VNew_Serial(matrows, sunctx); - A = SUNDenseMatrix(matrows, matcols, sunctx); - I = NULL; + x = N_VNew_Serial(matcols, sunctx); + y = N_VNew_Serial(matrows, sunctx); + A = SUNDenseMatrix(matrows, matcols, sunctx); + AT = SUNDenseMatrix(matcols, matrows, sunctx); + I = NULL; if (square) { I = SUNDenseMatrix(matrows, matcols, sunctx); } /* Fill matrices and vectors */ @@ -110,6 +111,15 @@ int main(int argc, char* argv[]) } } + ATdata = SUNDenseMatrix_Data(AT); + for (j = 0; j < matcols; j++) + { + for (i = 0; i < matrows; i++) + { + ATdata[i * matcols + j] = (j + 1) * (i + j); + } + } + if (square) { Idata = SUNDenseMatrix_Data(I); @@ -138,6 +148,7 @@ int main(int argc, char* argv[]) fails += Test_SUNMatScaleAddI(A, I, 0); } fails += Test_SUNMatMatvec(A, x, y, 0); + fails += Test_SUNMatMatTransposeVec(A, AT, x, y, 0); fails += Test_SUNMatSpace(A, 0); /* Print result */ @@ -162,6 +173,7 @@ int main(int argc, char* argv[]) N_VDestroy(x); N_VDestroy(y); SUNMatDestroy(A); + SUNMatDestroy(AT); if (square) { SUNMatDestroy(I); } SUNContext_Free(&sunctx); diff --git a/examples/sunmatrix/sparse/test_sunmatrix_sparse.c b/examples/sunmatrix/sparse/test_sunmatrix_sparse.c index 0cb7cb3786..0cff1d38f0 100644 --- a/examples/sunmatrix/sparse/test_sunmatrix_sparse.c +++ b/examples/sunmatrix/sparse/test_sunmatrix_sparse.c @@ -40,13 +40,13 @@ int Test_SUNSparseMatrixToCSR(SUNMatrix A); * --------------------------------------------------------------------*/ int main(int argc, char* argv[]) { - int fails = 0; /* counter for test failures */ - sunindextype matrows, matcols; /* matrix dims */ - int mattype; /* matrix storage type */ - N_Vector x, y, z; /* test vectors */ - sunrealtype* vecdata; /* pointers to vector data */ - SUNMatrix A, B, C, D, I; /* test matrices */ - sunrealtype* matdata; /* pointer to matrix data */ + int fails = 0; /* counter for test failures */ + sunindextype matrows, matcols; /* matrix dims */ + int mattype; /* matrix storage type */ + N_Vector x, y, z; /* test vectors */ + sunrealtype* vecdata; /* pointers to vector data */ + SUNMatrix A, AT, B, C, CT, D, I; /* test matrices */ + sunrealtype* matdata; /* pointer to matrix data */ sunindextype i, j, k, kstart, kend, N, uband, lband; sunindextype *colptrs, *rowindices; sunindextype *rowptrs, *colindices; @@ -97,14 +97,15 @@ int main(int argc, char* argv[]) (long int)matrows, (long int)matcols, mattype); /* Initialize vectors and matrices to NULL */ - x = NULL; - y = NULL; - z = NULL; - A = NULL; - B = NULL; - C = NULL; - D = NULL; - I = NULL; + x = NULL; + y = NULL; + z = NULL; + A = NULL; + B = NULL; + C = NULL; + CT = NULL; + D = NULL; + I = NULL; /* check creating sparse matrix from dense matrix */ B = SUNDenseMatrix(5, 6, sunctx); @@ -389,8 +390,9 @@ int main(int argc, char* argv[]) } /* Create/fill random dense matrices, create sparse from them */ - C = SUNDenseMatrix(matrows, matcols, sunctx); - D = SUNDenseMatrix(matrows, matcols, sunctx); + C = SUNDenseMatrix(matrows, matcols, sunctx); + CT = SUNDenseMatrix(matcols, matrows, sunctx); + D = SUNDenseMatrix(matrows, matcols, sunctx); for (k = 0; k < 3 * matrows; k++) { i = rand() % matrows; @@ -405,8 +407,19 @@ int main(int argc, char* argv[]) matdata = SUNDenseMatrix_Column(C, j); matdata[i] = (sunrealtype)rand() / (sunrealtype)RAND_MAX; } - A = SUNSparseFromDenseMatrix(C, ZERO, mattype); - B = SUNSparseFromDenseMatrix(D, ZERO, mattype); + + /* Create transposed matrices */ + for (i = 0; i < matcols; i++) + { + for (j = 0; j < matrows; j++) + { + SM_ELEMENT_D(CT, i, j) = SM_ELEMENT_D(C, j, i); + } + } + + A = SUNSparseFromDenseMatrix(C, ZERO, mattype); + AT = SUNSparseFromDenseMatrix(CT, ZERO, mattype); + B = SUNSparseFromDenseMatrix(D, ZERO, mattype); /* Create vectors and fill */ x = N_VNew_Serial(matcols, sunctx); @@ -457,6 +470,7 @@ int main(int argc, char* argv[]) fails += Test_SUNMatScaleAddI2(A, x, y); } fails += Test_SUNMatMatvec(A, x, y, 0); + fails += Test_SUNMatMatTransposeVec(A, AT, x, y, 0); fails += Test_SUNMatSpace(A, 0); if (mattype == CSR_MAT) { fails += Test_SUNSparseMatrixToCSC(A); } else { fails += Test_SUNSparseMatrixToCSR(A); } @@ -488,8 +502,10 @@ int main(int argc, char* argv[]) N_VDestroy(y); N_VDestroy(z); SUNMatDestroy(A); + SUNMatDestroy(AT); SUNMatDestroy(B); SUNMatDestroy(C); + SUNMatDestroy(CT); SUNMatDestroy(D); if (square) { SUNMatDestroy(I); } diff --git a/examples/sunmatrix/test_sunmatrix.c b/examples/sunmatrix/test_sunmatrix.c index 47b2cf9296..fb2a422baf 100644 --- a/examples/sunmatrix/test_sunmatrix.c +++ b/examples/sunmatrix/test_sunmatrix.c @@ -573,6 +573,75 @@ int Test_SUNMatMatvec(SUNMatrix A, N_Vector x, N_Vector y, int myid) return (0); } +/* ---------------------------------------------------------------------- + * SUNMatMatTransposeVec Test (y should be correct A^T*x product) + * --------------------------------------------------------------------*/ +int Test_SUNMatMatTransposeVec(SUNMatrix A, SUNMatrix AT, N_Vector x, + N_Vector y, int myid) +{ + int failure; + double start_time, stop_time; + N_Vector z, w; + sunrealtype tol = 100 * SUN_UNIT_ROUNDOFF; + + if (A->ops->matvec == NULL) + { + TEST_STATUS(" PASSED test -- SUNMatMatTransposeVec not implemented\n", + myid); + return (0); + } + + w = N_VClone(x); /* reference solution computed with Matvec */ + z = N_VClone(x); /* will be computed with MatvecTranspose */ + + /* Compute reference solution */ + failure = SUNMatMatvec(AT, y, w); /* w = A^Ty */ + sync_device(A); + if (failure) + { + TEST_STATUS2(">>> FAILED test -- SUNMatMatTransposeVec: SUNMatMatvec " + "returned %d \n", + failure, myid); + return (1); + } + + /* Compute the solution with the routine we are testing */ + start_time = get_time(); + failure = SUNMatMatTransposeVec(A, y, z); /* z = A^Ty */ + sync_device(A); + stop_time = get_time(); + + if (failure) + { + TEST_STATUS2(">>> FAILED test -- SUNMatMatTransposeVec: " + "SUNMatMatTransposeVec returned %d \n", + failure, myid); + return (1); + } + + failure = check_vector(w, z, tol); + + if (failure) + { + TEST_STATUS(">>> FAILED test -- SUNMatMatTransposeVec check \n", myid); + PRINT_TIME(" SUNMatMatTransposeVec Time: %22.15e \n \n", + stop_time - start_time); + return (1); + } + else { TEST_STATUS(" PASSED test -- SUNMatMatTransposeVec \n", myid); } + + if (myid == 0) + { + PRINT_TIME(" SUNMatMatTransposeVec Time: %22.15e \n \n", + stop_time - start_time); + } + + N_VDestroy(w); + N_VDestroy(z); + + return (0); +} + /* ---------------------------------------------------------------------- * SUNMatSpace Test * --------------------------------------------------------------------*/ diff --git a/examples/sunmatrix/test_sunmatrix.h b/examples/sunmatrix/test_sunmatrix.h index 476b15d50d..4668c57163 100644 --- a/examples/sunmatrix/test_sunmatrix.h +++ b/examples/sunmatrix/test_sunmatrix.h @@ -74,6 +74,8 @@ int Test_SUNMatScaleAdd(SUNMatrix A, SUNMatrix I, int myid); int Test_SUNMatScaleAddI(SUNMatrix A, SUNMatrix I, int myid); int Test_SUNMatMatvecSetup(SUNMatrix A, int myid); int Test_SUNMatMatvec(SUNMatrix A, N_Vector x, N_Vector y, int myid); +int Test_SUNMatMatTransposeVec(SUNMatrix A, SUNMatrix AT, N_Vector x, + N_Vector y, int myid); int Test_SUNMatSpace(SUNMatrix A, int myid); /* Timing function */ diff --git a/include/arkode/arkode.h b/include/arkode/arkode.h index f33ec560dc..ac14bd78f8 100644 --- a/include/arkode/arkode.h +++ b/include/arkode/arkode.h @@ -30,7 +30,9 @@ #include #include +#include #include +#include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { @@ -139,6 +141,10 @@ extern "C" { #define ARK_CONTROLLER_ERR -47 #define ARK_STEPPER_UNSUPPORTED -48 +#define ARK_SUNSTEPPER_ERR -49 + +#define ARK_ADJ_CHECKPOINT_FAIL -50 +#define ARK_ADJ_RECOMPUTE_FAIL -51 #define ARK_UNRECOGNIZED_ERROR -99 @@ -280,6 +286,11 @@ SUNDIALS_EXPORT int ARKodeSetInitStep(void* arkode_mem, sunrealtype hin); SUNDIALS_EXPORT int ARKodeSetMinStep(void* arkode_mem, sunrealtype hmin); SUNDIALS_EXPORT int ARKodeSetMaxStep(void* arkode_mem, sunrealtype hmax); SUNDIALS_EXPORT int ARKodeSetMaxNumConstrFails(void* arkode_mem, int maxfails); +SUNDIALS_EXPORT +int ARKodeSetAdjointCheckpointScheme(void* arkode_mem, + SUNAdjointCheckpointScheme checkpoint_scheme); +SUNDIALS_EXPORT +int ARKodeSetAdjointCheckpointIndex(void* arkode_mem, int64_t step_index); /* Integrate the ODE over an interval in t */ SUNDIALS_EXPORT int ARKodeEvolve(void* arkode_mem, sunrealtype tout, @@ -414,6 +425,9 @@ SUNDIALS_EXPORT int ARKodeGetNumRelaxSolveFails(void* arkode_mem, SUNDIALS_EXPORT int ARKodeGetNumRelaxSolveIters(void* arkode_mem, long int* iters); +/* SUNStepper functions */ +SUNDIALS_EXPORT int ARKodeCreateSUNStepper(void* arkode_mem, SUNStepper* stepper); + #ifdef __cplusplus } #endif diff --git a/include/arkode/arkode_arkstep.h b/include/arkode/arkode_arkstep.h index 9a0cfbb5a1..9d364860f7 100644 --- a/include/arkode/arkode_arkstep.h +++ b/include/arkode/arkode_arkstep.h @@ -23,6 +23,8 @@ #include #include #include +#include +#include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { @@ -397,6 +399,13 @@ SUNDIALS_DEPRECATED_EXPORT_MSG("use ARKodeFree instead") void ARKStepFree(void** arkode_mem); SUNDIALS_DEPRECATED_EXPORT_MSG("use ARKodePrintMem instead") void ARKStepPrintMem(void* arkode_mem, FILE* outfile); + +/* Adjoint solver functions */ +SUNDIALS_EXPORT +int ARKStepCreateAdjointStepper(void* arkode_mem, N_Vector sf, + SUNAdjointStepper* adj_stepper_ptr); + +/* Relaxation functions */ SUNDIALS_DEPRECATED_EXPORT_MSG("use ARKodeSetRelaxFn instead") int ARKStepSetRelaxFn(void* arkode_mem, ARKRelaxFn rfn, ARKRelaxJacFn rjac); SUNDIALS_DEPRECATED_EXPORT_MSG("use ARKodeSetRelaxEtaFail instead") diff --git a/include/arkode/arkode_mristep.h b/include/arkode/arkode_mristep.h index 828272948a..506534b9db 100644 --- a/include/arkode/arkode_mristep.h +++ b/include/arkode/arkode_mristep.h @@ -22,6 +22,7 @@ #include #include #include +#include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { @@ -167,6 +168,10 @@ SUNDIALS_EXPORT int MRIStepGetLastInnerStepFlag(void* arkode_mem, int* flag); /* Custom inner stepper functions */ SUNDIALS_EXPORT int MRIStepInnerStepper_Create(SUNContext sunctx, MRIStepInnerStepper* stepper); + +SUNDIALS_EXPORT int MRIStepInnerStepper_CreateFromSUNStepper( + SUNStepper sunstepper, MRIStepInnerStepper* stepper); + SUNDIALS_EXPORT int MRIStepInnerStepper_Free(MRIStepInnerStepper* stepper); SUNDIALS_EXPORT int MRIStepInnerStepper_SetContent(MRIStepInnerStepper stepper, void* content); diff --git a/include/sunadjoint/sunadjoint_checkpointscheme.h b/include/sunadjoint/sunadjoint_checkpointscheme.h new file mode 100644 index 0000000000..f28555b870 --- /dev/null +++ b/include/sunadjoint/sunadjoint_checkpointscheme.h @@ -0,0 +1,104 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 + * ----------------------------------------------------------------- + * SUNAdjointCheckpointScheme class declaration. + * ----------------------------------------------------------------*/ + +#ifndef _SUNADJOINT_CHECKPOINTSCHEME_H +#define _SUNADJOINT_CHECKPOINTSCHEME_H + +#include +#include "sundials/sundials_types.h" + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +typedef _SUNDIALS_STRUCT_ SUNAdjointCheckpointScheme_Ops_* SUNAdjointCheckpointScheme_Ops; +typedef _SUNDIALS_STRUCT_ SUNAdjointCheckpointScheme_* SUNAdjointCheckpointScheme; + +struct SUNAdjointCheckpointScheme_Ops_ +{ + SUNErrCode (*shouldWeSave)(SUNAdjointCheckpointScheme, int64_t step_num, + int64_t stage_num, sunrealtype t, + sunbooleantype* yes_or_no); + + SUNErrCode (*shouldWeDelete)(SUNAdjointCheckpointScheme, int64_t step_num, + int64_t stage_num, sunbooleantype* yes_or_no); + + SUNErrCode (*insertVector)(SUNAdjointCheckpointScheme, int64_t step_num, + int64_t stage_num, sunrealtype t, N_Vector state); + + SUNErrCode (*loadVector)(SUNAdjointCheckpointScheme, int64_t step_num, + int64_t stage_num, sunbooleantype peek, + N_Vector* out, sunrealtype* tout); + + SUNErrCode (*removeVector)(SUNAdjointCheckpointScheme, int64_t step_num, + int64_t stage_num, N_Vector* out); + + SUNErrCode (*destroy)(SUNAdjointCheckpointScheme*); + + SUNErrCode (*enableDense)(SUNAdjointCheckpointScheme, sunbooleantype on_or_off); +}; + +struct SUNAdjointCheckpointScheme_ +{ + SUNAdjointCheckpointScheme_Ops ops; + void* content; + SUNContext sunctx; +}; + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointCheckpointScheme_NewEmpty(SUNContext sunctx, + SUNAdjointCheckpointScheme*); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointCheckpointScheme_ShouldWeSave(SUNAdjointCheckpointScheme, + int64_t step_num, + int64_t stage_num, + sunrealtype t, + sunbooleantype* yes_or_no); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointCheckpointScheme_ShouldWeDelete(SUNAdjointCheckpointScheme, + int64_t step_num, + int64_t stage_num, + sunbooleantype* yes_or_no); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointCheckpointScheme_InsertVector(SUNAdjointCheckpointScheme, + int64_t step_num, + int64_t stage_num, + sunrealtype t, N_Vector state); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointCheckpointScheme_LoadVector( + SUNAdjointCheckpointScheme, int64_t step_num, int64_t stage_num, + sunbooleantype peek, N_Vector* out, sunrealtype* tout); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointCheckpointScheme_RemoveVector(SUNAdjointCheckpointScheme, + int64_t step_num, + int64_t stage_num, + N_Vector* out); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointCheckpointScheme_Destroy(SUNAdjointCheckpointScheme*); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointCheckpointScheme_EnableDense(SUNAdjointCheckpointScheme, + sunbooleantype on_or_off); + +#ifdef __cplusplus +} +#endif + +#endif /*_SUNADJOINT_CHECKPOINTSCHEME_H*/ diff --git a/include/sunadjoint/sunadjoint_checkpointscheme_fixed.h b/include/sunadjoint/sunadjoint_checkpointscheme_fixed.h new file mode 100644 index 0000000000..37412dda49 --- /dev/null +++ b/include/sunadjoint/sunadjoint_checkpointscheme_fixed.h @@ -0,0 +1,70 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 + * ----------------------------------------------------------------- + * SUNAdjointCheckpointScheme_Fixed class declaration. + * ----------------------------------------------------------------*/ + +#ifndef _sunadjoint_checkpointscheme_fixed_H +#define _sunadjoint_checkpointscheme_fixed_H + +#include +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointCheckpointScheme_Create_Fixed( + SUNDataIOMode io_mode, SUNMemoryHelper mem_helper, int64_t interval, + int64_t estimate, sunbooleantype save_stages, sunbooleantype keep, + SUNContext sunctx, SUNAdjointCheckpointScheme* check_scheme_ptr); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointCheckpointScheme_ShouldWeSave_Fixed( + SUNAdjointCheckpointScheme check_scheme, int64_t step_num, int64_t stage_num, + sunrealtype t, sunbooleantype* yes_or_no); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointCheckpointScheme_InsertVector_Fixed( + SUNAdjointCheckpointScheme check_scheme, int64_t step_num, int64_t stage_num, + sunrealtype t, N_Vector state); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointCheckpointScheme_ShouldWeDelete_Fixed( + SUNAdjointCheckpointScheme check_scheme, int64_t step_num, int64_t stage_num, + sunbooleantype* yes_or_no); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointCheckpointScheme_RemoveVector_Fixed( + SUNAdjointCheckpointScheme check_scheme, int64_t step_num, int64_t stage_num, + N_Vector* out); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointCheckpointScheme_LoadVector_Fixed( + SUNAdjointCheckpointScheme check_scheme, int64_t step_num, int64_t stage_num, + sunbooleantype peek, N_Vector* out, sunrealtype* tout); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointCheckpointScheme_Destroy_Fixed( + SUNAdjointCheckpointScheme* check_scheme_ptr); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointCheckpointScheme_EnableDense_Fixed( + SUNAdjointCheckpointScheme check_scheme, sunbooleantype on_or_off); + +#ifdef __cplusplus +} +#endif + +#endif /* _sunadjoint_checkpointscheme_fixed_H */ diff --git a/include/sunadjoint/sunadjoint_stepper.h b/include/sunadjoint/sunadjoint_stepper.h new file mode 100644 index 0000000000..ac5e94d23e --- /dev/null +++ b/include/sunadjoint/sunadjoint_stepper.h @@ -0,0 +1,107 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 + * ----------------------------------------------------------------- + * SUNAdjointStepper class definition. + * ----------------------------------------------------------------*/ + +#ifndef _SUNADJOINT_STEPPER_H +#define _SUNADJOINT_STEPPER_H + +#include +#include +#include + +#include "sundials/sundials_types.h" + +struct SUNAdjointStepper_ +{ + SUNStepper adj_sunstepper; + SUNStepper fwd_sunstepper; + SUNAdjointCheckpointScheme checkpoint_scheme; + + sunrealtype tf; + int64_t step_idx, final_step_idx; + int last_flag; + + /* Jacobian-related data */ + SUNMatrix Jac, JacP; + SUNRhsJacFn JacFn, JacPFn; + SUNRhsJacTimesFn JvpFn, JPvpFn, vJpFn, vJPpFn; + + /* counters */ + int64_t nst, njeval, njpeval, njtimesv, njptimesv, nvtimesj, nvtimesjp, + nrecompute; + + void* user_data; + void* content; + SUNContext sunctx; +}; + +typedef struct SUNAdjointStepper_* SUNAdjointStepper; + +#ifdef __cplusplus +extern "C" { +#endif + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointStepper_Create( + SUNStepper fwd_sunstepper, SUNStepper adj_sunstepper, int64_t final_step_idx, + N_Vector sf, sunrealtype tf, SUNAdjointCheckpointScheme checkpoint_scheme, + SUNContext sunctx, SUNAdjointStepper* adj_stepper); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointStepper_ReInit(SUNAdjointStepper adj, N_Vector y0, + sunrealtype t0, N_Vector sf, sunrealtype tf); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointStepper_Evolve(SUNAdjointStepper adj_stepper, + sunrealtype tout, N_Vector sens, + sunrealtype* tret); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointStepper_OneStep(SUNAdjointStepper adj_stepper, + sunrealtype tout, N_Vector sens, + sunrealtype* tret); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointStepper_RecomputeFwd(SUNAdjointStepper adj_stepper, + int64_t start_idx, sunrealtype t0, + sunrealtype tf, N_Vector y0); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointStepper_SetJacFn(SUNAdjointStepper, SUNRhsJacFn JacFn, + SUNMatrix Jac, SUNRhsJacFn JacPFn, + SUNMatrix JP); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointStepper_SetJacTimesVecFn(SUNAdjointStepper, + SUNRhsJacTimesFn Jvp, + SUNRhsJacTimesFn JPvp); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointStepper_SetVecTimesJacFn(SUNAdjointStepper, + SUNRhsJacTimesFn vJp, + SUNRhsJacTimesFn vJPp); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointStepper_SetUserData(SUNAdjointStepper, void* user_data); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointStepper_PrintAllStats(SUNAdjointStepper adj_stepper, + FILE* outfile, SUNOutputFormat fmt); + +SUNDIALS_EXPORT +SUNErrCode SUNAdjointStepper_Destroy(SUNAdjointStepper*); + +#ifdef __cplusplus +} +#endif +#endif /* _SUNADJOINT_STEPPER_H */ diff --git a/include/sundials/sundials_errors.h b/include/sundials/sundials_errors.h index 3aefc0ea57..caf79a2808 100644 --- a/include/sundials/sundials_errors.h +++ b/include/sundials/sundials_errors.h @@ -48,6 +48,8 @@ "operation is not implemented: function pointer is NULL") \ ENTRY(SUN_ERR_USER_FCN_FAIL, "the user provided callback function failed") \ \ + ENTRY(SUN_ERR_DATANODE_NODENOTFOUND, "the data node could not be found") \ + \ ENTRY(SUN_ERR_PROFILER_MAPFULL, \ "the number of profiler entries exceeded SUNPROFILER_MAX_ENTRIES") \ ENTRY(SUN_ERR_PROFILER_MAPGET, "unknown error getting SUNProfiler timer") \ @@ -56,6 +58,15 @@ ENTRY(SUN_ERR_PROFILER_MAPKEYNOTFOUND, "timer was not found in SUNProfiler") \ ENTRY(SUN_ERR_PROFILER_MAPSORT, "error sorting SUNProfiler map") \ \ + ENTRY(SUN_ERR_ADJOINT_STEPPERFAILED, \ + "SUNStepper stopped without successfully reaching the requested " \ + "output time when solving the adjoint system") \ + ENTRY(SUN_ERR_ADJOINT_STEPPERINVALIDSTOP, \ + "SUNStepper stopped with a flag not supported by the " \ + "adjoint solver") \ + ENTRY(SUN_ERR_CHECKPOINT_NOT_FOUND, \ + "the requested checkpoint was not found") \ + \ ENTRY(SUN_ERR_SUNCTX_CORRUPT, "SUNContext is NULL or corrupt") \ \ ENTRY(SUN_ERR_MPI_FAIL, \ diff --git a/include/sundials/sundials_matrix.h b/include/sundials/sundials_matrix.h index 40dfdc22cf..3c9bee52cf 100644 --- a/include/sundials/sundials_matrix.h +++ b/include/sundials/sundials_matrix.h @@ -93,6 +93,7 @@ struct _generic_SUNMatrix_Ops SUNErrCode (*scaleaddi)(sunrealtype, SUNMatrix); SUNErrCode (*matvecsetup)(SUNMatrix); SUNErrCode (*matvec)(SUNMatrix, N_Vector, N_Vector); + SUNErrCode (*mattransposevec)(SUNMatrix, N_Vector, N_Vector); SUNErrCode (*space)(SUNMatrix, long int*, long int*); }; @@ -146,6 +147,9 @@ SUNErrCode SUNMatMatvecSetup(SUNMatrix A); SUNDIALS_EXPORT SUNErrCode SUNMatMatvec(SUNMatrix A, N_Vector x, N_Vector y); +SUNDIALS_EXPORT +SUNErrCode SUNMatMatTransposeVec(SUNMatrix A, N_Vector x, N_Vector y); + SUNDIALS_EXPORT SUNErrCode SUNMatSpace(SUNMatrix A, long int* lenrw, long int* leniw); diff --git a/include/sundials/sundials_memory.h b/include/sundials/sundials_memory.h index 53b01f6790..e1f1086da6 100644 --- a/include/sundials/sundials_memory.h +++ b/include/sundials/sundials_memory.h @@ -47,6 +47,7 @@ struct SUNMemory_ SUNMemoryType type; sunbooleantype own; size_t bytes; + size_t stride; }; /* Creates a new SUNMemory object with a NULL ptr */ @@ -77,6 +78,8 @@ struct SUNMemoryHelper_Ops_ size_t mem_size, void* queue); /* operations that provide default implementations */ + SUNErrCode (*allocstrided)(SUNMemoryHelper, SUNMemory* memptr, size_t mem_size, + size_t stride, SUNMemoryType mem_type, void* queue); SUNErrCode (*copyasync)(SUNMemoryHelper, SUNMemory dst, SUNMemory src, size_t mem_size, void* queue); SUNErrCode (*getallocstats)(SUNMemoryHelper, SUNMemoryType mem_type, @@ -115,6 +118,11 @@ SUNErrCode SUNMemoryHelper_Alloc(SUNMemoryHelper, SUNMemory* memptr, size_t mem_size, SUNMemoryType mem_type, void* queue); +SUNDIALS_EXPORT +SUNErrCode SUNMemoryHelper_AllocStrided(SUNMemoryHelper, SUNMemory* memptr, + size_t mem_size, size_t stride, + SUNMemoryType mem_type, void* queue); + SUNDIALS_EXPORT SUNErrCode SUNMemoryHelper_Dealloc(SUNMemoryHelper, SUNMemory mem, void* queue); diff --git a/include/sundials/sundials_stepper.h b/include/sundials/sundials_stepper.h new file mode 100644 index 0000000000..b43d4e3a2f --- /dev/null +++ b/include/sundials/sundials_stepper.h @@ -0,0 +1,130 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 _SUNDIALS_STEPPER_H +#define _SUNDIALS_STEPPER_H + +#include + +#ifdef __cplusplus +extern "C" { +#endif + +typedef enum +{ + SUN_FULLRHS_START, + SUN_FULLRHS_END, + SUN_FULLRHS_OTHER +} SUNFullRhsMode; + +typedef int (*SUNRhsJacFn)(sunrealtype t, N_Vector y, N_Vector fy, + SUNMatrix Jac, void* user_data, N_Vector tmp1, + N_Vector tmp2, N_Vector tmp3); + +typedef int (*SUNRhsJacTimesFn)(N_Vector v, N_Vector Jv, sunrealtype t, + N_Vector y, N_Vector fy, void* user_data, + N_Vector tmp); + +typedef _SUNDIALS_STRUCT_ SUNStepper_* SUNStepper; + +typedef SUNErrCode (*SUNStepperEvolveFn)(SUNStepper stepper, sunrealtype tout, + N_Vector vret, sunrealtype* tret); + +typedef SUNErrCode (*SUNStepperOneStepFn)(SUNStepper stepper, sunrealtype tout, + N_Vector vout, sunrealtype* tret); + +typedef SUNErrCode (*SUNStepperFullRhsFn)(SUNStepper stepper, sunrealtype t, + N_Vector v, N_Vector f, + SUNFullRhsMode mode); + +typedef SUNErrCode (*SUNStepperResetFn)(SUNStepper stepper, sunrealtype tR, + N_Vector vR, int64_t ckptIdxR); + +typedef SUNErrCode (*SUNStepperSetStopTimeFn)(SUNStepper stepper, + sunrealtype tstop); + +typedef SUNErrCode (*SUNStepperSetForcingFn)(SUNStepper stepper, + sunrealtype tshift, + sunrealtype tscale, + N_Vector* forcing, int nforcing); + +typedef SUNErrCode (*SUNStepperDestroyFn)(SUNStepper stepper); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_Create(SUNContext sunctx, SUNStepper* stepper); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_Destroy(SUNStepper* stepper); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_Evolve(SUNStepper stepper, sunrealtype tout, + N_Vector vret, sunrealtype* tret); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_OneStep(SUNStepper stepper, sunrealtype tout, + N_Vector vout, sunrealtype* tret); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_FullRhs(SUNStepper stepper, sunrealtype t, N_Vector v, + N_Vector f, SUNFullRhsMode mode); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_Reset(SUNStepper stepper, sunrealtype tR, N_Vector vR, + int64_t ckptIdxR); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_SetStopTime(SUNStepper stepper, sunrealtype tstop); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_SetForcing(SUNStepper stepper, sunrealtype tshift, + sunrealtype tscale, N_Vector* forcing, + int nforcing); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_SetContent(SUNStepper stepper, void* content); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_GetContent(SUNStepper stepper, void** content); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_SetLastFlag(SUNStepper stepper, int last_flag); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_GetLastFlag(SUNStepper stepper, int* last_flag); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_SetEvolveFn(SUNStepper stepper, SUNStepperEvolveFn fn); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_SetOneStepFn(SUNStepper stepper, SUNStepperOneStepFn fn); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_SetFullRhsFn(SUNStepper stepper, SUNStepperFullRhsFn fn); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_SetResetFn(SUNStepper stepper, SUNStepperResetFn fn); + +SUNDIALS_EXPORT +SUNErrCode SUNStepper_SetStopTimeFn(SUNStepper stepper, + SUNStepperSetStopTimeFn fn); + +SUNDIALS_EXPORT SUNErrCode SUNStepper_SetForcingFn(SUNStepper stepper, + SUNStepperSetForcingFn fn); + +SUNDIALS_EXPORT SUNErrCode SUNStepper_SetDestroyFn(SUNStepper stepper, + SUNStepperDestroyFn fn); + +#ifdef __cplusplus +} +#endif + +#endif /* _SUNDIALS_STEPPER_H */ diff --git a/include/sundials/sundials_types.h b/include/sundials/sundials_types.h index c959b6fe33..222bfb2ecf 100644 --- a/include/sundials/sundials_types.h +++ b/include/sundials/sundials_types.h @@ -230,4 +230,18 @@ typedef int SUNComm; } #endif +/* + *------------------------------------------------------------------ + * Type : SUNDataIOMode + *------------------------------------------------------------------ + * Type that controls IO modes for certain data operations, notably + * checkpoints for adjoints. + *------------------------------------------------------------------ + */ + +typedef enum +{ + SUNDATAIOMODE_INMEM, +} SUNDataIOMode; + #endif /* _SUNDIALS_TYPES_H */ diff --git a/include/sunmatrix/sunmatrix_band.h b/include/sunmatrix/sunmatrix_band.h index 1936d6ada4..d5e7ad3b5a 100644 --- a/include/sunmatrix/sunmatrix_band.h +++ b/include/sunmatrix/sunmatrix_band.h @@ -121,6 +121,8 @@ SUNDIALS_EXPORT SUNErrCode SUNMatScaleAdd_Band(sunrealtype c, SUNMatrix A, SUNMatrix B); SUNDIALS_EXPORT SUNErrCode SUNMatScaleAddI_Band(sunrealtype c, SUNMatrix A); SUNDIALS_EXPORT SUNErrCode SUNMatMatvec_Band(SUNMatrix A, N_Vector x, N_Vector y); +SUNDIALS_EXPORT SUNErrCode SUNMatMatTransposeVec_Band(SUNMatrix A, N_Vector x, + N_Vector y); SUNDIALS_EXPORT SUNErrCode SUNMatSpace_Band(SUNMatrix A, long int* lenrw, long int* leniw); diff --git a/include/sunmatrix/sunmatrix_dense.h b/include/sunmatrix/sunmatrix_dense.h index 2a49da3784..fc87c8d7e7 100644 --- a/include/sunmatrix/sunmatrix_dense.h +++ b/include/sunmatrix/sunmatrix_dense.h @@ -99,6 +99,8 @@ SUNDIALS_EXPORT SUNErrCode SUNMatScaleAdd_Dense(sunrealtype c, SUNMatrix A, SUNDIALS_EXPORT SUNErrCode SUNMatScaleAddI_Dense(sunrealtype c, SUNMatrix A); SUNDIALS_EXPORT SUNErrCode SUNMatMatvec_Dense(SUNMatrix A, N_Vector x, N_Vector y); +SUNDIALS_EXPORT SUNErrCode SUNMatMatTransposeVec_Dense(SUNMatrix A, N_Vector x, + N_Vector y); SUNDIALS_EXPORT SUNErrCode SUNMatSpace_Dense(SUNMatrix A, long int* lenrw, long int* leniw); diff --git a/include/sunmatrix/sunmatrix_sparse.h b/include/sunmatrix/sunmatrix_sparse.h index edb929cef4..b4d30becb8 100644 --- a/include/sunmatrix/sunmatrix_sparse.h +++ b/include/sunmatrix/sunmatrix_sparse.h @@ -175,6 +175,9 @@ SUNErrCode SUNMatScaleAddI_Sparse(sunrealtype c, SUNMatrix A); SUNDIALS_EXPORT SUNErrCode SUNMatMatvec_Sparse(SUNMatrix A, N_Vector x, N_Vector y); +SUNDIALS_EXPORT +SUNErrCode SUNMatMatTransposeVec_Sparse(SUNMatrix A, N_Vector x, N_Vector y); + SUNDIALS_EXPORT SUNErrCode SUNMatSpace_Sparse(SUNMatrix A, long int* lenrw, long int* leniw); diff --git a/include/sunmemory/sunmemory_system.h b/include/sunmemory/sunmemory_system.h index 2e45ca24fd..46669a7398 100644 --- a/include/sunmemory/sunmemory_system.h +++ b/include/sunmemory/sunmemory_system.h @@ -35,6 +35,12 @@ SUNErrCode SUNMemoryHelper_Alloc_Sys(SUNMemoryHelper helper, SUNMemory* memptr, size_t mem_size, SUNMemoryType mem_type, void* queue); +SUNDIALS_EXPORT +SUNErrCode SUNMemoryHelper_AllocStrided_Sys(SUNMemoryHelper helper, + SUNMemory* memptr, size_t mem_size, + size_t stride, + SUNMemoryType mem_type, void* queue); + SUNDIALS_EXPORT SUNErrCode SUNMemoryHelper_Dealloc_Sys(SUNMemoryHelper helper, SUNMemory mem, void* queue); diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index dbe00927ca..6952120494 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -23,6 +23,7 @@ add_subdirectory(sunlinsol) add_subdirectory(sunnonlinsol) add_subdirectory(sunmemory) add_subdirectory(sunadaptcontroller) +add_subdirectory(sunadjoint) # ARKODE library if(BUILD_ARKODE) diff --git a/src/arkode/CMakeLists.txt b/src/arkode/CMakeLists.txt index f8a0f4be63..9e51d43f13 100644 --- a/src/arkode/CMakeLists.txt +++ b/src/arkode/CMakeLists.txt @@ -41,6 +41,7 @@ set(arkode_SOURCES arkode_sprkstep_io.c arkode_sprkstep.c arkode_sprk.c + arkode_sunstepper.c arkode_user_controller.c arkode.c) @@ -70,8 +71,10 @@ sundials_add_library( INCLUDE_SUBDIR arkode LINK_LIBRARIES PUBLIC sundials_core OBJECT_LIBRARIES + sundials_adjoint_obj sundials_sunmemsys_obj sundials_nvecserial_obj + sundials_nvecmanyvector_obj sundials_sunadaptcontrollerimexgus_obj sundials_sunadaptcontrollersoderlind_obj sundials_sunmatrixband_obj diff --git a/src/arkode/arkode.c b/src/arkode/arkode.c index 6d66929483..d0095a25b3 100644 --- a/src/arkode/arkode.c +++ b/src/arkode/arkode.c @@ -35,6 +35,8 @@ #include "sundials/sundials_logger.h" #include "sundials_utils.h" +#include "sundials_macros.h" + /*=============================================================== Exported functions ===============================================================*/ @@ -1271,6 +1273,7 @@ void ARKodePrintMem(void* arkode_mem, FILE* outfile) fprintf(outfile, "fixedstep = %i\n", ark_mem->fixedstep); fprintf(outfile, "tolsf = %" RSYM "\n", ark_mem->tolsf); fprintf(outfile, "call_fullrhs = %i\n", ark_mem->call_fullrhs); + fprintf(outfile, "do_adjoint = %i\n", ark_mem->do_adjoint); /* output counters */ fprintf(outfile, "nhnil = %i\n", ark_mem->nhnil); @@ -1437,6 +1440,7 @@ ARKodeMem arkCreate(SUNContext sunctx) ark_mem->step_getnumnonlinsolviters = NULL; ark_mem->step_getnumnonlinsolvconvfails = NULL; ark_mem->step_getnonlinsolvstats = NULL; + ark_mem->step_setforcing = NULL; ark_mem->step_mem = NULL; ark_mem->step_supports_adaptive = SUNFALSE; ark_mem->step_supports_implicit = SUNFALSE; @@ -1518,6 +1522,8 @@ ARKodeMem arkCreate(SUNContext sunctx) return (NULL); } + ark_mem->do_adjoint = SUNFALSE; + /* Return pointer to ARKODE memory block */ return (ark_mem); } @@ -1711,6 +1717,9 @@ int arkInit(ARKodeMem ark_mem, sunrealtype t0, N_Vector y0, int init_type) and/or the stepper initialization function in arkInitialSetup */ ark_mem->call_fullrhs = SUNFALSE; + /* Adjoint related */ + ark_mem->checkpoint_step_idx = 0; + /* Indicate that initialization has not been done before */ ark_mem->initialized = SUNFALSE; } @@ -1822,6 +1831,14 @@ int arkInitialSetup(ARKodeMem ark_mem, sunrealtype tout) /* Test input tstop for legality (correct direction of integration) */ if (ark_mem->tstopset) { +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_DEBUG + SUNLogger_QueueMsg(ARK_LOGGER, SUN_LOGLEVEL_DEBUG, + "ARKODE::arkInitialSetup", "test-tstop", + "h = %" RSYM ", tcur = %" RSYM ", tout = %" RSYM + ", tstop = %" RSYM, + ark_mem->h, ark_mem->tcur, tout, ark_mem->tstop); +#endif + htmp = (ark_mem->h == ZERO) ? tout - ark_mem->tcur : ark_mem->h; if ((ark_mem->tstop - ark_mem->tcur) * htmp <= ZERO) { @@ -2519,8 +2536,10 @@ int arkCompleteStep(ARKodeMem ark_mem, sunrealtype dsm) /* update interpolation structure NOTE: This must be called before updating yn with ycur as the interpolation - module may need to save tn, yn from the start of this step */ - if (ark_mem->interp != NULL) + module may need to save tn, yn from the start of this step + + NOTE: When doing adjoint integration interpolation is disabled, so we skip this */ + if (ark_mem->interp != NULL && !ark_mem->do_adjoint) { retval = arkInterpUpdate(ark_mem, ark_mem->interp, ark_mem->tcur); if (retval != ARK_SUCCESS) { return (retval); } @@ -2545,6 +2564,7 @@ int arkCompleteStep(ARKodeMem ark_mem, sunrealtype dsm) /* update scalar quantities */ ark_mem->nst++; + ark_mem->checkpoint_step_idx++; ark_mem->hold = ark_mem->h; ark_mem->tn = ark_mem->tcur; ark_mem->hprime = ark_mem->h * ark_mem->eta; @@ -2670,6 +2690,14 @@ int arkHandleFailure(ARKodeMem ark_mem, int flag) arkProcessError(ark_mem, ARK_RELAX_JAC_FAIL, __LINE__, __func__, __FILE__, "The relaxation Jacobian failed unrecoverably"); break; + case ARK_ADJ_RECOMPUTE_FAIL: + arkProcessError(ark_mem, ARK_ADJ_RECOMPUTE_FAIL, __LINE__, __func__, __FILE__, + "The forward recomputation of step failed unrecoverably"); + break; + case ARK_SUNSTEPPER_ERR: + arkProcessError(ark_mem, ARK_SUNSTEPPER_ERR, __LINE__, __func__, __FILE__, + "An inner SUNStepper error occurred"); + break; default: /* This return should never happen */ arkProcessError(ark_mem, ARK_UNRECOGNIZED_ERROR, __LINE__, __func__, __FILE__, diff --git a/src/arkode/arkode_adapt.c b/src/arkode/arkode_adapt.c index ada5cda343..4192266888 100644 --- a/src/arkode/arkode_adapt.c +++ b/src/arkode/arkode_adapt.c @@ -143,8 +143,8 @@ int arkAdapt(ARKodeMem ark_mem, ARKodeHAdaptMem hadapt_mem, N_Vector ycur, } if (h_cfl <= ZERO) { h_cfl = SUN_RCONST(1.0e30) * SUNRabs(hcur); } -#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_INFO - SUNLogger_QueueMsg(ARK_LOGGER, SUN_LOGLEVEL_INFO, "ARKODE::arkAdapt", +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_DEBUG + SUNLogger_QueueMsg(ARK_LOGGER, SUN_LOGLEVEL_DEBUG, "ARKODE::arkAdapt", "new-step-before-bounds", "h_acc = %" RSYM ", h_cfl = %" RSYM, h_acc, h_cfl); #endif @@ -159,8 +159,8 @@ int arkAdapt(ARKodeMem ark_mem, ARKodeHAdaptMem hadapt_mem, N_Vector ycur, /* enforce minimum bound time step reduction */ h_acc = int_dir * SUNMAX(SUNRabs(h_acc), SUNRabs(hadapt_mem->etamin * hcur)); -#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_INFO - SUNLogger_QueueMsg(ARK_LOGGER, SUN_LOGLEVEL_INFO, "ARKODE::arkAdapt", +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_DEBUG + SUNLogger_QueueMsg(ARK_LOGGER, SUN_LOGLEVEL_DEBUG, "ARKODE::arkAdapt", "new-step-after-max-min-bounds", "h_acc = %" RSYM ", h_cfl = %" RSYM, h_acc, h_cfl); #endif diff --git a/src/arkode/arkode_arkstep.c b/src/arkode/arkode_arkstep.c index e1ed9c0f66..920b15b0c7 100644 --- a/src/arkode/arkode_arkstep.c +++ b/src/arkode/arkode_arkstep.c @@ -15,16 +15,28 @@ * module. *--------------------------------------------------------------*/ +#include "arkode/arkode_arkstep.h" +#include #include #include #include #include #include +#include "arkode/arkode.h" #include "arkode/arkode_butcher.h" #include "arkode_arkstep_impl.h" #include "arkode_impl.h" #include "arkode_interp_impl.h" +#include "arkode_types_impl.h" +#include "sunadjoint/sunadjoint_checkpointscheme.h" +#include "sunadjoint/sunadjoint_stepper.h" + +#include "sundials/sundials_errors.h" +#include "sundials/sundials_nvector.h" +#include "sundials/sundials_stepper.h" +#include "sundials/sundials_types.h" +#include "sundials_macros.h" #define FIXED_LIN_TOL @@ -139,6 +151,7 @@ void* ARKStepCreate(ARKRhsFn fe, ARKRhsFn fi, sunrealtype t0, N_Vector y0, ark_mem->step_getnumnonlinsolviters = arkStep_GetNumNonlinSolvIters; ark_mem->step_getnumnonlinsolvconvfails = arkStep_GetNumNonlinSolvConvFails; ark_mem->step_getnonlinsolvstats = arkStep_GetNonlinSolvStats; + ark_mem->step_setforcing = arkStep_SetInnerForcing; ark_mem->step_supports_adaptive = SUNTRUE; ark_mem->step_supports_implicit = SUNTRUE; ark_mem->step_supports_massmatrix = SUNTRUE; @@ -1180,8 +1193,8 @@ int arkStep_Init(ARKodeMem ark_mem, int init_type) } /* set appropriate TakeStep routine based on problem configuration */ - /* (only one choice for now) */ - ark_mem->step = arkStep_TakeStep_Z; + if (ark_mem->do_adjoint) { ark_mem->step = arkStep_TakeStep_ERK_Adjoint; } + else { ark_mem->step = arkStep_TakeStep_Z; } /* Check for consistency between mass system and system linear system modules (e.g., if lsolve is direct, msolve needs to match) */ @@ -1719,10 +1732,42 @@ int arkStep_TakeStep_Z(ARKodeMem ark_mem, sunrealtype* dsmPtr, int* nflagPtr) } } - /* explicit first stage -- store stage if necessary for relaxation */ - if (is_start == 1 && save_stages) + /* explicit first stage -- store stage if necessary for relaxation or checkpointing */ + if (is_start == 1) { - N_VScale(ONE, ark_mem->yn, step_mem->z[0]); + if (save_stages) { N_VScale(ONE, ark_mem->yn, step_mem->z[0]); } + + if (ark_mem->checkpoint_scheme) + { + sunbooleantype do_save; + SUNErrCode errcode = + SUNAdjointCheckpointScheme_ShouldWeSave(ark_mem->checkpoint_scheme, + ark_mem->checkpoint_step_idx, 0, + ark_mem->tcur, &do_save); + if (errcode) + { + arkProcessError(ark_mem, ARK_ADJ_CHECKPOINT_FAIL, __LINE__, __func__, + __FILE__, + "SUNAdjointCheckpointScheme_ShouldWeSave returned %d", + errcode); + } + + if (do_save) + { + errcode = + SUNAdjointCheckpointScheme_InsertVector(ark_mem->checkpoint_scheme, + ark_mem->checkpoint_step_idx, 0, + ark_mem->tcur, ark_mem->ycur); + + if (errcode) + { + arkProcessError(ark_mem, ARK_ADJ_CHECKPOINT_FAIL, __LINE__, __func__, + __FILE__, + "SUNAdjointCheckpointScheme_InsertVector returned %d", + errcode); + } + } + } } /* check if the method is Stiffly Accurate (SA) */ @@ -1827,10 +1872,10 @@ int arkStep_TakeStep_Z(ARKodeMem ark_mem, sunrealtype* dsmPtr, int* nflagPtr) } } -#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_INFO +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_DEBUG if (is_start == 1) { - SUNLogger_QueueMsg(ARK_LOGGER, SUN_LOGLEVEL_INFO, + SUNLogger_QueueMsg(ARK_LOGGER, SUN_LOGLEVEL_DEBUG, "ARKODE::arkStep_TakeStep_Z", "start-stage", "step = %li, stage = %i, implicit = %i, h = %" RSYM ", tcur = %" RSYM, @@ -1991,6 +2036,38 @@ int arkStep_TakeStep_Z(ARKodeMem ark_mem, sunrealtype* dsmPtr, int* nflagPtr) /* store stage (if necessary for relaxation) */ if (save_stages) { N_VScale(ONE, ark_mem->ycur, step_mem->z[is]); } + /* checkpoint stage for adjoint (if necessary) */ + if (ark_mem->checkpoint_scheme) + { + sunbooleantype do_save; + SUNErrCode errcode = + SUNAdjointCheckpointScheme_ShouldWeSave(ark_mem->checkpoint_scheme, + ark_mem->checkpoint_step_idx, + is, ark_mem->tcur, &do_save); + if (errcode) + { + arkProcessError(ark_mem, ARK_ADJ_CHECKPOINT_FAIL, __LINE__, __func__, + __FILE__, + "SUNAdjointCheckpointScheme_ShouldWeSave returned %d", + errcode); + } + + if (do_save) + { + SUNAdjointCheckpointScheme_InsertVector(ark_mem->checkpoint_scheme, + ark_mem->checkpoint_step_idx, is, + ark_mem->tcur, ark_mem->ycur); + + if (errcode) + { + arkProcessError(ark_mem, ARK_ADJ_CHECKPOINT_FAIL, __LINE__, __func__, + __FILE__, + "SUNAdjointCheckpointScheme_InsertVector returned %d", + errcode); + } + } + } + /* store implicit RHS (value in Fi[is] is from preceding nonlinear iteration) */ if (step_mem->implicit) { @@ -2085,14 +2162,31 @@ int arkStep_TakeStep_Z(ARKodeMem ark_mem, sunrealtype* dsmPtr, int* nflagPtr) if (*nflagPtr < 0) { return (*nflagPtr); } if (*nflagPtr > 0) { return (TRY_AGAIN); } + if (ark_mem->checkpoint_scheme) + { + sunbooleantype do_save; + SUNAdjointCheckpointScheme_ShouldWeSave(ark_mem->checkpoint_scheme, + ark_mem->checkpoint_step_idx, + step_mem->Be->stages, + ark_mem->tn + ark_mem->h, &do_save); + if (do_save) + { + SUNAdjointCheckpointScheme_InsertVector(ark_mem->checkpoint_scheme, + ark_mem->checkpoint_step_idx, + step_mem->Be->stages, + ark_mem->tn + ark_mem->h, + ark_mem->ycur); + } + } + #ifdef SUNDIALS_LOGGING_EXTRA_DEBUG SUNLogger_QueueMsg(ARK_LOGGER, SUN_LOGLEVEL_DEBUG, "ARKODE::arkStep_TakeStep_Z", "updated solution", "ycur(:) =", ""); N_VPrintFile(ark_mem->ycur, ARK_LOGGER->debug_fp); #endif -#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_INFO - SUNLogger_QueueMsg(ARK_LOGGER, SUN_LOGLEVEL_INFO, +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_DEBUG + SUNLogger_QueueMsg(ARK_LOGGER, SUN_LOGLEVEL_DEBUG, "ARKODE::arkStep_TakeStep_Z", "end-step", "step = %li, h = %" RSYM ", dsm = %" RSYM ", nflag = %d", ark_mem->nst, ark_mem->h, *dsmPtr, *nflagPtr); @@ -2101,6 +2195,203 @@ int arkStep_TakeStep_Z(ARKodeMem ark_mem, sunrealtype* dsmPtr, int* nflagPtr) return (ARK_SUCCESS); } +/*--------------------------------------------------------------- + arkStep_TakeStep_ERK_Adjoint: + + This routine performs a single backwards step of the discrete + adjoint of the ERK method. + + Since we are not doing error control during the adjoint integration, + the output variable dsmPtr should should be 0. + + The input/output variable nflagPtr is used to gauge convergence + of any algebraic solvers within the step. In this case, it should + always be 0 since we do not do any algebraic solves. + + The return value from this routine is: + 0 => step completed successfully + >0 => step encountered recoverable failure; + reduce step and retry (if possible) + <0 => step encountered unrecoverable failure + ---------------------------------------------------------------*/ +int arkStep_TakeStep_ERK_Adjoint(ARKodeMem ark_mem, sunrealtype* dsmPtr, + int* nflagPtr) +{ + int retval = ARK_SUCCESS; + + ARKodeARKStepMem step_mem; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(ark_mem, __func__, &step_mem); + if (retval != ARK_SUCCESS) { return (retval); } + +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_DEBUG + SUNLogger_QueueMsg(ARK_LOGGER, SUN_LOGLEVEL_DEBUG, + "ARKODE::arkStep_TakeStep_ERK_Adjoint", "start-step", + "step = %li, h = %" RSYM ", dsm = %" RSYM ", nflag = %d", + ark_mem->nst, ark_mem->h, *dsmPtr, *nflagPtr); +#endif + /* local shortcuts for readability */ + SUNAdjointStepper adj_stepper = (SUNAdjointStepper)ark_mem->user_data; + sunrealtype* cvals = step_mem->cvals; + N_Vector* Xvecs = step_mem->Xvecs; + N_Vector sens_np1 = ark_mem->yn; + N_Vector sens_n = ark_mem->ycur; + N_Vector sens_tmp = step_mem->sdata; + N_Vector Lambda_tmp = N_VGetSubvector_ManyVector(sens_tmp, 0); + N_Vector lambda_np1 = N_VGetSubvector_ManyVector(sens_np1, 0); + N_Vector* stage_values = step_mem->Fe; + + /* determine if method has fsal property */ + sunbooleantype fsal = (SUNRabs(step_mem->Be->A[0][0]) <= TINY) && + ARKodeButcherTable_IsStifflyAccurate(step_mem->Be); + + /* Loop over stages */ + if (fsal) { N_VConst(SUN_RCONST(0.0), stage_values[step_mem->stages - 1]); } + for (int is = step_mem->stages - (fsal ? 2 : 1); is >= 0; --is) + { + /* which stage is being processed -- needed for loading checkpoints */ + ark_mem->adj_stage_idx = is; + + /* Set current stage time(s) and index */ + ark_mem->tcur = ark_mem->tn + + ark_mem->h * (SUN_RCONST(1.0) - step_mem->Be->c[is]); + + /* + * Compute partial current stage value \Lambda + */ + int nvec = 0; + for (int js = is + 1; js < step_mem->stages; ++js) + { + /* h sum_{j=i}^{s} A_{ji}/b_i \Lambda_{j} */ + if (step_mem->Be->b[is] > SUN_UNIT_ROUNDOFF) + { + cvals[nvec] = -ark_mem->h * step_mem->Be->A[js][is] / step_mem->Be->b[is]; + } + else { cvals[nvec] = -ark_mem->h * step_mem->Be->A[js][is]; } + Xvecs[nvec] = N_VGetSubvector_ManyVector(stage_values[js], 0); + nvec++; + } + cvals[nvec] = -ark_mem->h * step_mem->Be->b[is]; + Xvecs[nvec] = lambda_np1; + nvec++; + + /* h b_i \lambda_{n+1} + h sum_{j=i}^{s} A_{ji} \Lambda_{j} */ + retval = N_VLinearCombination(nvec, cvals, Xvecs, Lambda_tmp); + if (retval != 0) { return (ARK_VECTOROP_ERR); } + + /* Compute stage values \Lambda_i, \nu_i by applying f_{y,p}^T (which is what fe does in this case) */ + retval = step_mem->fe(ark_mem->tcur, sens_tmp, stage_values[is], + ark_mem->user_data); + step_mem->nfe++; + + /* The checkpoint was not found, so we need to recompute at least + this step forward in time. We first seek the last checkpointed step + solution, then recompute from there. */ + if (retval > 0) + { + N_Vector checkpoint = N_VGetSubvector_ManyVector(ark_mem->tempv2, 0); + int64_t start_step = adj_stepper->step_idx; + + SUNErrCode errcode = SUN_ERR_CHECKPOINT_NOT_FOUND; + for (int64_t i = 0; i <= adj_stepper->step_idx; ++i, --start_step) + { +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_DEBUG + int64_t stop_step = adj_stepper->step_idx + 1; + SUNLogger_QueueMsg(ARK_LOGGER, SUN_LOGLEVEL_DEBUG, + "ARKODE::arkStep_TakeStep_ERK_Adjoint", + "searching-for-checkpoint", + "start_step = %li, stop_step = %li", start_step, + stop_step); +#endif + sunrealtype checkpoint_t; + errcode = + SUNAdjointCheckpointScheme_LoadVector(ark_mem->checkpoint_scheme, + start_step, step_mem->stages, 1, + &checkpoint, &checkpoint_t); + if (errcode == SUN_SUCCESS) + { + /* OK, now we have the last checkpoint that stored as (start_step, stages). + This represents the last step solution that was checkpointed. As such, we + want to recompute from start_step+1 to stop_step. */ + start_step++; + sunrealtype t0 = checkpoint_t; + sunrealtype tf = ark_mem->tn; +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_DEBUG + SUNLogger_QueueMsg(ARK_LOGGER, SUN_LOGLEVEL_DEBUG, + "ARKODE::arkStep_TakeStep_ERK_Adjoint", + "start-recompute", + "start_step = %li, stop_step = %li, t0 = %" RSYM + ", tf = %" RSYM "", + start_step, stop_step, t0, tf); +#endif + if (SUNAdjointStepper_RecomputeFwd(adj_stepper, start_step, t0, tf, + checkpoint)) + { + return (ARK_ADJ_RECOMPUTE_FAIL); + } +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_DEBUG + SUNLogger_QueueMsg(ARK_LOGGER, SUN_LOGLEVEL_DEBUG, + "ARKODE::arkStep_TakeStep_ERK_Adjoint", + "end-recompute", + "start_step = %li, stop_step = %li, t0 = %" RSYM + ", tf = %" RSYM "", + start_step, stop_step, t0, tf); +#endif + return arkStep_TakeStep_ERK_Adjoint(ark_mem, dsmPtr, nflagPtr); + } + } + if (errcode != SUN_SUCCESS) { return (ARK_RHSFUNC_FAIL); } + } + else if (retval < 0) { return (ARK_RHSFUNC_FAIL); } + } + + /* Throw away the step solution */ + sunrealtype checkpoint_t = 0.0; + N_Vector checkpoint = N_VGetSubvector_ManyVector(ark_mem->tempv2, 0); + SUNErrCode errcode = + SUNAdjointCheckpointScheme_LoadVector(ark_mem->checkpoint_scheme, + adj_stepper->step_idx, 0, 0, + &checkpoint, &checkpoint_t); + if (errcode) + { + arkProcessError(ark_mem, ARK_ADJ_CHECKPOINT_FAIL, __LINE__, __func__, + __FILE__, + "SUNAdjointCheckpointScheme_LoadVector returned %d", errcode); + } + + /* Now compute the time step solution. We cannot use arkStep_ComputeSolutions because the + adjoint calculation for the time step solution is different than the forward case. */ + + int nvec = 0; + for (int j = 0; j < step_mem->stages; j++) + { + cvals[nvec] = ONE; + Xvecs[nvec] = + stage_values[j]; // this needs to be the stage values [Lambda_i, nu_i] + nvec++; + } + cvals[nvec] = ONE; + Xvecs[nvec] = sens_np1; + nvec++; + + /* \lambda_n = \lambda_{n+1} + \sum_{j=1}^{s} \Lambda_j + \mu_n = \mu_{n+1} + \sum_{j=1}^{s} \nu_j */ + retval = N_VLinearCombination(nvec, cvals, Xvecs, sens_n); + if (retval != 0) { return (ARK_VECTOROP_ERR); } + + *dsmPtr = ZERO; + *nflagPtr = 0; + +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_DEBUG + SUNLogger_QueueMsg(ARK_LOGGER, SUN_LOGLEVEL_DEBUG, + "ARKODE::arkStep_TakeStep_ERK_Adjoint", "end-step", + "step = %li, h = %" RSYM ", dsm = %" RSYM ", nflag = %d", + ark_mem->nst, ark_mem->h, *dsmPtr, *nflagPtr); +#endif + return (ARK_SUCCESS); +} + /*=============================================================== Internal utility routines ===============================================================*/ @@ -3159,6 +3450,256 @@ int arkStep_ComputeSolutions_MassFixed(ARKodeMem ark_mem, sunrealtype* dsmPtr) return (ARK_SUCCESS); } +/*--------------------------------------------------------------- + Utility routines for interfacing with SUNAdjointStepper + ---------------------------------------------------------------*/ + +int arkStep_fe_Adj(sunrealtype t, N_Vector sens_partial_stage, + N_Vector sens_complete_stage, void* content) +{ + SUNErrCode errcode = SUN_SUCCESS; + + SUNAdjointStepper adj_stepper = (SUNAdjointStepper)content; + SUNAdjointCheckpointScheme check_scheme = adj_stepper->checkpoint_scheme; + ARKodeMem ark_mem = (ARKodeMem)adj_stepper->adj_sunstepper->content; + void* user_data = adj_stepper->user_data; + + N_Vector Lambda_part = N_VGetSubvector_ManyVector(sens_partial_stage, 0); + N_Vector Lambda = N_VGetSubvector_ManyVector(sens_complete_stage, 0); + N_Vector checkpoint = N_VClone(Lambda_part); + sunrealtype checkpoint_t = SUN_RCONST(0.0); + + errcode = SUNAdjointCheckpointScheme_LoadVector(check_scheme, + adj_stepper->step_idx, + ark_mem->adj_stage_idx, 0, + &checkpoint, &checkpoint_t); + + // Checkpoint was not found, recompute the missing step + if (errcode == SUN_ERR_CHECKPOINT_NOT_FOUND) { return +1; } + + if (adj_stepper->JacFn) + { + adj_stepper->JacFn(t, checkpoint, NULL, adj_stepper->Jac, user_data, NULL, + NULL, NULL); + adj_stepper->njeval++; + if (SUNMatMatTransposeVec(adj_stepper->Jac, Lambda_part, Lambda)) + { + return -1; + }; + } + else if (adj_stepper->JvpFn) + { + adj_stepper->JvpFn(Lambda_part, Lambda, t, checkpoint, NULL, user_data, NULL); + + adj_stepper->njtimesv++; + } + else if (adj_stepper->vJpFn) + { + adj_stepper->vJpFn(Lambda_part, Lambda, t, checkpoint, NULL, user_data, NULL); + adj_stepper->nvtimesj++; + } + + if (adj_stepper->JacPFn) + { + if (N_VGetNumSubvectors_ManyVector(sens_complete_stage) < 2) { return -1; } + N_Vector nu = N_VGetSubvector_ManyVector(sens_complete_stage, 1); + adj_stepper->JacPFn(t, checkpoint, NULL, adj_stepper->JacP, user_data, NULL, + NULL, NULL); + adj_stepper->njpeval++; + if (SUNMatMatTransposeVec(adj_stepper->JacP, Lambda_part, nu)) + { + return -1; + } + } + else if (adj_stepper->JPvpFn) + { + if (N_VGetNumSubvectors_ManyVector(sens_complete_stage) < 2) { return -1; } + N_Vector nu = N_VGetSubvector_ManyVector(sens_complete_stage, 1); + adj_stepper->JPvpFn(Lambda_part, nu, t, checkpoint, NULL, user_data, NULL); + adj_stepper->njptimesv++; + } + else if (adj_stepper->vJPpFn) + { + if (N_VGetNumSubvectors_ManyVector(sens_complete_stage) < 2) { return -1; } + N_Vector nu = N_VGetSubvector_ManyVector(sens_complete_stage, 1); + adj_stepper->vJPpFn(Lambda_part, nu, t, checkpoint, NULL, user_data, NULL); + adj_stepper->nvtimesjp++; + } + + N_VDestroy(checkpoint); + + return 0; +} + +int arkStepCompatibleWithAdjointSolver(ARKodeMem ark_mem, + ARKodeARKStepMem step_mem, int lineno, + const char* fname, const char* filename) +{ + if (!ark_mem->fixedstep) + { + arkProcessError(ark_mem, ARK_ILL_INPUT, lineno, fname, + filename, "ARKStep must be using a fixed step to work with SUNAdjointStepper"); + return ARK_ILL_INPUT; + } + + if (step_mem->fi) + { + arkProcessError(ark_mem, ARK_ILL_INPUT, lineno, fname, + filename, "SUNAdjointStepper requires fi = NULL (it only supports explicit RK methods)"); + return ARK_ILL_INPUT; + } + + if (!step_mem->fe) + { + arkProcessError(ark_mem, ARK_ILL_INPUT, lineno, fname, + filename, "fe must have been provided to ARKStepCreate to create a SUNAdjointStepper"); + return ARK_ILL_INPUT; + } + + if (ark_mem->relax_enabled) + { + arkProcessError(ark_mem, ARK_ILL_INPUT, lineno, fname, filename, + "SUNAdjointStepper is not compatible with relaxation"); + return ARK_ILL_INPUT; + } + + if (step_mem->mass_type != MASS_IDENTITY) + { + arkProcessError(ark_mem, ARK_ILL_INPUT, lineno, fname, + filename, "SUNAdjointStepper is not compatible with non-identity mass matrices"); + return ARK_ILL_INPUT; + } + + return ARK_SUCCESS; +} + +int ARKStepCreateAdjointStepper(void* arkode_mem, N_Vector sf, + SUNAdjointStepper* adj_stepper_ptr) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval = arkStep_AccessARKODEStepMem(arkode_mem, + "ARKStepCreateAdjointStepper", + &ark_mem, &step_mem); + if (retval) + { + arkProcessError(NULL, ARK_ILL_INPUT, __LINE__, __func__, __FILE__, + "The ARKStep memory pointer is NULL"); + return ARK_ILL_INPUT; + } + + if (arkStepCompatibleWithAdjointSolver(ark_mem, step_mem, __LINE__, __func__, + __FILE__)) + { + return ARK_ILL_INPUT; + } + + /** + Create and configure the ARKStep stepper for the adjoint system + */ + long nst = 0; + retval = ARKodeGetNumSteps(arkode_mem, &nst); + if (retval) + { + arkProcessError(ark_mem, retval, __LINE__, __func__, __FILE__, + "ARKodeGetNumSteps failed"); + return retval; + } + + void* arkode_mem_adj = ARKStepCreate(arkStep_fe_Adj, NULL, ark_mem->tretlast, + sf, ark_mem->sunctx); + ARKodeMem ark_mem_adj = (ARKodeMem)arkode_mem_adj; + + ark_mem_adj->do_adjoint = SUNTRUE; + + retval = ARKodeSetFixedStep(arkode_mem_adj, -ark_mem->h); + if (retval) + { + arkProcessError(ark_mem, retval, __LINE__, __func__, __FILE__, + "ARKodeSetFixedStep failed"); + return retval; + } + + retval = ARKStepSetTables(arkode_mem_adj, step_mem->Be->q, step_mem->Be->p, + step_mem->Bi, step_mem->Be); + if (retval) + { + arkProcessError(ark_mem, retval, __LINE__, __func__, __FILE__, + "ARKStepSetTables failed"); + return retval; + } + + retval = ARKodeSetMaxNumSteps(arkode_mem_adj, nst); + if (retval) + { + arkProcessError(ark_mem, retval, __LINE__, __func__, __FILE__, + "ARKodeSetMaxNumSteps failed"); + return retval; + } + + retval = ARKodeSetAdjointCheckpointScheme(arkode_mem_adj, + ark_mem->checkpoint_scheme); + if (retval) + { + arkProcessError(ark_mem, retval, __LINE__, __func__, __FILE__, + "ARKodeSetAdjointCheckpointScheme failed"); + return retval; + } + + /* SUNAdjointStepper will own the SUNSteppers and destroy them */ + SUNStepper fwd_stepper; + retval = ARKodeCreateSUNStepper(arkode_mem, &fwd_stepper); + if (retval) + { + arkProcessError(ark_mem, retval, __LINE__, __func__, __FILE__, + "ARKodeCreateSUNStepper failed"); + return retval; + } + + SUNStepper adj_stepper; + retval = ARKodeCreateSUNStepper(arkode_mem_adj, &adj_stepper); + if (retval) + { + arkProcessError(ark_mem, retval, __LINE__, __func__, __FILE__, + "ARKodeCreateSUNStepper failed"); + return retval; + } + + SUNErrCode errcode = SUN_SUCCESS; + errcode = SUNAdjointStepper_Create(fwd_stepper, adj_stepper, nst - 1, sf, + ark_mem->tretlast, + ark_mem->checkpoint_scheme, + ark_mem->sunctx, adj_stepper_ptr); + if (errcode) + { + retval = ARK_UNRECOGNIZED_ERROR; + arkProcessError(ark_mem, retval, __LINE__, __func__, __FILE__, + "SUNAdjointStepper_Create failed"); + return retval; + } + + errcode = SUNAdjointStepper_SetUserData(*adj_stepper_ptr, ark_mem->user_data); + if (errcode) + { + retval = ARK_UNRECOGNIZED_ERROR; + arkProcessError(ark_mem, retval, __LINE__, __func__, __FILE__, + "SUNAdjointStepper_SetUserData failed"); + return retval; + } + + /* We need access to the adjoint solver to access the parameter Jacobian inside of ARKStep's + backwards integration of the the adjoint problem. */ + retval = ARKodeSetUserData(arkode_mem_adj, *adj_stepper_ptr); + if (retval) + { + arkProcessError(ark_mem, retval, __LINE__, __func__, __FILE__, + "ARKodeSetUserData failed"); + return retval; + } + + return ARK_SUCCESS; +} + /*=============================================================== Internal utility routines for interacting with MRIStep ===============================================================*/ @@ -3325,16 +3866,19 @@ void arkStep_ApplyForcing(ARKodeARKStepMem step_mem, sunrealtype* stage_times, methods). ----------------------------------------------------------------------------*/ -int arkStep_SetInnerForcing(void* arkode_mem, sunrealtype tshift, +int arkStep_SetInnerForcing(ARKodeMem ark_mem, sunrealtype tshift, sunrealtype tscale, N_Vector* forcing, int nvecs) { - ARKodeMem ark_mem; ARKodeARKStepMem step_mem; - int retval; - /* access ARKodeMem and ARKodeARKStepMem structures */ - retval = arkStep_AccessARKODEStepMem(arkode_mem, __func__, &ark_mem, &step_mem); - if (retval != ARK_SUCCESS) { return (retval); } + /* access ARKodeARKStepMem structure */ + if (ark_mem->step_mem == NULL) + { + arkProcessError(ark_mem, ARK_MEM_NULL, __LINE__, __func__, __FILE__, + MSG_ARKSTEP_NO_MEM); + return ARK_MEM_NULL; + } + step_mem = (ARKodeARKStepMem)ark_mem->step_mem; if (nvecs > 0) { diff --git a/src/arkode/arkode_arkstep_impl.h b/src/arkode/arkode_arkstep_impl.h index 806101a98b..c17f094cb4 100644 --- a/src/arkode/arkode_arkstep_impl.h +++ b/src/arkode/arkode_arkstep_impl.h @@ -189,6 +189,8 @@ int arkStep_GetGammas(ARKodeMem ark_mem, sunrealtype* gamma, sunrealtype* gamrat sunbooleantype** jcur, sunbooleantype* dgamma_fail); int arkStep_FullRHS(ARKodeMem ark_mem, sunrealtype t, N_Vector y, N_Vector f, int mode); +int arkStep_TakeStep_ERK_Adjoint(ARKodeMem ark_mem, sunrealtype* dsmPtr, + int* nflagPtr); int arkStep_TakeStep_Z(ARKodeMem ark_mem, sunrealtype* dsmPtr, int* nflagPtr); int arkStep_SetUserData(ARKodeMem ark_mem, void* user_data); int arkStep_SetDefaults(ARKodeMem ark_mem); @@ -271,7 +273,7 @@ int arkStep_NlsConvTest(SUNNonlinearSolver NLS, N_Vector y, N_Vector del, sunrealtype tol, N_Vector ewt, void* arkode_mem); /* private functions for interfacing with MRIStep */ -int arkStep_SetInnerForcing(void* arkode_mem, sunrealtype tshift, +int arkStep_SetInnerForcing(ARKodeMem arkode_mem, sunrealtype tshift, sunrealtype tscale, N_Vector* f, int nvecs); int arkStep_MRIStepInnerEvolve(MRIStepInnerStepper stepper, sunrealtype t0, sunrealtype tout, N_Vector y); @@ -286,6 +288,14 @@ int arkStep_RelaxDeltaE(ARKodeMem ark_mem, ARKRelaxJacFn relax_jac_fn, long int* relax_jac_fn_evals, sunrealtype* delta_e_out); int arkStep_GetOrder(ARKodeMem ark_mem); +/* private functions for adjoints */ +int arkStep_fe_Adj(sunrealtype t, N_Vector sens_partial_stage, + N_Vector sens_complete_stage, void* content); + +int arkStepCompatibleWithAdjointSolver(ARKodeMem ark_mem, + ARKodeARKStepMem step_mem, int lineno, + const char* fname, const char* filename); + /*=============================================================== Reusable ARKStep Error Messages ===============================================================*/ diff --git a/src/arkode/arkode_impl.h b/src/arkode/arkode_impl.h index f9383fe1de..3b90f6f724 100644 --- a/src/arkode/arkode_impl.h +++ b/src/arkode/arkode_impl.h @@ -23,6 +23,9 @@ #include #include #include +#include +#include +#include #include #include #include @@ -33,8 +36,10 @@ #include "arkode_relaxation_impl.h" #include "arkode_root_impl.h" #include "arkode_types_impl.h" +#include "sundials/sundials_types.h" #include "sundials_logger_impl.h" #include "sundials_macros.h" +#include "sundials_stepper_impl.h" #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { @@ -289,6 +294,11 @@ typedef int (*ARKTimestepAttachMasssolFn)( typedef void (*ARKTimestepDisableMSetup)(ARKodeMem ark_mem); typedef void* (*ARKTimestepGetMassMemFn)(ARKodeMem ark_mem); +/* time stepper interface functions -- forcing */ +typedef int (*ARKTimestepSetForcingFn)(ARKodeMem ark_mem, sunrealtype tshift, + sunrealtype tscale, N_Vector* f, + int nvecs); + /*=============================================================== ARKODE interpolation module definition ===============================================================*/ @@ -454,6 +464,9 @@ struct ARKodeMemRec ARKTimestepGetMassMemFn step_getmassmem; ARKMassMultFn step_mmult; + /* Time stepper module -- forcing */ + ARKTimestepSetForcingFn step_setforcing; + /* N_Vector storage */ N_Vector ewt; /* error weight vector */ N_Vector rwt; /* residual weight vector */ @@ -552,6 +565,14 @@ struct ARKodeMemRec sunbooleantype use_compensated_sums; + /* Adjoint solver data */ + sunbooleantype do_adjoint; + long int adj_stage_idx; /* current stage index (only valid in adjoint context)*/ + + /* Checkpointing data */ + SUNAdjointCheckpointScheme checkpoint_scheme; + int64_t checkpoint_step_idx; /* the step number for checkpointing */ + /* XBraid interface variables */ sunbooleantype force_pass; /* when true the step attempt loop will ignore the return value (kflag) from arkCheckTemporalError diff --git a/src/arkode/arkode_io.c b/src/arkode/arkode_io.c index 670b1fd9d0..84914dc46b 100644 --- a/src/arkode/arkode_io.c +++ b/src/arkode/arkode_io.c @@ -1995,6 +1995,39 @@ int ARKodeSetMaxConvFails(void* arkode_mem, int maxncf) return (ARK_SUCCESS); } +int ARKodeSetAdjointCheckpointScheme(void* arkode_mem, + SUNAdjointCheckpointScheme checkpoint_scheme) +{ + ARKodeMem ark_mem; + if (arkode_mem == NULL) + { + arkProcessError(NULL, ARK_MEM_NULL, __LINE__, __func__, __FILE__, + MSG_ARK_NO_MEM); + return (ARK_MEM_NULL); + } + ark_mem = (ARKodeMem)arkode_mem; + + ark_mem->checkpoint_scheme = checkpoint_scheme; + + return (ARK_SUCCESS); +} + +int ARKodeSetAdjointCheckpointIndex(void* arkode_mem, int64_t step_index) +{ + ARKodeMem ark_mem; + if (arkode_mem == NULL) + { + arkProcessError(NULL, ARK_MEM_NULL, __LINE__, __func__, __FILE__, + MSG_ARK_NO_MEM); + return (ARK_MEM_NULL); + } + ark_mem = (ARKodeMem)arkode_mem; + + ark_mem->checkpoint_step_idx = step_index; + + return (ARK_SUCCESS); +} + /*=============================================================== ARKODE optional output utility functions ===============================================================*/ @@ -2899,6 +2932,7 @@ char* ARKodeGetReturnFlagName(long int flag) case ARK_RELAX_JAC_FAIL: sprintf(name, "ARK_RELAX_JAC_FAIL"); break; case ARK_CONTROLLER_ERR: sprintf(name, "ARK_CONTROLLER_ERR"); break; case ARK_STEPPER_UNSUPPORTED: sprintf(name, "ARK_STEPPER_UNSUPPORTED"); break; + case ARK_ADJ_RECOMPUTE_FAIL: sprintf(name, "ARK_ADJ_RECOMPUTE_FAIL"); break; case ARK_UNRECOGNIZED_ERROR: sprintf(name, "ARK_UNRECOGNIZED_ERROR"); break; default: sprintf(name, "NONE"); } diff --git a/src/arkode/arkode_mristep.c b/src/arkode/arkode_mristep.c index 32c26e1de0..4f499ed419 100644 --- a/src/arkode/arkode_mristep.c +++ b/src/arkode/arkode_mristep.c @@ -16,12 +16,15 @@ * This is the implementation file for ARKODE's MRI time stepper module. * ---------------------------------------------------------------------------*/ +#include "arkode/arkode_mristep.h" + #include #include #include #include #include +#include "arkode/arkode.h" #include "arkode_impl.h" #include "arkode_interp_impl.h" #include "arkode_mristep_impl.h" @@ -2591,9 +2594,9 @@ int mriStep_StageSetup(ARKodeMem ark_mem) return (ARK_SUCCESS); } -/*=============================================================== +/*--------------------------------------------------------------- User-callable functions for a custom inner integrator - ===============================================================*/ + ---------------------------------------------------------------*/ int MRIStepInnerStepper_Create(SUNContext sunctx, MRIStepInnerStepper* stepper) { @@ -2626,6 +2629,30 @@ int MRIStepInnerStepper_Create(SUNContext sunctx, MRIStepInnerStepper* stepper) return (ARK_SUCCESS); } +int MRIStepInnerStepper_CreateFromSUNStepper(SUNStepper sunstepper, + MRIStepInnerStepper* stepper) +{ + int retval = MRIStepInnerStepper_Create(sunstepper->sunctx, stepper); + if (retval != ARK_SUCCESS) { return retval; } + + retval = MRIStepInnerStepper_SetContent(*stepper, sunstepper); + if (retval != ARK_SUCCESS) { return retval; } + + retval = MRIStepInnerStepper_SetEvolveFn(*stepper, + mriStepInnerStepper_EvolveSUNStepper); + if (retval != ARK_SUCCESS) { return retval; } + + retval = MRIStepInnerStepper_SetFullRhsFn(*stepper, + mriStepInnerStepper_FullRhsSUNStepper); + if (retval != ARK_SUCCESS) { return retval; } + + retval = MRIStepInnerStepper_SetResetFn(*stepper, + mriStepInnerStepper_ResetSUNStepper); + if (retval != ARK_SUCCESS) { return retval; } + + return ARK_SUCCESS; +} + int MRIStepInnerStepper_Free(MRIStepInnerStepper* stepper) { if (*stepper == NULL) { return ARK_SUCCESS; } @@ -2787,9 +2814,9 @@ int MRIStepInnerStepper_GetForcingData(MRIStepInnerStepper stepper, return ARK_SUCCESS; } -/*=============================================================== - Private inner integrator functions - ===============================================================*/ +/*--------------------------------------------------------------- + Internal inner integrator functions + ---------------------------------------------------------------*/ /* Check for required operations */ int mriStepInnerStepper_HasRequiredOps(MRIStepInnerStepper stepper) @@ -2810,7 +2837,7 @@ int mriStepInnerStepper_Evolve(MRIStepInnerStepper stepper, sunrealtype t0, if (stepper->ops->evolve == NULL) { return ARK_ILL_INPUT; } #if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_DEBUG - SUNLogger_QueueMsg(stepper->sunctx->logger, SUN_LOGLEVEL_INFO, + SUNLogger_QueueMsg(stepper->sunctx->logger, SUN_LOGLEVEL_DEBUG, "ARKODE::mriStepInnerStepper_Evolve", "start-inner-evolve", "t0 = %" RSYM ", tout = %" RSYM, t0, tout); #endif @@ -2818,7 +2845,7 @@ int mriStepInnerStepper_Evolve(MRIStepInnerStepper stepper, sunrealtype t0, stepper->last_flag = stepper->ops->evolve(stepper, t0, tout, y); #if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_DEBUG - SUNLogger_QueueMsg(stepper->sunctx->logger, SUN_LOGLEVEL_INFO, + SUNLogger_QueueMsg(stepper->sunctx->logger, SUN_LOGLEVEL_DEBUG, "ARKODE::mriStepInnerStepper_Evolve", "end-inner-evolve", "flag = %i", stepper->last_flag); #endif @@ -2826,6 +2853,27 @@ int mriStepInnerStepper_Evolve(MRIStepInnerStepper stepper, sunrealtype t0, return stepper->last_flag; } +int mriStepInnerStepper_EvolveSUNStepper(MRIStepInnerStepper stepper, + SUNDIALS_MAYBE_UNUSED sunrealtype t0, + sunrealtype tout, N_Vector y) +{ + SUNStepper sunstepper = (SUNStepper)stepper->content; + sunrealtype tret; + + SUNErrCode err = sunstepper->ops->setstoptime(sunstepper, tout); + if (err != SUN_SUCCESS) + { + stepper->last_flag = sunstepper->last_flag; + return ARK_SUNSTEPPER_ERR; + } + + err = sunstepper->ops->evolve(sunstepper, tout, y, &tret); + stepper->last_flag = sunstepper->last_flag; + if (err != SUN_SUCCESS) { return ARK_SUNSTEPPER_ERR; } + + return ARK_SUCCESS; +} + /* Compute the full RHS for inner (fast) time scale TODO(DJG): This function can be made optional when fullrhs is not called unconditionally by the ARKODE infrastructure e.g., in arkInitialSetup, arkYddNorm, and arkCompleteStep. */ @@ -2840,6 +2888,26 @@ int mriStepInnerStepper_FullRhs(MRIStepInnerStepper stepper, sunrealtype t, return stepper->last_flag; } +int mriStepInnerStepper_FullRhsSUNStepper(MRIStepInnerStepper stepper, + sunrealtype t, N_Vector y, N_Vector f, + int ark_mode) +{ + SUNStepper sunstepper = (SUNStepper)stepper->content; + + SUNFullRhsMode mode; + switch (ark_mode) + { + case ARK_FULLRHS_START: mode = SUN_FULLRHS_START; break; + case ARK_FULLRHS_END: mode = SUN_FULLRHS_END; break; + default: mode = SUN_FULLRHS_OTHER; break; + } + + SUNErrCode err = sunstepper->ops->fullrhs(sunstepper, t, y, f, mode); + stepper->last_flag = sunstepper->last_flag; + if (err != SUN_SUCCESS) { return ARK_SUNSTEPPER_ERR; } + return ARK_SUCCESS; +} + /* Reset the inner (fast) stepper state */ int mriStepInnerStepper_Reset(MRIStepInnerStepper stepper, sunrealtype tR, N_Vector yR) @@ -2848,7 +2916,7 @@ int mriStepInnerStepper_Reset(MRIStepInnerStepper stepper, sunrealtype tR, if (stepper->ops == NULL) { return ARK_ILL_INPUT; } #if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_DEBUG - SUNLogger_QueueMsg(stepper->sunctx->logger, SUN_LOGLEVEL_INFO, + SUNLogger_QueueMsg(stepper->sunctx->logger, SUN_LOGLEVEL_DEBUG, "ARKODE::mriStepInnerStepper_Reset", "reset-inner-state", "tR = %" RSYM, tR); #endif @@ -2865,6 +2933,16 @@ int mriStepInnerStepper_Reset(MRIStepInnerStepper stepper, sunrealtype tR, } } +int mriStepInnerStepper_ResetSUNStepper(MRIStepInnerStepper stepper, + sunrealtype tR, N_Vector yR) +{ + SUNStepper sunstepper = (SUNStepper)stepper->content; + SUNErrCode err = sunstepper->ops->reset(sunstepper, tR, yR, 0); + stepper->last_flag = sunstepper->last_flag; + if (err != SUN_SUCCESS) { return ARK_SUNSTEPPER_ERR; } + return ARK_SUCCESS; +} + /* Allocate MRI forcing and fused op workspace vectors if necessary */ int mriStepInnerStepper_AllocVecs(MRIStepInnerStepper stepper, int count, N_Vector tmpl) @@ -2907,7 +2985,7 @@ int mriStepInnerStepper_AllocVecs(MRIStepInnerStepper stepper, int count, /* Allocate fused operation workspace arrays */ if (stepper->vecs == NULL) { - stepper->vecs = (N_Vector*)calloc(count + 1, sizeof(*stepper->vecs)); + stepper->vecs = (N_Vector*)calloc(count + 1, sizeof(N_Vector)); if (stepper->vecs == NULL) { mriStepInnerStepper_FreeVecs(stepper); @@ -2917,7 +2995,7 @@ int mriStepInnerStepper_AllocVecs(MRIStepInnerStepper stepper, int count, if (stepper->vals == NULL) { - stepper->vals = (sunrealtype*)calloc(count + 1, sizeof(*stepper->vals)); + stepper->vals = (sunrealtype*)calloc(count + 1, sizeof(sunrealtype)); if (stepper->vals == NULL) { mriStepInnerStepper_FreeVecs(stepper); diff --git a/src/arkode/arkode_mristep_impl.h b/src/arkode/arkode_mristep_impl.h index f631307e07..3ae944b12d 100644 --- a/src/arkode/arkode_mristep_impl.h +++ b/src/arkode/arkode_mristep_impl.h @@ -272,10 +272,18 @@ int mriStep_NlsConvTest(SUNNonlinearSolver NLS, N_Vector y, N_Vector del, int mriStepInnerStepper_HasRequiredOps(MRIStepInnerStepper stepper); int mriStepInnerStepper_Evolve(MRIStepInnerStepper stepper, sunrealtype t0, sunrealtype tout, N_Vector y); +int mriStepInnerStepper_EvolveSUNStepper(MRIStepInnerStepper stepper, + sunrealtype t0, sunrealtype tout, + N_Vector y); int mriStepInnerStepper_FullRhs(MRIStepInnerStepper stepper, sunrealtype t, N_Vector y, N_Vector f, int mode); +int mriStepInnerStepper_FullRhsSUNStepper(MRIStepInnerStepper stepper, + sunrealtype t, N_Vector y, N_Vector f, + int mode); int mriStepInnerStepper_Reset(MRIStepInnerStepper stepper, sunrealtype tR, N_Vector yR); +int mriStepInnerStepper_ResetSUNStepper(MRIStepInnerStepper stepper, + sunrealtype tR, N_Vector yR); int mriStepInnerStepper_AllocVecs(MRIStepInnerStepper stepper, int count, N_Vector tmpl); int mriStepInnerStepper_Resize(MRIStepInnerStepper stepper, ARKVecResizeFn resize, diff --git a/src/arkode/arkode_sunstepper.c b/src/arkode/arkode_sunstepper.c new file mode 100644 index 0000000000..42b8452a2f --- /dev/null +++ b/src/arkode/arkode_sunstepper.c @@ -0,0 +1,213 @@ +/*--------------------------------------------------------------- + * Programmer(s): Steven B. Roberts @ LLNL + Cody J. Balos @ LLNL + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 ARKODE's interfacing with + * SUNStepper + *--------------------------------------------------------------*/ + +#include +#include +#include "arkode_impl.h" +#include "sundials_macros.h" + +static SUNErrCode arkSUNStepperEvolveHelper(SUNStepper stepper, + sunrealtype tout, N_Vector y, + sunrealtype* tret, int mode) +{ + SUNFunctionBegin(stepper->sunctx); + /* extract the ARKODE memory struct */ + void* arkode_mem; + SUNCheckCall(SUNStepper_GetContent(stepper, &arkode_mem)); + + /* evolve inner ODE */ + stepper->last_flag = ARKodeEvolve(arkode_mem, tout, y, tret, mode); + if (stepper->last_flag < 0) { return SUN_ERR_OP_FAIL; } + + return SUN_SUCCESS; +} + +static SUNErrCode arkSUNStepperEvolve(SUNStepper stepper, sunrealtype tout, + N_Vector y, sunrealtype* tret) +{ + return arkSUNStepperEvolveHelper(stepper, tout, y, tret, ARK_NORMAL); +} + +static SUNErrCode arkSUNStepperOneStep(SUNStepper stepper, sunrealtype tout, + N_Vector y, sunrealtype* tret) +{ + return arkSUNStepperEvolveHelper(stepper, tout, y, tret, ARK_ONE_STEP); +} + +/*------------------------------------------------------------------------------ + Implementation of SUNStepperFullRhsFn to compute the full inner + (fast) ODE IVP RHS. + ----------------------------------------------------------------------------*/ + +static SUNErrCode arkSUNStepperFullRhs(SUNStepper stepper, sunrealtype t, + N_Vector y, N_Vector f, + SUNFullRhsMode mode) +{ + SUNFunctionBegin(stepper->sunctx); + /* extract the ARKODE memory struct */ + void* arkode_mem; + SUNCheckCall(SUNStepper_GetContent(stepper, &arkode_mem)); + ARKodeMem ark_mem = (ARKodeMem)arkode_mem; + + int ark_mode; + switch (mode) + { + case SUN_FULLRHS_START: ark_mode = ARK_FULLRHS_START; break; + case SUN_FULLRHS_END: ark_mode = ARK_FULLRHS_END; break; + case SUN_FULLRHS_OTHER: ark_mode = ARK_FULLRHS_OTHER; break; + default: ark_mode = -1; break; + } + + stepper->last_flag = ark_mem->step_fullrhs(ark_mem, t, y, f, ark_mode); + if (stepper->last_flag != ARK_SUCCESS) { return SUN_ERR_OP_FAIL; } + + return SUN_SUCCESS; +} + +/*------------------------------------------------------------------------------ + Implementation of SUNStepperResetFn to reset the inner (fast) stepper + state. + ----------------------------------------------------------------------------*/ + +static SUNErrCode arkSUNStepperReset(SUNStepper stepper, sunrealtype tR, + N_Vector yR, int64_t ckptIdxR) +{ + SUNFunctionBegin(stepper->sunctx); + + /* extract the ARKODE memory struct */ + void* arkode_mem; + SUNCheckCall(SUNStepper_GetContent(stepper, &arkode_mem)); + + stepper->last_flag = ARKodeReset(arkode_mem, tR, yR); + if (stepper->last_flag != ARK_SUCCESS) { return SUN_ERR_OP_FAIL; } + + stepper->last_flag = ARKodeSetAdjointCheckpointIndex(arkode_mem, ckptIdxR); + if (stepper->last_flag != ARK_SUCCESS) { return SUN_ERR_OP_FAIL; } + + return SUN_SUCCESS; +} + +/*------------------------------------------------------------------------------ + Implementation of SUNStepperStopTimeFn to set the tstop time + ----------------------------------------------------------------------------*/ + +static SUNErrCode arkSUNStepperSetStopTime(SUNStepper stepper, sunrealtype tstop) +{ + SUNFunctionBegin(stepper->sunctx); + /* extract the ARKODE memory struct */ + void* arkode_mem; + SUNCheckCall(SUNStepper_GetContent(stepper, &arkode_mem)); + + stepper->last_flag = ARKodeSetStopTime(arkode_mem, tstop); + if (stepper->last_flag != ARK_SUCCESS) { return SUN_ERR_OP_FAIL; } + + return SUN_SUCCESS; +} + +static SUNErrCode arkSUNStepperSetForcing(SUNStepper stepper, sunrealtype tshift, + sunrealtype tscale, N_Vector* forcing, + int nforcing) +{ + SUNFunctionBegin(stepper->sunctx); + /* extract the ARKODE memory struct */ + void* arkode_mem; + SUNCheckCall(SUNStepper_GetContent(stepper, &arkode_mem)); + ARKodeMem ark_mem = (ARKodeMem)arkode_mem; + + stepper->last_flag = ark_mem->step_setforcing(ark_mem, tshift, tscale, + forcing, nforcing); + if (stepper->last_flag != ARK_SUCCESS) { return SUN_ERR_OP_FAIL; } + + return SUN_SUCCESS; +} + +int ARKodeCreateSUNStepper(void* arkode_mem, SUNStepper* stepper) +{ + /* unpack ark_mem */ + if (arkode_mem == NULL) + { + arkProcessError(NULL, ARK_MEM_NULL, __LINE__, __func__, __FILE__, + MSG_ARK_NO_MEM); + return ARK_MEM_NULL; + } + ARKodeMem ark_mem = (ARKodeMem)arkode_mem; + + SUNErrCode err = SUNStepper_Create(ark_mem->sunctx, stepper); + if (err != SUN_SUCCESS) + { + arkProcessError(ark_mem, ARK_SUNSTEPPER_ERR, __LINE__, __func__, __FILE__, + "Failed to create SUNStepper"); + return ARK_SUNSTEPPER_ERR; + } + + err = SUNStepper_SetContent(*stepper, arkode_mem); + if (err != SUN_SUCCESS) + { + arkProcessError(ark_mem, ARK_SUNSTEPPER_ERR, __LINE__, __func__, __FILE__, + "Failed to set SUNStepper content"); + return ARK_SUNSTEPPER_ERR; + } + + err = SUNStepper_SetEvolveFn(*stepper, arkSUNStepperEvolve); + if (err != SUN_SUCCESS) + { + arkProcessError(ark_mem, ARK_SUNSTEPPER_ERR, __LINE__, __func__, __FILE__, + "Failed to set SUNStepper evolve function"); + return ARK_SUNSTEPPER_ERR; + } + + err = SUNStepper_SetOneStepFn(*stepper, arkSUNStepperOneStep); + if (err != SUN_SUCCESS) { return ARK_SUNSTEPPER_ERR; } + + err = SUNStepper_SetFullRhsFn(*stepper, arkSUNStepperFullRhs); + if (err != SUN_SUCCESS) + { + arkProcessError(ark_mem, ARK_SUNSTEPPER_ERR, __LINE__, __func__, __FILE__, + "Failed to set SUNStepper full RHS function"); + return ARK_SUNSTEPPER_ERR; + } + + err = SUNStepper_SetResetFn(*stepper, arkSUNStepperReset); + if (err != SUN_SUCCESS) + { + arkProcessError(ark_mem, ARK_SUNSTEPPER_ERR, __LINE__, __func__, __FILE__, + "Failed to set SUNStepper reset function"); + return ARK_SUNSTEPPER_ERR; + } + + err = SUNStepper_SetStopTimeFn(*stepper, arkSUNStepperSetStopTime); + if (err != SUN_SUCCESS) + { + arkProcessError(ark_mem, ARK_SUNSTEPPER_ERR, __LINE__, __func__, __FILE__, + "Failed to set SUNStepper stop time function"); + return ARK_SUNSTEPPER_ERR; + } + + if (ark_mem->step_setforcing != NULL) + { + err = SUNStepper_SetForcingFn(*stepper, arkSUNStepperSetForcing); + if (err != SUN_SUCCESS) + { + arkProcessError(ark_mem, ARK_SUNSTEPPER_ERR, __LINE__, __func__, __FILE__, + "Failed to set SUNStepper forcing function"); + return ARK_SUNSTEPPER_ERR; + } + } + + return ARK_SUCCESS; +} diff --git a/src/arkode/fmod_int32/farkode_arkstep_mod.c b/src/arkode/fmod_int32/farkode_arkstep_mod.c index 944fd591b0..89345cc001 100644 --- a/src/arkode/fmod_int32/farkode_arkstep_mod.c +++ b/src/arkode/fmod_int32/farkode_arkstep_mod.c @@ -178,6 +178,22 @@ { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } +enum { + SWIG_MEM_OWN = 0x01, + SWIG_MEM_RVALUE = 0x02, + SWIG_MEM_CONST = 0x04 +}; + + +#define SWIG_check_mutable(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ + if ((SWIG_CLASS_WRAPPER).cmemflags & SWIG_MEM_CONST) { \ + SWIG_exception_impl(FUNCNAME, SWIG_TypeError, \ + "Cannot pass const " TYPENAME " (class " FNAME ") " \ + "as a mutable reference", \ + RETURNNULL); \ + } + + #include #if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) # ifndef snprintf @@ -233,6 +249,20 @@ SWIGINTERN SwigArrayWrapper SwigArrayWrapper_uninitialized() { #include + +typedef struct { + void* cptr; + int cmemflags; +} SwigClassWrapper; + + +SWIGINTERN SwigClassWrapper SwigClassWrapper_uninitialized() { + SwigClassWrapper result; + result.cptr = NULL; + result.cmemflags = 0; + return result; +} + SWIGEXPORT void * _wrap_FARKStepCreate(ARKRhsFn farg1, ARKRhsFn farg2, double const *farg3, N_Vector farg4, void *farg5) { void * fresult ; ARKRhsFn arg1 = (ARKRhsFn) 0 ; @@ -2427,6 +2457,23 @@ SWIGEXPORT void _wrap_FARKStepPrintMem(void *farg1, void *farg2) { } +SWIGEXPORT int _wrap_FARKStepCreateAdjointStepper(void *farg1, N_Vector farg2, SwigClassWrapper const *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + SUNAdjointStepper *arg3 = (SUNAdjointStepper *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + SWIG_check_mutable(*farg3, "SUNAdjointStepper *", "SWIGTYPE_p_SUNAdjointStepper", "ARKStepCreateAdjointStepper(void *,N_Vector,SUNAdjointStepper *)", return 0); + arg3 = (SUNAdjointStepper *)(farg3->cptr); + result = (int)ARKStepCreateAdjointStepper(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + SWIGEXPORT int _wrap_FARKStepSetRelaxFn(void *farg1, ARKRelaxFn farg2, ARKRelaxJacFn farg3) { int fresult ; void *arg1 = (void *) 0 ; diff --git a/src/arkode/fmod_int32/farkode_arkstep_mod.f90 b/src/arkode/fmod_int32/farkode_arkstep_mod.f90 index ae1f6659eb..1f1125a55b 100644 --- a/src/arkode/fmod_int32/farkode_arkstep_mod.f90 +++ b/src/arkode/fmod_int32/farkode_arkstep_mod.f90 @@ -202,6 +202,18 @@ module farkode_arkstep_mod public :: FARKStepGetLinReturnFlagName public :: FARKStepFree public :: FARKStepPrintMem + + integer, parameter :: swig_cmem_own_bit = 0 + integer, parameter :: swig_cmem_rvalue_bit = 1 + integer, parameter :: swig_cmem_const_bit = 2 + type, bind(C) :: SwigClassWrapper + type(C_PTR), public :: cptr = C_NULL_PTR + integer(C_INT), public :: cmemflags = 0 + end type + type, public :: SWIGTYPE_p_SUNAdjointStepper + type(SwigClassWrapper), public :: swigdata + end type + public :: FARKStepCreateAdjointStepper public :: FARKStepSetRelaxFn public :: FARKStepSetRelaxEtaFail public :: FARKStepSetRelaxLowerBound @@ -1625,6 +1637,17 @@ subroutine swigc_FARKStepPrintMem(farg1, farg2) & type(C_PTR), value :: farg2 end subroutine +function swigc_FARKStepCreateAdjointStepper(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepCreateAdjointStepper") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(SwigClassWrapper) :: farg3 +integer(C_INT) :: fresult +end function + function swigc_FARKStepSetRelaxFn(farg1, farg2, farg3) & bind(C, name="_wrap_FARKStepSetRelaxFn") & result(fresult) @@ -4356,6 +4379,25 @@ subroutine FARKStepPrintMem(arkode_mem, outfile) call swigc_FARKStepPrintMem(farg1, farg2) end subroutine +function FARKStepCreateAdjointStepper(arkode_mem, sf, adj_stepper_ptr) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(N_Vector), target, intent(inout) :: sf +class(SWIGTYPE_p_SUNAdjointStepper), intent(in) :: adj_stepper_ptr +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(SwigClassWrapper) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(sf) +farg3 = adj_stepper_ptr%swigdata +fresult = swigc_FARKStepCreateAdjointStepper(farg1, farg2, farg3) +swig_result = fresult +end function + function FARKStepSetRelaxFn(arkode_mem, rfn, rjac) & result(swig_result) use, intrinsic :: ISO_C_BINDING diff --git a/src/arkode/fmod_int32/farkode_mod.c b/src/arkode/fmod_int32/farkode_mod.c index 52f187e8c4..d2aa435640 100644 --- a/src/arkode/fmod_int32/farkode_mod.c +++ b/src/arkode/fmod_int32/farkode_mod.c @@ -185,6 +185,14 @@ enum { }; +#define SWIG_check_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ + if (!(SWIG_CLASS_WRAPPER).cptr) { \ + SWIG_exception_impl(FUNCNAME, SWIG_TypeError, \ + "Cannot pass null " TYPENAME " (class " FNAME ") " \ + "as a reference", RETURNNULL); \ + } + + #define SWIG_check_mutable(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ if ((SWIG_CLASS_WRAPPER).cmemflags & SWIG_MEM_CONST) { \ SWIG_exception_impl(FUNCNAME, SWIG_TypeError, \ @@ -194,14 +202,6 @@ enum { } -#define SWIG_check_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ - if (!(SWIG_CLASS_WRAPPER).cptr) { \ - SWIG_exception_impl(FUNCNAME, SWIG_TypeError, \ - "Cannot pass null " TYPENAME " (class " FNAME ") " \ - "as a reference", RETURNNULL); \ - } - - #define SWIG_check_mutable_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ SWIG_check_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL); \ SWIG_check_mutable(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL); @@ -242,6 +242,20 @@ enum { #include "arkode/arkode_ls.h" +typedef struct { + void* cptr; + int cmemflags; +} SwigClassWrapper; + + +SWIGINTERN SwigClassWrapper SwigClassWrapper_uninitialized() { + SwigClassWrapper result; + result.cptr = NULL; + result.cmemflags = 0; + return result; +} + + #include #ifdef _MSC_VER # ifndef strtoull @@ -270,20 +284,6 @@ SWIGINTERN SwigArrayWrapper SwigArrayWrapper_uninitialized() { #include -typedef struct { - void* cptr; - int cmemflags; -} SwigClassWrapper; - - -SWIGINTERN SwigClassWrapper SwigClassWrapper_uninitialized() { - SwigClassWrapper result; - result.cptr = NULL; - result.cmemflags = 0; - return result; -} - - SWIGINTERN void SWIG_assign(SwigClassWrapper* self, SwigClassWrapper other) { if (self->cptr == NULL) { /* LHS is unassigned */ @@ -1139,6 +1139,35 @@ SWIGEXPORT int _wrap_FARKodeSetMaxNumConstrFails(void *farg1, int const *farg2) } +SWIGEXPORT int _wrap_FARKodeSetAdjointCheckpointScheme(void *farg1, SwigClassWrapper const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + SUNAdjointCheckpointScheme arg2 ; + int result; + + arg1 = (void *)(farg1); + SWIG_check_nonnull(*farg2, "SUNAdjointCheckpointScheme", "SWIGTYPE_p_SUNAdjointCheckpointScheme", "ARKodeSetAdjointCheckpointScheme(void *,SUNAdjointCheckpointScheme)", return 0); + arg2 = *(SUNAdjointCheckpointScheme *)(farg2->cptr); + result = (int)ARKodeSetAdjointCheckpointScheme(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKodeSetAdjointCheckpointIndex(void *farg1, int64_t const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int64_t arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int64_t)(*farg2); + result = (int)ARKodeSetAdjointCheckpointIndex(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + SWIGEXPORT int _wrap_FARKodeEvolve(void *farg1, double const *farg2, N_Vector farg3, double *farg4, int const *farg5) { int fresult ; void *arg1 = (void *) 0 ; @@ -2253,6 +2282,20 @@ SWIGEXPORT int _wrap_FARKodeGetNumRelaxSolveIters(void *farg1, long *farg2) { } +SWIGEXPORT int _wrap_FARKodeCreateSUNStepper(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + SUNStepper *arg2 = (SUNStepper *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (SUNStepper *)(farg2); + result = (int)ARKodeCreateSUNStepper(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + SWIGEXPORT int _wrap_FARKBandPrecInit(void *farg1, int32_t const *farg2, int32_t const *farg3, int32_t const *farg4) { int fresult ; void *arg1 = (void *) 0 ; diff --git a/src/arkode/fmod_int32/farkode_mod.f90 b/src/arkode/fmod_int32/farkode_mod.f90 index d5eefa63da..5d13b9078f 100644 --- a/src/arkode/fmod_int32/farkode_mod.f90 +++ b/src/arkode/fmod_int32/farkode_mod.f90 @@ -94,6 +94,9 @@ module farkode_mod integer(C_INT), parameter, public :: ARK_RELAX_JAC_FAIL = -46_C_INT integer(C_INT), parameter, public :: ARK_CONTROLLER_ERR = -47_C_INT integer(C_INT), parameter, public :: ARK_STEPPER_UNSUPPORTED = -48_C_INT + integer(C_INT), parameter, public :: ARK_SUNSTEPPER_ERR = -49_C_INT + integer(C_INT), parameter, public :: ARK_ADJ_CHECKPOINT_FAIL = -50_C_INT + integer(C_INT), parameter, public :: ARK_ADJ_RECOMPUTE_FAIL = -51_C_INT integer(C_INT), parameter, public :: ARK_UNRECOGNIZED_ERROR = -99_C_INT ! typedef enum ARKRelaxSolver enum, bind(c) @@ -160,6 +163,19 @@ module farkode_mod public :: FARKodeSetMinStep public :: FARKodeSetMaxStep public :: FARKodeSetMaxNumConstrFails + + integer, parameter :: swig_cmem_own_bit = 0 + integer, parameter :: swig_cmem_rvalue_bit = 1 + integer, parameter :: swig_cmem_const_bit = 2 + type, bind(C) :: SwigClassWrapper + type(C_PTR), public :: cptr = C_NULL_PTR + integer(C_INT), public :: cmemflags = 0 + end type + type, public :: SWIGTYPE_p_SUNAdjointCheckpointScheme + type(SwigClassWrapper), public :: swigdata + end type + public :: FARKodeSetAdjointCheckpointScheme + public :: FARKodeSetAdjointCheckpointIndex public :: FARKodeEvolve public :: FARKodeGetDky public :: FARKodeComputeState @@ -241,6 +257,7 @@ module farkode_mod public :: FARKodeGetNumRelaxBoundFails public :: FARKodeGetNumRelaxSolveFails public :: FARKodeGetNumRelaxSolveIters + public :: FARKodeCreateSUNStepper public :: FARKBandPrecInit public :: FARKBandPrecGetWorkSpace public :: FARKBandPrecGetNumRhsEvals @@ -248,14 +265,6 @@ module farkode_mod public :: FARKBBDPrecReInit public :: FARKBBDPrecGetWorkSpace public :: FARKBBDPrecGetNumGfnEvals - - integer, parameter :: swig_cmem_own_bit = 0 - integer, parameter :: swig_cmem_rvalue_bit = 1 - integer, parameter :: swig_cmem_const_bit = 2 - type, bind(C) :: SwigClassWrapper - type(C_PTR), public :: cptr = C_NULL_PTR - integer(C_INT), public :: cmemflags = 0 - end type ! struct struct ARKodeButcherTableMem type, public :: ARKodeButcherTableMem type(SwigClassWrapper), public :: swigdata @@ -987,6 +996,25 @@ function swigc_FARKodeSetMaxNumConstrFails(farg1, farg2) & integer(C_INT) :: fresult end function +function swigc_FARKodeSetAdjointCheckpointScheme(farg1, farg2) & +bind(C, name="_wrap_FARKodeSetAdjointCheckpointScheme") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(C_PTR), value :: farg1 +type(SwigClassWrapper) :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FARKodeSetAdjointCheckpointIndex(farg1, farg2) & +bind(C, name="_wrap_FARKodeSetAdjointCheckpointIndex") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT) :: fresult +end function + function swigc_FARKodeEvolve(farg1, farg2, farg3, farg4, farg5) & bind(C, name="_wrap_FARKodeEvolve") & result(fresult) @@ -1704,6 +1732,15 @@ function swigc_FARKodeGetNumRelaxSolveIters(farg1, farg2) & integer(C_INT) :: fresult end function +function swigc_FARKodeCreateSUNStepper(farg1, farg2) & +bind(C, name="_wrap_FARKodeCreateSUNStepper") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + function swigc_FARKBandPrecInit(farg1, farg2, farg3, farg4) & bind(C, name="_wrap_FARKBandPrecInit") & result(fresult) @@ -3326,6 +3363,38 @@ function FARKodeSetMaxNumConstrFails(arkode_mem, maxfails) & swig_result = fresult end function +function FARKodeSetAdjointCheckpointScheme(arkode_mem, checkpoint_scheme) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(SWIGTYPE_p_SUNAdjointCheckpointScheme), intent(in) :: checkpoint_scheme +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(SwigClassWrapper) :: farg2 + +farg1 = arkode_mem +farg2 = checkpoint_scheme%swigdata +fresult = swigc_FARKodeSetAdjointCheckpointScheme(farg1, farg2) +swig_result = fresult +end function + +function FARKodeSetAdjointCheckpointIndex(arkode_mem, step_index) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT64_T), intent(in) :: step_index +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = arkode_mem +farg2 = step_index +fresult = swigc_FARKodeSetAdjointCheckpointIndex(farg1, farg2) +swig_result = fresult +end function + function FARKodeEvolve(arkode_mem, tout, yout, tret, itask) & result(swig_result) use, intrinsic :: ISO_C_BINDING @@ -4629,6 +4698,22 @@ function FARKodeGetNumRelaxSolveIters(arkode_mem, iters) & swig_result = fresult end function +function FARKodeCreateSUNStepper(arkode_mem, stepper) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR), target, intent(inout) :: stepper +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(stepper) +fresult = swigc_FARKodeCreateSUNStepper(farg1, farg2) +swig_result = fresult +end function + function FARKBandPrecInit(arkode_mem, n, mu, ml) & result(swig_result) use, intrinsic :: ISO_C_BINDING diff --git a/src/arkode/fmod_int32/farkode_mristep_mod.c b/src/arkode/fmod_int32/farkode_mristep_mod.c index 8b6a72b660..b454003c6d 100644 --- a/src/arkode/fmod_int32/farkode_mristep_mod.c +++ b/src/arkode/fmod_int32/farkode_mristep_mod.c @@ -755,6 +755,20 @@ SWIGEXPORT int _wrap_FMRIStepInnerStepper_Create(void *farg1, void *farg2) { } +SWIGEXPORT int _wrap_FMRIStepInnerStepper_CreateFromSUNStepper(void *farg1, void *farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + MRIStepInnerStepper *arg2 = (MRIStepInnerStepper *) 0 ; + int result; + + arg1 = (SUNStepper)(farg1); + arg2 = (MRIStepInnerStepper *)(farg2); + result = (int)MRIStepInnerStepper_CreateFromSUNStepper(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + SWIGEXPORT int _wrap_FMRIStepInnerStepper_Free(void *farg1) { int fresult ; MRIStepInnerStepper *arg1 = (MRIStepInnerStepper *) 0 ; diff --git a/src/arkode/fmod_int32/farkode_mristep_mod.f90 b/src/arkode/fmod_int32/farkode_mristep_mod.f90 index ecba398b89..9505d486cb 100644 --- a/src/arkode/fmod_int32/farkode_mristep_mod.f90 +++ b/src/arkode/fmod_int32/farkode_mristep_mod.f90 @@ -132,6 +132,7 @@ module farkode_mristep_mod public :: FMRIStepGetCurrentCoupling public :: FMRIStepGetLastInnerStepFlag public :: FMRIStepInnerStepper_Create + public :: FMRIStepInnerStepper_CreateFromSUNStepper public :: FMRIStepInnerStepper_Free public :: FMRIStepInnerStepper_SetContent public :: FMRIStepInnerStepper_GetContent @@ -530,6 +531,15 @@ function swigc_FMRIStepInnerStepper_Create(farg1, farg2) & integer(C_INT) :: fresult end function +function swigc_FMRIStepInnerStepper_CreateFromSUNStepper(farg1, farg2) & +bind(C, name="_wrap_FMRIStepInnerStepper_CreateFromSUNStepper") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + function swigc_FMRIStepInnerStepper_Free(farg1) & bind(C, name="_wrap_FMRIStepInnerStepper_Free") & result(fresult) @@ -1931,6 +1941,22 @@ function FMRIStepInnerStepper_Create(sunctx, stepper) & swig_result = fresult end function +function FMRIStepInnerStepper_CreateFromSUNStepper(sunstepper, stepper) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: sunstepper +type(C_PTR), target, intent(inout) :: stepper +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = sunstepper +farg2 = c_loc(stepper) +fresult = swigc_FMRIStepInnerStepper_CreateFromSUNStepper(farg1, farg2) +swig_result = fresult +end function + function FMRIStepInnerStepper_Free(stepper) & result(swig_result) use, intrinsic :: ISO_C_BINDING diff --git a/src/arkode/fmod_int64/farkode_arkstep_mod.c b/src/arkode/fmod_int64/farkode_arkstep_mod.c index 944fd591b0..89345cc001 100644 --- a/src/arkode/fmod_int64/farkode_arkstep_mod.c +++ b/src/arkode/fmod_int64/farkode_arkstep_mod.c @@ -178,6 +178,22 @@ { printf("In " DECL ": " MSG); assert(0); RETURNNULL; } +enum { + SWIG_MEM_OWN = 0x01, + SWIG_MEM_RVALUE = 0x02, + SWIG_MEM_CONST = 0x04 +}; + + +#define SWIG_check_mutable(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ + if ((SWIG_CLASS_WRAPPER).cmemflags & SWIG_MEM_CONST) { \ + SWIG_exception_impl(FUNCNAME, SWIG_TypeError, \ + "Cannot pass const " TYPENAME " (class " FNAME ") " \ + "as a mutable reference", \ + RETURNNULL); \ + } + + #include #if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM) # ifndef snprintf @@ -233,6 +249,20 @@ SWIGINTERN SwigArrayWrapper SwigArrayWrapper_uninitialized() { #include + +typedef struct { + void* cptr; + int cmemflags; +} SwigClassWrapper; + + +SWIGINTERN SwigClassWrapper SwigClassWrapper_uninitialized() { + SwigClassWrapper result; + result.cptr = NULL; + result.cmemflags = 0; + return result; +} + SWIGEXPORT void * _wrap_FARKStepCreate(ARKRhsFn farg1, ARKRhsFn farg2, double const *farg3, N_Vector farg4, void *farg5) { void * fresult ; ARKRhsFn arg1 = (ARKRhsFn) 0 ; @@ -2427,6 +2457,23 @@ SWIGEXPORT void _wrap_FARKStepPrintMem(void *farg1, void *farg2) { } +SWIGEXPORT int _wrap_FARKStepCreateAdjointStepper(void *farg1, N_Vector farg2, SwigClassWrapper const *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + SUNAdjointStepper *arg3 = (SUNAdjointStepper *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + SWIG_check_mutable(*farg3, "SUNAdjointStepper *", "SWIGTYPE_p_SUNAdjointStepper", "ARKStepCreateAdjointStepper(void *,N_Vector,SUNAdjointStepper *)", return 0); + arg3 = (SUNAdjointStepper *)(farg3->cptr); + result = (int)ARKStepCreateAdjointStepper(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + SWIGEXPORT int _wrap_FARKStepSetRelaxFn(void *farg1, ARKRelaxFn farg2, ARKRelaxJacFn farg3) { int fresult ; void *arg1 = (void *) 0 ; diff --git a/src/arkode/fmod_int64/farkode_arkstep_mod.f90 b/src/arkode/fmod_int64/farkode_arkstep_mod.f90 index ae1f6659eb..1f1125a55b 100644 --- a/src/arkode/fmod_int64/farkode_arkstep_mod.f90 +++ b/src/arkode/fmod_int64/farkode_arkstep_mod.f90 @@ -202,6 +202,18 @@ module farkode_arkstep_mod public :: FARKStepGetLinReturnFlagName public :: FARKStepFree public :: FARKStepPrintMem + + integer, parameter :: swig_cmem_own_bit = 0 + integer, parameter :: swig_cmem_rvalue_bit = 1 + integer, parameter :: swig_cmem_const_bit = 2 + type, bind(C) :: SwigClassWrapper + type(C_PTR), public :: cptr = C_NULL_PTR + integer(C_INT), public :: cmemflags = 0 + end type + type, public :: SWIGTYPE_p_SUNAdjointStepper + type(SwigClassWrapper), public :: swigdata + end type + public :: FARKStepCreateAdjointStepper public :: FARKStepSetRelaxFn public :: FARKStepSetRelaxEtaFail public :: FARKStepSetRelaxLowerBound @@ -1625,6 +1637,17 @@ subroutine swigc_FARKStepPrintMem(farg1, farg2) & type(C_PTR), value :: farg2 end subroutine +function swigc_FARKStepCreateAdjointStepper(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepCreateAdjointStepper") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(SwigClassWrapper) :: farg3 +integer(C_INT) :: fresult +end function + function swigc_FARKStepSetRelaxFn(farg1, farg2, farg3) & bind(C, name="_wrap_FARKStepSetRelaxFn") & result(fresult) @@ -4356,6 +4379,25 @@ subroutine FARKStepPrintMem(arkode_mem, outfile) call swigc_FARKStepPrintMem(farg1, farg2) end subroutine +function FARKStepCreateAdjointStepper(arkode_mem, sf, adj_stepper_ptr) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(N_Vector), target, intent(inout) :: sf +class(SWIGTYPE_p_SUNAdjointStepper), intent(in) :: adj_stepper_ptr +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(SwigClassWrapper) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(sf) +farg3 = adj_stepper_ptr%swigdata +fresult = swigc_FARKStepCreateAdjointStepper(farg1, farg2, farg3) +swig_result = fresult +end function + function FARKStepSetRelaxFn(arkode_mem, rfn, rjac) & result(swig_result) use, intrinsic :: ISO_C_BINDING diff --git a/src/arkode/fmod_int64/farkode_mod.c b/src/arkode/fmod_int64/farkode_mod.c index b092ee9d57..50d256a237 100644 --- a/src/arkode/fmod_int64/farkode_mod.c +++ b/src/arkode/fmod_int64/farkode_mod.c @@ -185,6 +185,14 @@ enum { }; +#define SWIG_check_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ + if (!(SWIG_CLASS_WRAPPER).cptr) { \ + SWIG_exception_impl(FUNCNAME, SWIG_TypeError, \ + "Cannot pass null " TYPENAME " (class " FNAME ") " \ + "as a reference", RETURNNULL); \ + } + + #define SWIG_check_mutable(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ if ((SWIG_CLASS_WRAPPER).cmemflags & SWIG_MEM_CONST) { \ SWIG_exception_impl(FUNCNAME, SWIG_TypeError, \ @@ -194,14 +202,6 @@ enum { } -#define SWIG_check_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ - if (!(SWIG_CLASS_WRAPPER).cptr) { \ - SWIG_exception_impl(FUNCNAME, SWIG_TypeError, \ - "Cannot pass null " TYPENAME " (class " FNAME ") " \ - "as a reference", RETURNNULL); \ - } - - #define SWIG_check_mutable_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ SWIG_check_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL); \ SWIG_check_mutable(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL); @@ -242,6 +242,20 @@ enum { #include "arkode/arkode_ls.h" +typedef struct { + void* cptr; + int cmemflags; +} SwigClassWrapper; + + +SWIGINTERN SwigClassWrapper SwigClassWrapper_uninitialized() { + SwigClassWrapper result; + result.cptr = NULL; + result.cmemflags = 0; + return result; +} + + #include #ifdef _MSC_VER # ifndef strtoull @@ -270,20 +284,6 @@ SWIGINTERN SwigArrayWrapper SwigArrayWrapper_uninitialized() { #include -typedef struct { - void* cptr; - int cmemflags; -} SwigClassWrapper; - - -SWIGINTERN SwigClassWrapper SwigClassWrapper_uninitialized() { - SwigClassWrapper result; - result.cptr = NULL; - result.cmemflags = 0; - return result; -} - - SWIGINTERN void SWIG_assign(SwigClassWrapper* self, SwigClassWrapper other) { if (self->cptr == NULL) { /* LHS is unassigned */ @@ -1139,6 +1139,35 @@ SWIGEXPORT int _wrap_FARKodeSetMaxNumConstrFails(void *farg1, int const *farg2) } +SWIGEXPORT int _wrap_FARKodeSetAdjointCheckpointScheme(void *farg1, SwigClassWrapper const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + SUNAdjointCheckpointScheme arg2 ; + int result; + + arg1 = (void *)(farg1); + SWIG_check_nonnull(*farg2, "SUNAdjointCheckpointScheme", "SWIGTYPE_p_SUNAdjointCheckpointScheme", "ARKodeSetAdjointCheckpointScheme(void *,SUNAdjointCheckpointScheme)", return 0); + arg2 = *(SUNAdjointCheckpointScheme *)(farg2->cptr); + result = (int)ARKodeSetAdjointCheckpointScheme(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKodeSetAdjointCheckpointIndex(void *farg1, int64_t const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int64_t arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int64_t)(*farg2); + result = (int)ARKodeSetAdjointCheckpointIndex(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + SWIGEXPORT int _wrap_FARKodeEvolve(void *farg1, double const *farg2, N_Vector farg3, double *farg4, int const *farg5) { int fresult ; void *arg1 = (void *) 0 ; @@ -2253,6 +2282,20 @@ SWIGEXPORT int _wrap_FARKodeGetNumRelaxSolveIters(void *farg1, long *farg2) { } +SWIGEXPORT int _wrap_FARKodeCreateSUNStepper(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + SUNStepper *arg2 = (SUNStepper *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (SUNStepper *)(farg2); + result = (int)ARKodeCreateSUNStepper(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + SWIGEXPORT int _wrap_FARKBandPrecInit(void *farg1, int64_t const *farg2, int64_t const *farg3, int64_t const *farg4) { int fresult ; void *arg1 = (void *) 0 ; diff --git a/src/arkode/fmod_int64/farkode_mod.f90 b/src/arkode/fmod_int64/farkode_mod.f90 index ffb3eedfac..0d21f0398b 100644 --- a/src/arkode/fmod_int64/farkode_mod.f90 +++ b/src/arkode/fmod_int64/farkode_mod.f90 @@ -94,6 +94,9 @@ module farkode_mod integer(C_INT), parameter, public :: ARK_RELAX_JAC_FAIL = -46_C_INT integer(C_INT), parameter, public :: ARK_CONTROLLER_ERR = -47_C_INT integer(C_INT), parameter, public :: ARK_STEPPER_UNSUPPORTED = -48_C_INT + integer(C_INT), parameter, public :: ARK_SUNSTEPPER_ERR = -49_C_INT + integer(C_INT), parameter, public :: ARK_ADJ_CHECKPOINT_FAIL = -50_C_INT + integer(C_INT), parameter, public :: ARK_ADJ_RECOMPUTE_FAIL = -51_C_INT integer(C_INT), parameter, public :: ARK_UNRECOGNIZED_ERROR = -99_C_INT ! typedef enum ARKRelaxSolver enum, bind(c) @@ -160,6 +163,19 @@ module farkode_mod public :: FARKodeSetMinStep public :: FARKodeSetMaxStep public :: FARKodeSetMaxNumConstrFails + + integer, parameter :: swig_cmem_own_bit = 0 + integer, parameter :: swig_cmem_rvalue_bit = 1 + integer, parameter :: swig_cmem_const_bit = 2 + type, bind(C) :: SwigClassWrapper + type(C_PTR), public :: cptr = C_NULL_PTR + integer(C_INT), public :: cmemflags = 0 + end type + type, public :: SWIGTYPE_p_SUNAdjointCheckpointScheme + type(SwigClassWrapper), public :: swigdata + end type + public :: FARKodeSetAdjointCheckpointScheme + public :: FARKodeSetAdjointCheckpointIndex public :: FARKodeEvolve public :: FARKodeGetDky public :: FARKodeComputeState @@ -241,6 +257,7 @@ module farkode_mod public :: FARKodeGetNumRelaxBoundFails public :: FARKodeGetNumRelaxSolveFails public :: FARKodeGetNumRelaxSolveIters + public :: FARKodeCreateSUNStepper public :: FARKBandPrecInit public :: FARKBandPrecGetWorkSpace public :: FARKBandPrecGetNumRhsEvals @@ -248,14 +265,6 @@ module farkode_mod public :: FARKBBDPrecReInit public :: FARKBBDPrecGetWorkSpace public :: FARKBBDPrecGetNumGfnEvals - - integer, parameter :: swig_cmem_own_bit = 0 - integer, parameter :: swig_cmem_rvalue_bit = 1 - integer, parameter :: swig_cmem_const_bit = 2 - type, bind(C) :: SwigClassWrapper - type(C_PTR), public :: cptr = C_NULL_PTR - integer(C_INT), public :: cmemflags = 0 - end type ! struct struct ARKodeButcherTableMem type, public :: ARKodeButcherTableMem type(SwigClassWrapper), public :: swigdata @@ -987,6 +996,25 @@ function swigc_FARKodeSetMaxNumConstrFails(farg1, farg2) & integer(C_INT) :: fresult end function +function swigc_FARKodeSetAdjointCheckpointScheme(farg1, farg2) & +bind(C, name="_wrap_FARKodeSetAdjointCheckpointScheme") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(C_PTR), value :: farg1 +type(SwigClassWrapper) :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FARKodeSetAdjointCheckpointIndex(farg1, farg2) & +bind(C, name="_wrap_FARKodeSetAdjointCheckpointIndex") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT) :: fresult +end function + function swigc_FARKodeEvolve(farg1, farg2, farg3, farg4, farg5) & bind(C, name="_wrap_FARKodeEvolve") & result(fresult) @@ -1704,6 +1732,15 @@ function swigc_FARKodeGetNumRelaxSolveIters(farg1, farg2) & integer(C_INT) :: fresult end function +function swigc_FARKodeCreateSUNStepper(farg1, farg2) & +bind(C, name="_wrap_FARKodeCreateSUNStepper") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + function swigc_FARKBandPrecInit(farg1, farg2, farg3, farg4) & bind(C, name="_wrap_FARKBandPrecInit") & result(fresult) @@ -3326,6 +3363,38 @@ function FARKodeSetMaxNumConstrFails(arkode_mem, maxfails) & swig_result = fresult end function +function FARKodeSetAdjointCheckpointScheme(arkode_mem, checkpoint_scheme) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(SWIGTYPE_p_SUNAdjointCheckpointScheme), intent(in) :: checkpoint_scheme +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(SwigClassWrapper) :: farg2 + +farg1 = arkode_mem +farg2 = checkpoint_scheme%swigdata +fresult = swigc_FARKodeSetAdjointCheckpointScheme(farg1, farg2) +swig_result = fresult +end function + +function FARKodeSetAdjointCheckpointIndex(arkode_mem, step_index) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT64_T), intent(in) :: step_index +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = arkode_mem +farg2 = step_index +fresult = swigc_FARKodeSetAdjointCheckpointIndex(farg1, farg2) +swig_result = fresult +end function + function FARKodeEvolve(arkode_mem, tout, yout, tret, itask) & result(swig_result) use, intrinsic :: ISO_C_BINDING @@ -4629,6 +4698,22 @@ function FARKodeGetNumRelaxSolveIters(arkode_mem, iters) & swig_result = fresult end function +function FARKodeCreateSUNStepper(arkode_mem, stepper) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR), target, intent(inout) :: stepper +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(stepper) +fresult = swigc_FARKodeCreateSUNStepper(farg1, farg2) +swig_result = fresult +end function + function FARKBandPrecInit(arkode_mem, n, mu, ml) & result(swig_result) use, intrinsic :: ISO_C_BINDING diff --git a/src/arkode/fmod_int64/farkode_mristep_mod.c b/src/arkode/fmod_int64/farkode_mristep_mod.c index 5ddb7d077a..d5597bea4f 100644 --- a/src/arkode/fmod_int64/farkode_mristep_mod.c +++ b/src/arkode/fmod_int64/farkode_mristep_mod.c @@ -755,6 +755,20 @@ SWIGEXPORT int _wrap_FMRIStepInnerStepper_Create(void *farg1, void *farg2) { } +SWIGEXPORT int _wrap_FMRIStepInnerStepper_CreateFromSUNStepper(void *farg1, void *farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + MRIStepInnerStepper *arg2 = (MRIStepInnerStepper *) 0 ; + int result; + + arg1 = (SUNStepper)(farg1); + arg2 = (MRIStepInnerStepper *)(farg2); + result = (int)MRIStepInnerStepper_CreateFromSUNStepper(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + SWIGEXPORT int _wrap_FMRIStepInnerStepper_Free(void *farg1) { int fresult ; MRIStepInnerStepper *arg1 = (MRIStepInnerStepper *) 0 ; diff --git a/src/arkode/fmod_int64/farkode_mristep_mod.f90 b/src/arkode/fmod_int64/farkode_mristep_mod.f90 index be5bb7445a..e2202c73da 100644 --- a/src/arkode/fmod_int64/farkode_mristep_mod.f90 +++ b/src/arkode/fmod_int64/farkode_mristep_mod.f90 @@ -132,6 +132,7 @@ module farkode_mristep_mod public :: FMRIStepGetCurrentCoupling public :: FMRIStepGetLastInnerStepFlag public :: FMRIStepInnerStepper_Create + public :: FMRIStepInnerStepper_CreateFromSUNStepper public :: FMRIStepInnerStepper_Free public :: FMRIStepInnerStepper_SetContent public :: FMRIStepInnerStepper_GetContent @@ -530,6 +531,15 @@ function swigc_FMRIStepInnerStepper_Create(farg1, farg2) & integer(C_INT) :: fresult end function +function swigc_FMRIStepInnerStepper_CreateFromSUNStepper(farg1, farg2) & +bind(C, name="_wrap_FMRIStepInnerStepper_CreateFromSUNStepper") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + function swigc_FMRIStepInnerStepper_Free(farg1) & bind(C, name="_wrap_FMRIStepInnerStepper_Free") & result(fresult) @@ -1931,6 +1941,22 @@ function FMRIStepInnerStepper_Create(sunctx, stepper) & swig_result = fresult end function +function FMRIStepInnerStepper_CreateFromSUNStepper(sunstepper, stepper) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: sunstepper +type(C_PTR), target, intent(inout) :: stepper +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = sunstepper +farg2 = c_loc(stepper) +fresult = swigc_FMRIStepInnerStepper_CreateFromSUNStepper(farg1, farg2) +swig_result = fresult +end function + function FMRIStepInnerStepper_Free(stepper) & result(swig_result) use, intrinsic :: ISO_C_BINDING diff --git a/src/sunadjoint/CMakeLists.txt b/src/sunadjoint/CMakeLists.txt new file mode 100644 index 0000000000..dd897f5435 --- /dev/null +++ b/src/sunadjoint/CMakeLists.txt @@ -0,0 +1,29 @@ +# --------------------------------------------------------------- +# SUNDIALS Copyright Start +# Copyright (c) 2002-2024, 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 +# --------------------------------------------------------------- + +# Create a library out of the generic sundials modules +sundials_add_library( + sundials_adjoint + SOURCES sunadjoint_stepper.c sunadjoint_checkpointscheme.c + sunadjoint_checkpointscheme_fixed.c + HEADERS + ${SUNDIALS_SOURCE_DIR}/include/sunadjoint/sunadjoint_stepper.h + ${SUNDIALS_SOURCE_DIR}/include/sunadjoint/sunadjoint_checkpointscheme.h + ${SUNDIALS_SOURCE_DIR}/include/sunadjoint/sunadjoint_checkpointscheme_fixed.h + LINK_LIBRARIES PUBLIC sundials_core + OBJECT_LIBRARIES sundials_sunmemsys_obj + INCLUDE_SUBDIR sunadjoint) + +# Add F2003 module if the interface is enabled +if(BUILD_FORTRAN_MODULE_INTERFACE) + add_subdirectory("fmod_int${SUNDIALS_INDEX_SIZE}") +endif() diff --git a/src/sunadjoint/fmod_int32/CMakeLists.txt b/src/sunadjoint/fmod_int32/CMakeLists.txt new file mode 100644 index 0000000000..440f06eeb9 --- /dev/null +++ b/src/sunadjoint/fmod_int32/CMakeLists.txt @@ -0,0 +1,24 @@ +# --------------------------------------------------------------- +# SUNDIALS Copyright Start +# Copyright (c) 2002-2024, 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_add_f2003_library( + sundials_fsunadjoint_mod + SOURCES fsunadjointstepper_mod.f90 + fsunadjointstepper_mod.c + fsunadjointcheckpointscheme_mod.f90 + fsunadjointcheckpointscheme_mod.c + fsunadjointcheckpointscheme_fixed_mod.f90 + fsunadjointcheckpointscheme_fixed_mod.c + LINK_LIBRARIES PUBLIC sundials_fcore_mod + OUTPUT_NAME sundials_fsunadjoint_mod OBJECT_LIB_ONLY) + +message(STATUS "Added SUNAdjoint interface") diff --git a/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_basic_mod.c b/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_basic_mod.c new file mode 100644 index 0000000000..ac6ab39940 --- /dev/null +++ b/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_basic_mod.c @@ -0,0 +1,391 @@ +/* ---------------------------------------------------------------------------- + * 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-2024, 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; } + + +enum { + SWIG_MEM_OWN = 0x01, + SWIG_MEM_RVALUE = 0x02, + SWIG_MEM_CONST = 0x04 +}; + + +#define SWIG_check_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ + if (!(SWIG_CLASS_WRAPPER).cptr) { \ + SWIG_exception_impl(FUNCNAME, SWIG_TypeError, \ + "Cannot pass null " TYPENAME " (class " FNAME ") " \ + "as a reference", 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 "sunadjoint/sunadjoint_checkpointscheme_fixed.h" + + +typedef struct { + void* cptr; + int cmemflags; +} SwigClassWrapper; + + +SWIGINTERN SwigClassWrapper SwigClassWrapper_uninitialized() { + SwigClassWrapper result; + result.cptr = NULL; + result.cmemflags = 0; + return result; +} + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_Create_Fixed(int const *farg1, SwigClassWrapper const *farg2, int64_t const *farg3, int64_t const *farg4, int const *farg5, int const *farg6, void *farg7, void *farg8) { + int fresult ; + SUNDataIOMode arg1 ; + SUNMemoryHelper arg2 ; + int64_t arg3 ; + int64_t arg4 ; + int arg5 ; + int arg6 ; + SUNContext arg7 = (SUNContext) 0 ; + SUNAdjointCheckpointScheme *arg8 = (SUNAdjointCheckpointScheme *) 0 ; + SUNErrCode result; + + arg1 = (SUNDataIOMode)(*farg1); + SWIG_check_nonnull(*farg2, "SUNMemoryHelper", "SWIGTYPE_p_SUNMemoryHelper", "SUNAdjointCheckpointScheme_Create_Fixed(SUNDataIOMode,SUNMemoryHelper,int64_t,int64_t,int,int,SUNContext,SUNAdjointCheckpointScheme *)", return 0); + arg2 = *(SUNMemoryHelper *)(farg2->cptr); + arg3 = (int64_t)(*farg3); + arg4 = (int64_t)(*farg4); + arg5 = (int)(*farg5); + arg6 = (int)(*farg6); + arg7 = (SUNContext)(farg7); + arg8 = (SUNAdjointCheckpointScheme *)(farg8); + result = (SUNErrCode)SUNAdjointCheckpointScheme_Create_Fixed(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, double const *farg4, int *farg5) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + sunrealtype arg4 ; + int *arg5 = (int *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (sunrealtype)(*farg4); + arg5 = (int *)(farg5); + result = (SUNErrCode)SUNAdjointCheckpointScheme_ShouldWeSave_Fixed(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_InsertVector_Fixed(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, double const *farg4, N_Vector farg5) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + sunrealtype arg4 ; + N_Vector arg5 = (N_Vector) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (sunrealtype)(*farg4); + arg5 = (N_Vector)(farg5); + result = (SUNErrCode)SUNAdjointCheckpointScheme_InsertVector_Fixed(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, int *farg4) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + int *arg4 = (int *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (int *)(farg4); + result = (SUNErrCode)SUNAdjointCheckpointScheme_ShouldWeDelete_Fixed(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_RemoveVector_Fixed(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, void *farg4) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + N_Vector *arg4 = (N_Vector *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (N_Vector *)(farg4); + result = (SUNErrCode)SUNAdjointCheckpointScheme_RemoveVector_Fixed(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_LoadVector_Fixed(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, int const *farg4, void *farg5, double *farg6) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + int arg4 ; + N_Vector *arg5 = (N_Vector *) 0 ; + sunrealtype *arg6 = (sunrealtype *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (int)(*farg4); + arg5 = (N_Vector *)(farg5); + arg6 = (sunrealtype *)(farg6); + result = (SUNErrCode)SUNAdjointCheckpointScheme_LoadVector_Fixed(arg1,arg2,arg3,arg4,arg5,arg6); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_Destroy_Fixed(void *farg1) { + int fresult ; + SUNAdjointCheckpointScheme *arg1 = (SUNAdjointCheckpointScheme *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme *)(farg1); + result = (SUNErrCode)SUNAdjointCheckpointScheme_Destroy_Fixed(arg1); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_EnableDense_Fixed(SUNAdjointCheckpointScheme farg1, int const *farg2) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int arg2 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int)(*farg2); + result = (SUNErrCode)SUNAdjointCheckpointScheme_EnableDense_Fixed(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + + diff --git a/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_basic_mod.f90 b/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_basic_mod.f90 new file mode 100644 index 0000000000..fb6df78cce --- /dev/null +++ b/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_basic_mod.f90 @@ -0,0 +1,336 @@ +! This file was automatically generated by SWIG (http://www.swig.org). +! Version 4.0.0 +! +! 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-2024, 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 +! --------------------------------------------------------------- + +module fsunadjointcheckpointscheme_fixed_mod + use, intrinsic :: ISO_C_BINDING + use fsundials_core_mod + use fsunadjointcheckpointscheme_mod + use fsundials_core_mod + implicit none + private + + ! DECLARATION CONSTRUCTS + + integer, parameter :: swig_cmem_own_bit = 0 + integer, parameter :: swig_cmem_rvalue_bit = 1 + integer, parameter :: swig_cmem_const_bit = 2 + type, bind(C) :: SwigClassWrapper + type(C_PTR), public :: cptr = C_NULL_PTR + integer(C_INT), public :: cmemflags = 0 + end type + type, public :: SWIGTYPE_p_SUNMemoryHelper + type(SwigClassWrapper), public :: swigdata + end type + public :: FSUNAdjointCheckpointScheme_Create_Fixed + public :: FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed + public :: FSUNAdjointCheckpointScheme_InsertVector_Fixed + public :: FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed + public :: FSUNAdjointCheckpointScheme_RemoveVector_Fixed + public :: FSUNAdjointCheckpointScheme_LoadVector_Fixed + public :: FSUNAdjointCheckpointScheme_Destroy_Fixed + public :: FSUNAdjointCheckpointScheme_EnableDense_Fixed + +! WRAPPER DECLARATIONS +interface +function swigc_FSUNAdjointCheckpointScheme_Create_Fixed(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_Create_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +integer(C_INT), intent(in) :: farg1 +type(SwigClassWrapper) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +integer(C_INT64_T), intent(in) :: farg4 +integer(C_INT), intent(in) :: farg5 +integer(C_INT), intent(in) :: farg6 +type(C_PTR), value :: farg7 +type(C_PTR), value :: farg8 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +real(C_DOUBLE), intent(in) :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_InsertVector_Fixed(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_InsertVector_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +real(C_DOUBLE), intent(in) :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_RemoveVector_Fixed(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_RemoveVector_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_LoadVector_Fixed(farg1, farg2, farg3, farg4, farg5, farg6) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_LoadVector_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +integer(C_INT), intent(in) :: farg4 +type(C_PTR), value :: farg5 +type(C_PTR), value :: farg6 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_Destroy_Fixed(farg1) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_Destroy_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_EnableDense_Fixed(farg1, farg2) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_EnableDense_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT), intent(in) :: farg2 +integer(C_INT) :: fresult +end function + +end interface + + +contains + ! MODULE SUBPROGRAMS +function FSUNAdjointCheckpointScheme_Create_Fixed(io_mode, mem_helper, interval, estimate, save_stages, keep, sunctx, & + check_scheme_ptr) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +integer(SUNDataIOMode), intent(in) :: io_mode +type(SWIGTYPE_p_SUNMemoryHelper), intent(in) :: mem_helper +integer(C_INT64_T), intent(in) :: interval +integer(C_INT64_T), intent(in) :: estimate +integer(C_INT), intent(in) :: save_stages +integer(C_INT), intent(in) :: keep +type(C_PTR) :: sunctx +type(C_PTR), target, intent(inout) :: check_scheme_ptr +integer(C_INT) :: fresult +integer(C_INT) :: farg1 +type(SwigClassWrapper) :: farg2 +integer(C_INT64_T) :: farg3 +integer(C_INT64_T) :: farg4 +integer(C_INT) :: farg5 +integer(C_INT) :: farg6 +type(C_PTR) :: farg7 +type(C_PTR) :: farg8 + +farg1 = io_mode +farg2 = mem_helper%swigdata +farg3 = interval +farg4 = estimate +farg5 = save_stages +farg6 = keep +farg7 = sunctx +farg8 = c_loc(check_scheme_ptr) +fresult = swigc_FSUNAdjointCheckpointScheme_Create_Fixed(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed(check_scheme, step_num, stage_num, t, yes_or_no) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +real(C_DOUBLE), intent(in) :: t +integer(C_INT), dimension(*), target, intent(inout) :: yes_or_no +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +real(C_DOUBLE) :: farg4 +type(C_PTR) :: farg5 + +farg1 = c_loc(check_scheme) +farg2 = step_num +farg3 = stage_num +farg4 = t +farg5 = c_loc(yes_or_no(1)) +fresult = swigc_FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_InsertVector_Fixed(check_scheme, step_num, stage_num, t, state) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +real(C_DOUBLE), intent(in) :: t +type(N_Vector), target, intent(inout) :: state +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +real(C_DOUBLE) :: farg4 +type(C_PTR) :: farg5 + +farg1 = c_loc(check_scheme) +farg2 = step_num +farg3 = stage_num +farg4 = t +farg5 = c_loc(state) +fresult = swigc_FSUNAdjointCheckpointScheme_InsertVector_Fixed(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed(check_scheme, step_num, stage_num, yes_or_no) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +integer(C_INT), dimension(*), target, intent(inout) :: yes_or_no +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +type(C_PTR) :: farg4 + +farg1 = c_loc(check_scheme) +farg2 = step_num +farg3 = stage_num +farg4 = c_loc(yes_or_no(1)) +fresult = swigc_FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_RemoveVector_Fixed(check_scheme, step_num, stage_num, out) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +type(C_PTR) :: out +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +type(C_PTR) :: farg4 + +farg1 = c_loc(check_scheme) +farg2 = step_num +farg3 = stage_num +farg4 = out +fresult = swigc_FSUNAdjointCheckpointScheme_RemoveVector_Fixed(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_LoadVector_Fixed(check_scheme, step_num, stage_num, peek, out, tout) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +integer(C_INT), intent(in) :: peek +type(C_PTR) :: out +real(C_DOUBLE), dimension(*), target, intent(inout) :: tout +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +integer(C_INT) :: farg4 +type(C_PTR) :: farg5 +type(C_PTR) :: farg6 + +farg1 = c_loc(check_scheme) +farg2 = step_num +farg3 = stage_num +farg4 = peek +farg5 = out +farg6 = c_loc(tout(1)) +fresult = swigc_FSUNAdjointCheckpointScheme_LoadVector_Fixed(farg1, farg2, farg3, farg4, farg5, farg6) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_Destroy_Fixed(check_scheme_ptr) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR), target, intent(inout) :: check_scheme_ptr +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = c_loc(check_scheme_ptr) +fresult = swigc_FSUNAdjointCheckpointScheme_Destroy_Fixed(farg1) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_EnableDense_Fixed(check_scheme, on_or_off) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT), intent(in) :: on_or_off +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = c_loc(check_scheme) +farg2 = on_or_off +fresult = swigc_FSUNAdjointCheckpointScheme_EnableDense_Fixed(farg1, farg2) +swig_result = fresult +end function + + +end module diff --git a/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_fixed_mod.c b/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_fixed_mod.c new file mode 100644 index 0000000000..4a81825695 --- /dev/null +++ b/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_fixed_mod.c @@ -0,0 +1,391 @@ +/* ---------------------------------------------------------------------------- + * 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-2024, 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; } + + +enum { + SWIG_MEM_OWN = 0x01, + SWIG_MEM_RVALUE = 0x02, + SWIG_MEM_CONST = 0x04 +}; + + +#define SWIG_check_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ + if (!(SWIG_CLASS_WRAPPER).cptr) { \ + SWIG_exception_impl(FUNCNAME, SWIG_TypeError, \ + "Cannot pass null " TYPENAME " (class " FNAME ") " \ + "as a reference", 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 "sunadjoint/sunadjoint_checkpointscheme_fixed.h" + + +typedef struct { + void* cptr; + int cmemflags; +} SwigClassWrapper; + + +SWIGINTERN SwigClassWrapper SwigClassWrapper_uninitialized() { + SwigClassWrapper result; + result.cptr = NULL; + result.cmemflags = 0; + return result; +} + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_Create_Fixed(int const *farg1, SwigClassWrapper const *farg2, int64_t const *farg3, int64_t const *farg4, int const *farg5, int const *farg6, void *farg7, void *farg8) { + int fresult ; + SUNDataIOMode arg1 ; + SUNMemoryHelper arg2 ; + int64_t arg3 ; + int64_t arg4 ; + int arg5 ; + int arg6 ; + SUNContext arg7 = (SUNContext) 0 ; + SUNAdjointCheckpointScheme *arg8 = (SUNAdjointCheckpointScheme *) 0 ; + SUNErrCode result; + + arg1 = (SUNDataIOMode)(*farg1); + SWIG_check_nonnull(*farg2, "SUNMemoryHelper", "SWIGTYPE_p_SUNMemoryHelper", "SUNAdjointCheckpointScheme_Create_Fixed(SUNDataIOMode,SUNMemoryHelper,int64_t,int64_t,int,int,SUNContext,SUNAdjointCheckpointScheme *)", return 0); + arg2 = *(SUNMemoryHelper *)(farg2->cptr); + arg3 = (int64_t)(*farg3); + arg4 = (int64_t)(*farg4); + arg5 = (int)(*farg5); + arg6 = (int)(*farg6); + arg7 = (SUNContext)(farg7); + arg8 = (SUNAdjointCheckpointScheme *)(farg8); + result = (SUNErrCode)SUNAdjointCheckpointScheme_Create_Fixed(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, double const *farg4, int *farg5) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + sunrealtype arg4 ; + int *arg5 = (int *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (sunrealtype)(*farg4); + arg5 = (int *)(farg5); + result = (SUNErrCode)SUNAdjointCheckpointScheme_ShouldWeSave_Fixed(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_InsertVector_Fixed(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, double const *farg4, N_Vector farg5) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + sunrealtype arg4 ; + N_Vector arg5 = (N_Vector) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (sunrealtype)(*farg4); + arg5 = (N_Vector)(farg5); + result = (SUNErrCode)SUNAdjointCheckpointScheme_InsertVector_Fixed(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, int *farg4) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + int *arg4 = (int *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (int *)(farg4); + result = (SUNErrCode)SUNAdjointCheckpointScheme_ShouldWeDelete_Fixed(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_RemoveVector_Fixed(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, void *farg4) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + N_Vector *arg4 = (N_Vector *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (N_Vector *)(farg4); + result = (SUNErrCode)SUNAdjointCheckpointScheme_RemoveVector_Fixed(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_LoadVector_Fixed(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, int const *farg4, void *farg5, double *farg6) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + int arg4 ; + N_Vector *arg5 = (N_Vector *) 0 ; + sunrealtype *arg6 = (sunrealtype *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (int)(*farg4); + arg5 = (N_Vector *)(farg5); + arg6 = (sunrealtype *)(farg6); + result = (SUNErrCode)SUNAdjointCheckpointScheme_LoadVector_Fixed(arg1,arg2,arg3,arg4,arg5,arg6); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_Destroy_Fixed(void *farg1) { + int fresult ; + SUNAdjointCheckpointScheme *arg1 = (SUNAdjointCheckpointScheme *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme *)(farg1); + result = (SUNErrCode)SUNAdjointCheckpointScheme_Destroy_Fixed(arg1); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_EnableDense_Fixed(SUNAdjointCheckpointScheme farg1, int const *farg2) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int arg2 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int)(*farg2); + result = (SUNErrCode)SUNAdjointCheckpointScheme_EnableDense_Fixed(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + + diff --git a/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_fixed_mod.f90 b/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_fixed_mod.f90 new file mode 100644 index 0000000000..6b019d2547 --- /dev/null +++ b/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_fixed_mod.f90 @@ -0,0 +1,336 @@ +! This file was automatically generated by SWIG (http://www.swig.org). +! Version 4.0.0 +! +! 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-2024, 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 +! --------------------------------------------------------------- + +module fsunadjointcheckpointscheme_fixed_mod + use, intrinsic :: ISO_C_BINDING + use fsundials_core_mod + use fsunadjointcheckpointscheme_mod + use fsundials_core_mod + implicit none + private + + ! DECLARATION CONSTRUCTS + + integer, parameter :: swig_cmem_own_bit = 0 + integer, parameter :: swig_cmem_rvalue_bit = 1 + integer, parameter :: swig_cmem_const_bit = 2 + type, bind(C) :: SwigClassWrapper + type(C_PTR), public :: cptr = C_NULL_PTR + integer(C_INT), public :: cmemflags = 0 + end type + type, public :: SWIGTYPE_p_SUNMemoryHelper + type(SwigClassWrapper), public :: swigdata + end type + public :: FSUNAdjointCheckpointScheme_Create_Fixed + public :: FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed + public :: FSUNAdjointCheckpointScheme_InsertVector_Fixed + public :: FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed + public :: FSUNAdjointCheckpointScheme_RemoveVector_Fixed + public :: FSUNAdjointCheckpointScheme_LoadVector_Fixed + public :: FSUNAdjointCheckpointScheme_Destroy_Fixed + public :: FSUNAdjointCheckpointScheme_EnableDense_Fixed + +! WRAPPER DECLARATIONS +interface +function swigc_FSUNAdjointCheckpointScheme_Create_Fixed(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_Create_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +integer(C_INT), intent(in) :: farg1 +type(SwigClassWrapper) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +integer(C_INT64_T), intent(in) :: farg4 +integer(C_INT), intent(in) :: farg5 +integer(C_INT), intent(in) :: farg6 +type(C_PTR), value :: farg7 +type(C_PTR), value :: farg8 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +real(C_DOUBLE), intent(in) :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_InsertVector_Fixed(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_InsertVector_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +real(C_DOUBLE), intent(in) :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_RemoveVector_Fixed(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_RemoveVector_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_LoadVector_Fixed(farg1, farg2, farg3, farg4, farg5, farg6) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_LoadVector_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +integer(C_INT), intent(in) :: farg4 +type(C_PTR), value :: farg5 +type(C_PTR), value :: farg6 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_Destroy_Fixed(farg1) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_Destroy_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_EnableDense_Fixed(farg1, farg2) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_EnableDense_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT), intent(in) :: farg2 +integer(C_INT) :: fresult +end function + +end interface + + +contains + ! MODULE SUBPROGRAMS +function FSUNAdjointCheckpointScheme_Create_Fixed(io_mode, mem_helper, interval, estimate, save_stages, keep, sunctx, & + check_scheme_ptr) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +integer(SUNDataIOMode), intent(in) :: io_mode +type(SWIGTYPE_p_SUNMemoryHelper), intent(in) :: mem_helper +integer(C_INT64_T), intent(in) :: interval +integer(C_INT64_T), intent(in) :: estimate +integer(C_INT), intent(in) :: save_stages +integer(C_INT), intent(in) :: keep +type(C_PTR) :: sunctx +type(C_PTR), target, intent(inout) :: check_scheme_ptr +integer(C_INT) :: fresult +integer(C_INT) :: farg1 +type(SwigClassWrapper) :: farg2 +integer(C_INT64_T) :: farg3 +integer(C_INT64_T) :: farg4 +integer(C_INT) :: farg5 +integer(C_INT) :: farg6 +type(C_PTR) :: farg7 +type(C_PTR) :: farg8 + +farg1 = io_mode +farg2 = mem_helper%swigdata +farg3 = interval +farg4 = estimate +farg5 = save_stages +farg6 = keep +farg7 = sunctx +farg8 = c_loc(check_scheme_ptr) +fresult = swigc_FSUNAdjointCheckpointScheme_Create_Fixed(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed(check_scheme, step_num, stage_num, t, yes_or_no) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +real(C_DOUBLE), intent(in) :: t +integer(C_INT), dimension(*), target, intent(inout) :: yes_or_no +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +real(C_DOUBLE) :: farg4 +type(C_PTR) :: farg5 + +farg1 = c_loc(check_scheme) +farg2 = step_num +farg3 = stage_num +farg4 = t +farg5 = c_loc(yes_or_no(1)) +fresult = swigc_FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_InsertVector_Fixed(check_scheme, step_num, stage_num, t, state) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +real(C_DOUBLE), intent(in) :: t +type(N_Vector), target, intent(inout) :: state +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +real(C_DOUBLE) :: farg4 +type(C_PTR) :: farg5 + +farg1 = c_loc(check_scheme) +farg2 = step_num +farg3 = stage_num +farg4 = t +farg5 = c_loc(state) +fresult = swigc_FSUNAdjointCheckpointScheme_InsertVector_Fixed(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed(check_scheme, step_num, stage_num, yes_or_no) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +integer(C_INT), dimension(*), target, intent(inout) :: yes_or_no +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +type(C_PTR) :: farg4 + +farg1 = c_loc(check_scheme) +farg2 = step_num +farg3 = stage_num +farg4 = c_loc(yes_or_no(1)) +fresult = swigc_FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_RemoveVector_Fixed(check_scheme, step_num, stage_num, out) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +type(C_PTR) :: out +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +type(C_PTR) :: farg4 + +farg1 = c_loc(check_scheme) +farg2 = step_num +farg3 = stage_num +farg4 = out +fresult = swigc_FSUNAdjointCheckpointScheme_RemoveVector_Fixed(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_LoadVector_Fixed(check_scheme, step_num, stage_num, peek, out, tout) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +integer(C_INT), intent(in) :: peek +type(C_PTR) :: out +real(C_DOUBLE), dimension(*), target, intent(inout) :: tout +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +integer(C_INT) :: farg4 +type(C_PTR) :: farg5 +type(C_PTR) :: farg6 + +farg1 = c_loc(check_scheme) +farg2 = step_num +farg3 = stage_num +farg4 = peek +farg5 = out +farg6 = c_loc(tout(1)) +fresult = swigc_FSUNAdjointCheckpointScheme_LoadVector_Fixed(farg1, farg2, farg3, farg4, farg5, farg6) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_Destroy_Fixed(check_scheme_ptr) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR), target, intent(inout) :: check_scheme_ptr +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = c_loc(check_scheme_ptr) +fresult = swigc_FSUNAdjointCheckpointScheme_Destroy_Fixed(farg1) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_EnableDense_Fixed(check_scheme, on_or_off) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT), intent(in) :: on_or_off +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = c_loc(check_scheme) +farg2 = on_or_off +fresult = swigc_FSUNAdjointCheckpointScheme_EnableDense_Fixed(farg1, farg2) +swig_result = fresult +end function + + +end module diff --git a/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_mod.c b/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_mod.c new file mode 100644 index 0000000000..c1806a1d40 --- /dev/null +++ b/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_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-2024, 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 "sunadjoint/sunadjoint_checkpointscheme.h" + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_NewEmpty(void *farg1, void *farg2) { + int fresult ; + SUNContext arg1 = (SUNContext) 0 ; + SUNAdjointCheckpointScheme *arg2 = (SUNAdjointCheckpointScheme *) 0 ; + SUNErrCode result; + + arg1 = (SUNContext)(farg1); + arg2 = (SUNAdjointCheckpointScheme *)(farg2); + result = (SUNErrCode)SUNAdjointCheckpointScheme_NewEmpty(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_ShouldWeSave(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, double const *farg4, int *farg5) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + sunrealtype arg4 ; + int *arg5 = (int *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (sunrealtype)(*farg4); + arg5 = (int *)(farg5); + result = (SUNErrCode)SUNAdjointCheckpointScheme_ShouldWeSave(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_ShouldWeDelete(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, int *farg4) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + int *arg4 = (int *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (int *)(farg4); + result = (SUNErrCode)SUNAdjointCheckpointScheme_ShouldWeDelete(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_InsertVector(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, double const *farg4, N_Vector farg5) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + sunrealtype arg4 ; + N_Vector arg5 = (N_Vector) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (sunrealtype)(*farg4); + arg5 = (N_Vector)(farg5); + result = (SUNErrCode)SUNAdjointCheckpointScheme_InsertVector(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_LoadVector(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, int const *farg4, void *farg5, double *farg6) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + int arg4 ; + N_Vector *arg5 = (N_Vector *) 0 ; + sunrealtype *arg6 = (sunrealtype *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (int)(*farg4); + arg5 = (N_Vector *)(farg5); + arg6 = (sunrealtype *)(farg6); + result = (SUNErrCode)SUNAdjointCheckpointScheme_LoadVector(arg1,arg2,arg3,arg4,arg5,arg6); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_RemoveVector(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, void *farg4) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + N_Vector *arg4 = (N_Vector *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (N_Vector *)(farg4); + result = (SUNErrCode)SUNAdjointCheckpointScheme_RemoveVector(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_Destroy(void *farg1) { + int fresult ; + SUNAdjointCheckpointScheme *arg1 = (SUNAdjointCheckpointScheme *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme *)(farg1); + result = (SUNErrCode)SUNAdjointCheckpointScheme_Destroy(arg1); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_EnableDense(SUNAdjointCheckpointScheme farg1, int const *farg2) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int arg2 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int)(*farg2); + result = (SUNErrCode)SUNAdjointCheckpointScheme_EnableDense(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + + diff --git a/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_mod.f90 b/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_mod.f90 new file mode 100644 index 0000000000..5a9825052c --- /dev/null +++ b/src/sunadjoint/fmod_int32/fsunadjointcheckpointscheme_mod.f90 @@ -0,0 +1,313 @@ +! This file was automatically generated by SWIG (http://www.swig.org). +! Version 4.0.0 +! +! 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-2024, 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 +! --------------------------------------------------------------- + +module fsunadjointcheckpointscheme_mod + use, intrinsic :: ISO_C_BINDING + use fsundials_core_mod + implicit none + private + + ! DECLARATION CONSTRUCTS + ! struct struct SUNAdjointCheckpointScheme_Ops_ + type, bind(C), public :: SUNAdjointCheckpointScheme_Ops + type(C_FUNPTR), public :: shouldWeSave + type(C_FUNPTR), public :: shouldWeDelete + type(C_FUNPTR), public :: insertVector + type(C_FUNPTR), public :: loadVector + type(C_FUNPTR), public :: removeVector + type(C_FUNPTR), public :: destroy + type(C_FUNPTR), public :: enableDense + end type SUNAdjointCheckpointScheme_Ops + ! struct struct SUNAdjointCheckpointScheme_ + type, bind(C), public :: SUNAdjointCheckpointScheme + type(C_PTR), public :: ops + type(C_PTR), public :: content + type(C_PTR), public :: sunctx + end type SUNAdjointCheckpointScheme + public :: FSUNAdjointCheckpointScheme_NewEmpty + public :: FSUNAdjointCheckpointScheme_ShouldWeSave + public :: FSUNAdjointCheckpointScheme_ShouldWeDelete + public :: FSUNAdjointCheckpointScheme_InsertVector + public :: FSUNAdjointCheckpointScheme_LoadVector + public :: FSUNAdjointCheckpointScheme_RemoveVector + public :: FSUNAdjointCheckpointScheme_Destroy + public :: FSUNAdjointCheckpointScheme_EnableDense + +! WRAPPER DECLARATIONS +interface +function swigc_FSUNAdjointCheckpointScheme_NewEmpty(farg1, farg2) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_NewEmpty") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_ShouldWeSave(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_ShouldWeSave") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +real(C_DOUBLE), intent(in) :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_ShouldWeDelete(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_ShouldWeDelete") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_InsertVector(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_InsertVector") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +real(C_DOUBLE), intent(in) :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_LoadVector(farg1, farg2, farg3, farg4, farg5, farg6) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_LoadVector") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +integer(C_INT), intent(in) :: farg4 +type(C_PTR), value :: farg5 +type(C_PTR), value :: farg6 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_RemoveVector(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_RemoveVector") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_Destroy(farg1) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_Destroy") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_EnableDense(farg1, farg2) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_EnableDense") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT), intent(in) :: farg2 +integer(C_INT) :: fresult +end function + +end interface + + +contains + ! MODULE SUBPROGRAMS +function FSUNAdjointCheckpointScheme_NewEmpty(sunctx, arg1) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: sunctx +type(C_PTR), target, intent(inout) :: arg1 +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = sunctx +farg2 = c_loc(arg1) +fresult = swigc_FSUNAdjointCheckpointScheme_NewEmpty(farg1, farg2) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_ShouldWeSave(arg0, step_num, stage_num, t, yes_or_no) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: arg0 +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +real(C_DOUBLE), intent(in) :: t +integer(C_INT), dimension(*), target, intent(inout) :: yes_or_no +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +real(C_DOUBLE) :: farg4 +type(C_PTR) :: farg5 + +farg1 = c_loc(arg0) +farg2 = step_num +farg3 = stage_num +farg4 = t +farg5 = c_loc(yes_or_no(1)) +fresult = swigc_FSUNAdjointCheckpointScheme_ShouldWeSave(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_ShouldWeDelete(arg0, step_num, stage_num, yes_or_no) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: arg0 +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +integer(C_INT), dimension(*), target, intent(inout) :: yes_or_no +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +type(C_PTR) :: farg4 + +farg1 = c_loc(arg0) +farg2 = step_num +farg3 = stage_num +farg4 = c_loc(yes_or_no(1)) +fresult = swigc_FSUNAdjointCheckpointScheme_ShouldWeDelete(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_InsertVector(arg0, step_num, stage_num, t, state) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: arg0 +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +real(C_DOUBLE), intent(in) :: t +type(N_Vector), target, intent(inout) :: state +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +real(C_DOUBLE) :: farg4 +type(C_PTR) :: farg5 + +farg1 = c_loc(arg0) +farg2 = step_num +farg3 = stage_num +farg4 = t +farg5 = c_loc(state) +fresult = swigc_FSUNAdjointCheckpointScheme_InsertVector(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_LoadVector(arg0, step_num, stage_num, peek, out, tout) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: arg0 +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +integer(C_INT), intent(in) :: peek +type(C_PTR) :: out +real(C_DOUBLE), dimension(*), target, intent(inout) :: tout +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +integer(C_INT) :: farg4 +type(C_PTR) :: farg5 +type(C_PTR) :: farg6 + +farg1 = c_loc(arg0) +farg2 = step_num +farg3 = stage_num +farg4 = peek +farg5 = out +farg6 = c_loc(tout(1)) +fresult = swigc_FSUNAdjointCheckpointScheme_LoadVector(farg1, farg2, farg3, farg4, farg5, farg6) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_RemoveVector(arg0, step_num, stage_num, out) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: arg0 +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +type(C_PTR) :: out +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +type(C_PTR) :: farg4 + +farg1 = c_loc(arg0) +farg2 = step_num +farg3 = stage_num +farg4 = out +fresult = swigc_FSUNAdjointCheckpointScheme_RemoveVector(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_Destroy(arg0) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR), target, intent(inout) :: arg0 +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = c_loc(arg0) +fresult = swigc_FSUNAdjointCheckpointScheme_Destroy(farg1) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_EnableDense(arg0, on_or_off) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: arg0 +integer(C_INT), intent(in) :: on_or_off +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = c_loc(arg0) +farg2 = on_or_off +fresult = swigc_FSUNAdjointCheckpointScheme_EnableDense(farg1, farg2) +swig_result = fresult +end function + + +end module diff --git a/src/sunadjoint/fmod_int32/fsunadjointstepper_mod.c b/src/sunadjoint/fmod_int32/fsunadjointstepper_mod.c new file mode 100644 index 0000000000..27ffa9c8dd --- /dev/null +++ b/src/sunadjoint/fmod_int32/fsunadjointstepper_mod.c @@ -0,0 +1,1151 @@ +/* ---------------------------------------------------------------------------- + * 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-2024, 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; } + + +enum { + SWIG_MEM_OWN = 0x01, + SWIG_MEM_RVALUE = 0x02, + SWIG_MEM_CONST = 0x04 +}; + + +#define SWIG_check_mutable(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ + if ((SWIG_CLASS_WRAPPER).cmemflags & SWIG_MEM_CONST) { \ + SWIG_exception_impl(FUNCNAME, SWIG_TypeError, \ + "Cannot pass const " TYPENAME " (class " FNAME ") " \ + "as a mutable reference", \ + RETURNNULL); \ + } + + +#define SWIG_check_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ + if (!(SWIG_CLASS_WRAPPER).cptr) { \ + SWIG_exception_impl(FUNCNAME, SWIG_TypeError, \ + "Cannot pass null " TYPENAME " (class " FNAME ") " \ + "as a reference", RETURNNULL); \ + } + + +#define SWIG_check_mutable_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ + SWIG_check_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL); \ + SWIG_check_mutable(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, 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 "sunadjoint/sunadjoint_stepper.h" + + +typedef struct { + void* cptr; + int cmemflags; +} SwigClassWrapper; + + +SWIGINTERN SwigClassWrapper SwigClassWrapper_uninitialized() { + SwigClassWrapper result; + result.cptr = NULL; + result.cmemflags = 0; + return result; +} + + +#include +#ifdef _MSC_VER +# ifndef strtoull +# define strtoull _strtoui64 +# endif +# ifndef strtoll +# define strtoll _strtoi64 +# endif +#endif + + +#include + + +SWIGINTERN void SWIG_assign(SwigClassWrapper* self, SwigClassWrapper other) { + if (self->cptr == NULL) { + /* LHS is unassigned */ + if (other.cmemflags & SWIG_MEM_RVALUE) { + /* Capture pointer from RHS, clear 'moving' flag */ + self->cptr = other.cptr; + self->cmemflags = other.cmemflags & (~SWIG_MEM_RVALUE); + } else { + /* Become a reference to the other object */ + self->cptr = other.cptr; + self->cmemflags = other.cmemflags & (~SWIG_MEM_OWN); + } + } else if (other.cptr == NULL) { + /* Replace LHS with a null pointer */ + free(self->cptr); + *self = SwigClassWrapper_uninitialized(); + } else { + if (self->cmemflags & SWIG_MEM_OWN) { + free(self->cptr); + } + self->cptr = other.cptr; + if (other.cmemflags & SWIG_MEM_RVALUE) { + /* Capture RHS */ + self->cmemflags = other.cmemflags & ~SWIG_MEM_RVALUE; + } else { + /* Point to RHS */ + self->cmemflags = other.cmemflags & ~SWIG_MEM_OWN; + } + } +} + +SWIGEXPORT void _wrap_SUNAdjointStepper__adj_sunstepper_set(SwigClassWrapper const *farg1, void *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNStepper arg2 = (SUNStepper) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::adj_sunstepper", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNStepper)(farg2); + if (arg1) (arg1)->adj_sunstepper = arg2; +} + + +SWIGEXPORT void * _wrap_SUNAdjointStepper__adj_sunstepper_get(SwigClassWrapper const *farg1) { + void * fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNStepper result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::adj_sunstepper", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNStepper) ((arg1)->adj_sunstepper); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__fwd_sunstepper_set(SwigClassWrapper const *farg1, void *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNStepper arg2 = (SUNStepper) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::fwd_sunstepper", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNStepper)(farg2); + if (arg1) (arg1)->fwd_sunstepper = arg2; +} + + +SWIGEXPORT void * _wrap_SUNAdjointStepper__fwd_sunstepper_get(SwigClassWrapper const *farg1) { + void * fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNStepper result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::fwd_sunstepper", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNStepper) ((arg1)->fwd_sunstepper); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__checkpoint_scheme_set(SwigClassWrapper const *farg1, SUNAdjointCheckpointScheme farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNAdjointCheckpointScheme arg2 = (SUNAdjointCheckpointScheme) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::checkpoint_scheme", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNAdjointCheckpointScheme)(farg2); + if (arg1) (arg1)->checkpoint_scheme = arg2; +} + + +SWIGEXPORT SUNAdjointCheckpointScheme _wrap_SUNAdjointStepper__checkpoint_scheme_get(SwigClassWrapper const *farg1) { + SUNAdjointCheckpointScheme fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNAdjointCheckpointScheme result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::checkpoint_scheme", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNAdjointCheckpointScheme) ((arg1)->checkpoint_scheme); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__tf_set(SwigClassWrapper const *farg1, double const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + sunrealtype arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::tf", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (sunrealtype)(*farg2); + if (arg1) (arg1)->tf = arg2; +} + + +SWIGEXPORT double _wrap_SUNAdjointStepper__tf_get(SwigClassWrapper const *farg1) { + double fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + sunrealtype result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::tf", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (sunrealtype) ((arg1)->tf); + fresult = (sunrealtype)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__step_idx_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::step_idx", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->step_idx = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__step_idx_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::step_idx", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->step_idx); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__final_step_idx_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::final_step_idx", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->final_step_idx = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__final_step_idx_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::final_step_idx", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->final_step_idx); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__last_flag_set(SwigClassWrapper const *farg1, int const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::last_flag", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int)(*farg2); + if (arg1) (arg1)->last_flag = arg2; +} + + +SWIGEXPORT int _wrap_SUNAdjointStepper__last_flag_get(SwigClassWrapper const *farg1) { + int fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::last_flag", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (int) ((arg1)->last_flag); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__Jac_set(SwigClassWrapper const *farg1, SUNMatrix farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::Jac", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNMatrix)(farg2); + if (arg1) (arg1)->Jac = arg2; +} + + +SWIGEXPORT SUNMatrix _wrap_SUNAdjointStepper__Jac_get(SwigClassWrapper const *farg1) { + SUNMatrix fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNMatrix result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::Jac", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNMatrix) ((arg1)->Jac); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__JacP_set(SwigClassWrapper const *farg1, SUNMatrix farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JacP", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNMatrix)(farg2); + if (arg1) (arg1)->JacP = arg2; +} + + +SWIGEXPORT SUNMatrix _wrap_SUNAdjointStepper__JacP_get(SwigClassWrapper const *farg1) { + SUNMatrix fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNMatrix result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JacP", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNMatrix) ((arg1)->JacP); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__JacFn_set(SwigClassWrapper const *farg1, SUNRhsJacFn farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacFn arg2 = (SUNRhsJacFn) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JacFn", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNRhsJacFn)(farg2); + if (arg1) (arg1)->JacFn = arg2; +} + + +SWIGEXPORT SUNRhsJacFn _wrap_SUNAdjointStepper__JacFn_get(SwigClassWrapper const *farg1) { + SUNRhsJacFn fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacFn result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JacFn", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNRhsJacFn) ((arg1)->JacFn); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__JacPFn_set(SwigClassWrapper const *farg1, SUNRhsJacFn farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacFn arg2 = (SUNRhsJacFn) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JacPFn", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNRhsJacFn)(farg2); + if (arg1) (arg1)->JacPFn = arg2; +} + + +SWIGEXPORT SUNRhsJacFn _wrap_SUNAdjointStepper__JacPFn_get(SwigClassWrapper const *farg1) { + SUNRhsJacFn fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacFn result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JacPFn", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNRhsJacFn) ((arg1)->JacPFn); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__JvpFn_set(SwigClassWrapper const *farg1, SUNRhsJacTimesFn farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacTimesFn arg2 = (SUNRhsJacTimesFn) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JvpFn", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNRhsJacTimesFn)(farg2); + if (arg1) (arg1)->JvpFn = arg2; +} + + +SWIGEXPORT SUNRhsJacTimesFn _wrap_SUNAdjointStepper__JvpFn_get(SwigClassWrapper const *farg1) { + SUNRhsJacTimesFn fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacTimesFn result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JvpFn", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNRhsJacTimesFn) ((arg1)->JvpFn); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__JPvpFn_set(SwigClassWrapper const *farg1, SUNRhsJacTimesFn farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacTimesFn arg2 = (SUNRhsJacTimesFn) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JPvpFn", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNRhsJacTimesFn)(farg2); + if (arg1) (arg1)->JPvpFn = arg2; +} + + +SWIGEXPORT SUNRhsJacTimesFn _wrap_SUNAdjointStepper__JPvpFn_get(SwigClassWrapper const *farg1) { + SUNRhsJacTimesFn fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacTimesFn result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JPvpFn", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNRhsJacTimesFn) ((arg1)->JPvpFn); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__vJpFn_set(SwigClassWrapper const *farg1, SUNRhsJacTimesFn farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacTimesFn arg2 = (SUNRhsJacTimesFn) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::vJpFn", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNRhsJacTimesFn)(farg2); + if (arg1) (arg1)->vJpFn = arg2; +} + + +SWIGEXPORT SUNRhsJacTimesFn _wrap_SUNAdjointStepper__vJpFn_get(SwigClassWrapper const *farg1) { + SUNRhsJacTimesFn fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacTimesFn result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::vJpFn", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNRhsJacTimesFn) ((arg1)->vJpFn); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__vJPpFn_set(SwigClassWrapper const *farg1, SUNRhsJacTimesFn farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacTimesFn arg2 = (SUNRhsJacTimesFn) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::vJPpFn", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNRhsJacTimesFn)(farg2); + if (arg1) (arg1)->vJPpFn = arg2; +} + + +SWIGEXPORT SUNRhsJacTimesFn _wrap_SUNAdjointStepper__vJPpFn_get(SwigClassWrapper const *farg1) { + SUNRhsJacTimesFn fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacTimesFn result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::vJPpFn", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNRhsJacTimesFn) ((arg1)->vJPpFn); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__nst_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::nst", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->nst = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__nst_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::nst", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->nst); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__njeval_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::njeval", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->njeval = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__njeval_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::njeval", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->njeval); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__njpeval_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::njpeval", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->njpeval = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__njpeval_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::njpeval", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->njpeval); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__njtimesv_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::njtimesv", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->njtimesv = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__njtimesv_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::njtimesv", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->njtimesv); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__njptimesv_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::njptimesv", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->njptimesv = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__njptimesv_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::njptimesv", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->njptimesv); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__nvtimesj_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::nvtimesj", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->nvtimesj = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__nvtimesj_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::nvtimesj", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->nvtimesj); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__nvtimesjp_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::nvtimesjp", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->nvtimesjp = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__nvtimesjp_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::nvtimesjp", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->nvtimesjp); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__nrecompute_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::nrecompute", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->nrecompute = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__nrecompute_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::nrecompute", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->nrecompute); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__user_data_set(SwigClassWrapper const *farg1, void *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + void *arg2 = (void *) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::user_data", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (void *)(farg2); + if (arg1) (arg1)->user_data = arg2; +} + + +SWIGEXPORT void * _wrap_SUNAdjointStepper__user_data_get(SwigClassWrapper const *farg1) { + void * fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + void *result = 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::user_data", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (void *) ((arg1)->user_data); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__content_set(SwigClassWrapper const *farg1, void *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + void *arg2 = (void *) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::content", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (void *)(farg2); + if (arg1) (arg1)->content = arg2; +} + + +SWIGEXPORT void * _wrap_SUNAdjointStepper__content_get(SwigClassWrapper const *farg1) { + void * fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + void *result = 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::content", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (void *) ((arg1)->content); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__sunctx_set(SwigClassWrapper const *farg1, void *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNContext arg2 = (SUNContext) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::sunctx", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNContext)(farg2); + if (arg1) (arg1)->sunctx = arg2; +} + + +SWIGEXPORT void * _wrap_SUNAdjointStepper__sunctx_get(SwigClassWrapper const *farg1) { + void * fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNContext result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::sunctx", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNContext) ((arg1)->sunctx); + fresult = result; + return fresult; +} + + +SWIGEXPORT SwigClassWrapper _wrap_new_SUNAdjointStepper_() { + SwigClassWrapper fresult ; + struct SUNAdjointStepper_ *result = 0 ; + + result = (struct SUNAdjointStepper_ *)calloc(1, sizeof(struct SUNAdjointStepper_)); + fresult.cptr = result; + fresult.cmemflags = SWIG_MEM_RVALUE | (1 ? SWIG_MEM_OWN : 0); + return fresult; +} + + +SWIGEXPORT void _wrap_delete_SUNAdjointStepper_(SwigClassWrapper *farg1) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + + SWIG_check_mutable(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::~SUNAdjointStepper_()", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + free((char *) arg1); +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__op_assign__(SwigClassWrapper *farg1, SwigClassWrapper const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + struct SUNAdjointStepper_ *arg2 = 0 ; + + (void)sizeof(arg1); + (void)sizeof(arg2); + SWIG_assign(farg1, *farg2); + +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_Create(void *farg1, void *farg2, int64_t const *farg3, N_Vector farg4, double const *farg5, SUNAdjointCheckpointScheme farg6, void *farg7, void *farg8) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + SUNStepper arg2 = (SUNStepper) 0 ; + int64_t arg3 ; + N_Vector arg4 = (N_Vector) 0 ; + sunrealtype arg5 ; + SUNAdjointCheckpointScheme arg6 = (SUNAdjointCheckpointScheme) 0 ; + SUNContext arg7 = (SUNContext) 0 ; + SUNAdjointStepper *arg8 = (SUNAdjointStepper *) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (SUNStepper)(farg2); + arg3 = (int64_t)(*farg3); + arg4 = (N_Vector)(farg4); + arg5 = (sunrealtype)(*farg5); + arg6 = (SUNAdjointCheckpointScheme)(farg6); + arg7 = (SUNContext)(farg7); + arg8 = (SUNAdjointStepper *)(farg8); + result = (SUNErrCode)SUNAdjointStepper_Create(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_ReInit(void *farg1, N_Vector farg2, double const *farg3, N_Vector farg4, double const *farg5) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + sunrealtype arg3 ; + N_Vector arg4 = (N_Vector) 0 ; + sunrealtype arg5 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (sunrealtype)(*farg3); + arg4 = (N_Vector)(farg4); + arg5 = (sunrealtype)(*farg5); + result = (SUNErrCode)SUNAdjointStepper_ReInit(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_Evolve(void *farg1, double const *farg2, N_Vector farg3, double *farg4) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + sunrealtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + sunrealtype *arg4 = (sunrealtype *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (sunrealtype)(*farg2); + arg3 = (N_Vector)(farg3); + arg4 = (sunrealtype *)(farg4); + result = (SUNErrCode)SUNAdjointStepper_Evolve(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_OneStep(void *farg1, double const *farg2, N_Vector farg3, double *farg4) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + sunrealtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + sunrealtype *arg4 = (sunrealtype *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (sunrealtype)(*farg2); + arg3 = (N_Vector)(farg3); + arg4 = (sunrealtype *)(farg4); + result = (SUNErrCode)SUNAdjointStepper_OneStep(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_RecomputeFwd(void *farg1, int64_t const *farg2, double const *farg3, double const *farg4, N_Vector farg5) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + int64_t arg2 ; + sunrealtype arg3 ; + sunrealtype arg4 ; + N_Vector arg5 = (N_Vector) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (sunrealtype)(*farg3); + arg4 = (sunrealtype)(*farg4); + arg5 = (N_Vector)(farg5); + result = (SUNErrCode)SUNAdjointStepper_RecomputeFwd(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_SetJacFn(void *farg1, SUNRhsJacFn farg2, SUNMatrix farg3, SUNRhsJacFn farg4, SUNMatrix farg5) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + SUNRhsJacFn arg2 = (SUNRhsJacFn) 0 ; + SUNMatrix arg3 = (SUNMatrix) 0 ; + SUNRhsJacFn arg4 = (SUNRhsJacFn) 0 ; + SUNMatrix arg5 = (SUNMatrix) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (SUNRhsJacFn)(farg2); + arg3 = (SUNMatrix)(farg3); + arg4 = (SUNRhsJacFn)(farg4); + arg5 = (SUNMatrix)(farg5); + result = (SUNErrCode)SUNAdjointStepper_SetJacFn(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_SetJacTimesVecFn(void *farg1, SUNRhsJacTimesFn farg2, SUNRhsJacTimesFn farg3) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + SUNRhsJacTimesFn arg2 = (SUNRhsJacTimesFn) 0 ; + SUNRhsJacTimesFn arg3 = (SUNRhsJacTimesFn) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (SUNRhsJacTimesFn)(farg2); + arg3 = (SUNRhsJacTimesFn)(farg3); + result = (SUNErrCode)SUNAdjointStepper_SetJacTimesVecFn(arg1,arg2,arg3); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_SetVecTimesJacFn(void *farg1, SUNRhsJacTimesFn farg2, SUNRhsJacTimesFn farg3) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + SUNRhsJacTimesFn arg2 = (SUNRhsJacTimesFn) 0 ; + SUNRhsJacTimesFn arg3 = (SUNRhsJacTimesFn) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (SUNRhsJacTimesFn)(farg2); + arg3 = (SUNRhsJacTimesFn)(farg3); + result = (SUNErrCode)SUNAdjointStepper_SetVecTimesJacFn(arg1,arg2,arg3); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_SetUserData(void *farg1, void *farg2) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + void *arg2 = (void *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (void *)(farg2); + result = (SUNErrCode)SUNAdjointStepper_SetUserData(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_PrintAllStats(void *farg1, void *farg2, int const *farg3) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + FILE *arg2 = (FILE *) 0 ; + SUNOutputFormat arg3 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (FILE *)(farg2); + arg3 = (SUNOutputFormat)(*farg3); + result = (SUNErrCode)SUNAdjointStepper_PrintAllStats(arg1,arg2,arg3); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_Destroy(void *farg1) { + int fresult ; + SUNAdjointStepper *arg1 = (SUNAdjointStepper *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper *)(farg1); + result = (SUNErrCode)SUNAdjointStepper_Destroy(arg1); + fresult = (SUNErrCode)(result); + return fresult; +} + + + diff --git a/src/sunadjoint/fmod_int32/fsunadjointstepper_mod.f90 b/src/sunadjoint/fmod_int32/fsunadjointstepper_mod.f90 new file mode 100644 index 0000000000..4001e38336 --- /dev/null +++ b/src/sunadjoint/fmod_int32/fsunadjointstepper_mod.f90 @@ -0,0 +1,1633 @@ +! This file was automatically generated by SWIG (http://www.swig.org). +! Version 4.0.0 +! +! 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-2024, 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 +! --------------------------------------------------------------- + +module fsunadjointstepper_mod + use, intrinsic :: ISO_C_BINDING + use fsundials_core_mod + use fsunadjointcheckpointscheme_mod + use fsundials_core_mod + implicit none + private + + ! DECLARATION CONSTRUCTS + + integer, parameter :: swig_cmem_own_bit = 0 + integer, parameter :: swig_cmem_rvalue_bit = 1 + integer, parameter :: swig_cmem_const_bit = 2 + type, bind(C) :: SwigClassWrapper + type(C_PTR), public :: cptr = C_NULL_PTR + integer(C_INT), public :: cmemflags = 0 + end type + ! struct struct SUNAdjointStepper_ + type, public :: SUNAdjointStepper_ + type(SwigClassWrapper), public :: swigdata + contains + procedure :: set_adj_sunstepper => swigf_SUNAdjointStepper__adj_sunstepper_set + procedure :: get_adj_sunstepper => swigf_SUNAdjointStepper__adj_sunstepper_get + procedure :: set_fwd_sunstepper => swigf_SUNAdjointStepper__fwd_sunstepper_set + procedure :: get_fwd_sunstepper => swigf_SUNAdjointStepper__fwd_sunstepper_get + procedure :: set_checkpoint_scheme => swigf_SUNAdjointStepper__checkpoint_scheme_set + procedure :: get_checkpoint_scheme => swigf_SUNAdjointStepper__checkpoint_scheme_get + procedure :: set_tf => swigf_SUNAdjointStepper__tf_set + procedure :: get_tf => swigf_SUNAdjointStepper__tf_get + procedure :: set_step_idx => swigf_SUNAdjointStepper__step_idx_set + procedure :: get_step_idx => swigf_SUNAdjointStepper__step_idx_get + procedure :: set_final_step_idx => swigf_SUNAdjointStepper__final_step_idx_set + procedure :: get_final_step_idx => swigf_SUNAdjointStepper__final_step_idx_get + procedure :: set_last_flag => swigf_SUNAdjointStepper__last_flag_set + procedure :: get_last_flag => swigf_SUNAdjointStepper__last_flag_get + procedure :: set_Jac => swigf_SUNAdjointStepper__Jac_set + procedure :: get_Jac => swigf_SUNAdjointStepper__Jac_get + procedure :: set_JacP => swigf_SUNAdjointStepper__JacP_set + procedure :: get_JacP => swigf_SUNAdjointStepper__JacP_get + procedure :: set_JacFn => swigf_SUNAdjointStepper__JacFn_set + procedure :: get_JacFn => swigf_SUNAdjointStepper__JacFn_get + procedure :: set_JacPFn => swigf_SUNAdjointStepper__JacPFn_set + procedure :: get_JacPFn => swigf_SUNAdjointStepper__JacPFn_get + procedure :: set_JvpFn => swigf_SUNAdjointStepper__JvpFn_set + procedure :: get_JvpFn => swigf_SUNAdjointStepper__JvpFn_get + procedure :: set_JPvpFn => swigf_SUNAdjointStepper__JPvpFn_set + procedure :: get_JPvpFn => swigf_SUNAdjointStepper__JPvpFn_get + procedure :: set_vJpFn => swigf_SUNAdjointStepper__vJpFn_set + procedure :: get_vJpFn => swigf_SUNAdjointStepper__vJpFn_get + procedure :: set_vJPpFn => swigf_SUNAdjointStepper__vJPpFn_set + procedure :: get_vJPpFn => swigf_SUNAdjointStepper__vJPpFn_get + procedure :: set_nst => swigf_SUNAdjointStepper__nst_set + procedure :: get_nst => swigf_SUNAdjointStepper__nst_get + procedure :: set_njeval => swigf_SUNAdjointStepper__njeval_set + procedure :: get_njeval => swigf_SUNAdjointStepper__njeval_get + procedure :: set_njpeval => swigf_SUNAdjointStepper__njpeval_set + procedure :: get_njpeval => swigf_SUNAdjointStepper__njpeval_get + procedure :: set_njtimesv => swigf_SUNAdjointStepper__njtimesv_set + procedure :: get_njtimesv => swigf_SUNAdjointStepper__njtimesv_get + procedure :: set_njptimesv => swigf_SUNAdjointStepper__njptimesv_set + procedure :: get_njptimesv => swigf_SUNAdjointStepper__njptimesv_get + procedure :: set_nvtimesj => swigf_SUNAdjointStepper__nvtimesj_set + procedure :: get_nvtimesj => swigf_SUNAdjointStepper__nvtimesj_get + procedure :: set_nvtimesjp => swigf_SUNAdjointStepper__nvtimesjp_set + procedure :: get_nvtimesjp => swigf_SUNAdjointStepper__nvtimesjp_get + procedure :: set_nrecompute => swigf_SUNAdjointStepper__nrecompute_set + procedure :: get_nrecompute => swigf_SUNAdjointStepper__nrecompute_get + procedure :: set_user_data => swigf_SUNAdjointStepper__user_data_set + procedure :: get_user_data => swigf_SUNAdjointStepper__user_data_get + procedure :: set_content => swigf_SUNAdjointStepper__content_set + procedure :: get_content => swigf_SUNAdjointStepper__content_get + procedure :: set_sunctx => swigf_SUNAdjointStepper__sunctx_set + procedure :: get_sunctx => swigf_SUNAdjointStepper__sunctx_get + procedure :: release => swigf_release_SUNAdjointStepper_ + procedure, private :: swigf_SUNAdjointStepper__op_assign__ + generic :: assignment(=) => swigf_SUNAdjointStepper__op_assign__ + end type SUNAdjointStepper_ + interface SUNAdjointStepper_ + module procedure swigf_create_SUNAdjointStepper_ + end interface + public :: FSUNAdjointStepper_Create + public :: FSUNAdjointStepper_ReInit + public :: FSUNAdjointStepper_Evolve + public :: FSUNAdjointStepper_OneStep + public :: FSUNAdjointStepper_RecomputeFwd + public :: FSUNAdjointStepper_SetJacFn + public :: FSUNAdjointStepper_SetJacTimesVecFn + public :: FSUNAdjointStepper_SetVecTimesJacFn + public :: FSUNAdjointStepper_SetUserData + public :: FSUNAdjointStepper_PrintAllStats + public :: FSUNAdjointStepper_Destroy + +! WRAPPER DECLARATIONS +interface +subroutine swigc_SUNAdjointStepper__adj_sunstepper_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__adj_sunstepper_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__adj_sunstepper_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__adj_sunstepper_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__fwd_sunstepper_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__fwd_sunstepper_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__fwd_sunstepper_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__fwd_sunstepper_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__checkpoint_scheme_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__checkpoint_scheme_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__checkpoint_scheme_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__checkpoint_scheme_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__tf_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__tf_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__tf_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__tf_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +real(C_DOUBLE) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__step_idx_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__step_idx_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__step_idx_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__step_idx_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__final_step_idx_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__final_step_idx_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__final_step_idx_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__final_step_idx_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__last_flag_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__last_flag_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__last_flag_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__last_flag_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__Jac_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__Jac_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__Jac_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__Jac_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__JacP_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__JacP_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__JacP_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__JacP_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__JacFn_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__JacFn_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__JacFn_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__JacFn_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__JacPFn_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__JacPFn_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__JacPFn_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__JacPFn_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__JvpFn_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__JvpFn_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__JvpFn_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__JvpFn_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__JPvpFn_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__JPvpFn_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__JPvpFn_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__JPvpFn_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__vJpFn_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__vJpFn_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__vJpFn_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__vJpFn_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__vJPpFn_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__vJPpFn_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__vJPpFn_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__vJPpFn_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__nst_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__nst_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__nst_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__nst_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__njeval_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__njeval_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__njeval_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__njeval_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__njpeval_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__njpeval_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__njpeval_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__njpeval_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__njtimesv_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__njtimesv_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__njtimesv_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__njtimesv_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__njptimesv_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__njptimesv_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__njptimesv_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__njptimesv_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__nvtimesj_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__nvtimesj_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__nvtimesj_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__nvtimesj_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__nvtimesjp_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__nvtimesjp_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__nvtimesjp_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__nvtimesjp_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__nrecompute_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__nrecompute_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__nrecompute_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__nrecompute_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__user_data_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__user_data_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__user_data_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__user_data_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__content_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__content_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__content_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__content_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__sunctx_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__sunctx_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__sunctx_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__sunctx_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +function swigc_new_SUNAdjointStepper_() & +bind(C, name="_wrap_new_SUNAdjointStepper_") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: fresult +end function + +subroutine swigc_delete_SUNAdjointStepper_(farg1) & +bind(C, name="_wrap_delete_SUNAdjointStepper_") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper), intent(inout) :: farg1 +end subroutine + +subroutine swigc_SUNAdjointStepper__op_assign__(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__op_assign__") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper), intent(inout) :: farg1 +type(SwigClassWrapper) :: farg2 +end subroutine + +function swigc_FSUNAdjointStepper_Create(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8) & +bind(C, name="_wrap_FSUNAdjointStepper_Create") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +type(C_PTR), value :: farg4 +real(C_DOUBLE), intent(in) :: farg5 +type(C_PTR), value :: farg6 +type(C_PTR), value :: farg7 +type(C_PTR), value :: farg8 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_ReInit(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNAdjointStepper_ReInit") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +real(C_DOUBLE), intent(in) :: farg3 +type(C_PTR), value :: farg4 +real(C_DOUBLE), intent(in) :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_Evolve(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNAdjointStepper_Evolve") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_OneStep(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNAdjointStepper_OneStep") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_RecomputeFwd(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNAdjointStepper_RecomputeFwd") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +real(C_DOUBLE), intent(in) :: farg3 +real(C_DOUBLE), intent(in) :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_SetJacFn(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNAdjointStepper_SetJacFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +type(C_PTR), value :: farg3 +type(C_FUNPTR), value :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_SetJacTimesVecFn(farg1, farg2, farg3) & +bind(C, name="_wrap_FSUNAdjointStepper_SetJacTimesVecFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +type(C_FUNPTR), value :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_SetVecTimesJacFn(farg1, farg2, farg3) & +bind(C, name="_wrap_FSUNAdjointStepper_SetVecTimesJacFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +type(C_FUNPTR), value :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_SetUserData(farg1, farg2) & +bind(C, name="_wrap_FSUNAdjointStepper_SetUserData") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_PrintAllStats(farg1, farg2, farg3) & +bind(C, name="_wrap_FSUNAdjointStepper_PrintAllStats") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT), intent(in) :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_Destroy(farg1) & +bind(C, name="_wrap_FSUNAdjointStepper_Destroy") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +end interface + + +contains + ! MODULE SUBPROGRAMS +subroutine swigf_SUNAdjointStepper__adj_sunstepper_set(self, adj_sunstepper) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: adj_sunstepper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = adj_sunstepper +call swigc_SUNAdjointStepper__adj_sunstepper_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__adj_sunstepper_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__adj_sunstepper_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__fwd_sunstepper_set(self, fwd_sunstepper) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fwd_sunstepper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = fwd_sunstepper +call swigc_SUNAdjointStepper__fwd_sunstepper_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__fwd_sunstepper_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__fwd_sunstepper_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__checkpoint_scheme_set(self, checkpoint_scheme) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(SUNAdjointCheckpointScheme), target, intent(inout) :: checkpoint_scheme +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = c_loc(checkpoint_scheme) +call swigc_SUNAdjointStepper__checkpoint_scheme_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__checkpoint_scheme_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(SUNAdjointCheckpointScheme), pointer :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__checkpoint_scheme_get(farg1) +call c_f_pointer(fresult, swig_result) +end function + +subroutine swigf_SUNAdjointStepper__tf_set(self, tf) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +real(C_DOUBLE), intent(in) :: tf +type(SwigClassWrapper) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = self%swigdata +farg2 = tf +call swigc_SUNAdjointStepper__tf_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__tf_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +real(C_DOUBLE) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +real(C_DOUBLE) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__tf_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__step_idx_set(self, step_idx) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: step_idx +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = step_idx +call swigc_SUNAdjointStepper__step_idx_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__step_idx_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__step_idx_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__final_step_idx_set(self, final_step_idx) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: final_step_idx +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = final_step_idx +call swigc_SUNAdjointStepper__final_step_idx_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__final_step_idx_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__final_step_idx_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__last_flag_set(self, last_flag) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT), intent(in) :: last_flag +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: farg2 + +farg1 = self%swigdata +farg2 = last_flag +call swigc_SUNAdjointStepper__last_flag_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__last_flag_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__last_flag_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__Jac_set(self, jac) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(SUNMatrix), target, intent(inout) :: jac +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = c_loc(jac) +call swigc_SUNAdjointStepper__Jac_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__Jac_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(SUNMatrix), pointer :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__Jac_get(farg1) +call c_f_pointer(fresult, swig_result) +end function + +subroutine swigf_SUNAdjointStepper__JacP_set(self, jacp) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(SUNMatrix), target, intent(inout) :: jacp +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = c_loc(jacp) +call swigc_SUNAdjointStepper__JacP_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__JacP_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(SUNMatrix), pointer :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__JacP_get(farg1) +call c_f_pointer(fresult, swig_result) +end function + +subroutine swigf_SUNAdjointStepper__JacFn_set(self, jacfn) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR), intent(in), value :: jacfn +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = self%swigdata +farg2 = jacfn +call swigc_SUNAdjointStepper__JacFn_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__JacFn_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_FUNPTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__JacFn_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__JacPFn_set(self, jacpfn) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR), intent(in), value :: jacpfn +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = self%swigdata +farg2 = jacpfn +call swigc_SUNAdjointStepper__JacPFn_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__JacPFn_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_FUNPTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__JacPFn_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__JvpFn_set(self, jvpfn) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR), intent(in), value :: jvpfn +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = self%swigdata +farg2 = jvpfn +call swigc_SUNAdjointStepper__JvpFn_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__JvpFn_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_FUNPTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__JvpFn_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__JPvpFn_set(self, jpvpfn) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR), intent(in), value :: jpvpfn +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = self%swigdata +farg2 = jpvpfn +call swigc_SUNAdjointStepper__JPvpFn_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__JPvpFn_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_FUNPTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__JPvpFn_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__vJpFn_set(self, vjpfn) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR), intent(in), value :: vjpfn +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = self%swigdata +farg2 = vjpfn +call swigc_SUNAdjointStepper__vJpFn_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__vJpFn_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_FUNPTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__vJpFn_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__vJPpFn_set(self, vjppfn) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR), intent(in), value :: vjppfn +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = self%swigdata +farg2 = vjppfn +call swigc_SUNAdjointStepper__vJPpFn_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__vJPpFn_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_FUNPTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__vJPpFn_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__nst_set(self, nst) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: nst +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = nst +call swigc_SUNAdjointStepper__nst_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__nst_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__nst_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__njeval_set(self, njeval) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: njeval +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = njeval +call swigc_SUNAdjointStepper__njeval_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__njeval_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__njeval_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__njpeval_set(self, njpeval) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: njpeval +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = njpeval +call swigc_SUNAdjointStepper__njpeval_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__njpeval_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__njpeval_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__njtimesv_set(self, njtimesv) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: njtimesv +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = njtimesv +call swigc_SUNAdjointStepper__njtimesv_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__njtimesv_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__njtimesv_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__njptimesv_set(self, njptimesv) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: njptimesv +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = njptimesv +call swigc_SUNAdjointStepper__njptimesv_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__njptimesv_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__njptimesv_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__nvtimesj_set(self, nvtimesj) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: nvtimesj +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = nvtimesj +call swigc_SUNAdjointStepper__nvtimesj_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__nvtimesj_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__nvtimesj_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__nvtimesjp_set(self, nvtimesjp) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: nvtimesjp +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = nvtimesjp +call swigc_SUNAdjointStepper__nvtimesjp_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__nvtimesjp_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__nvtimesjp_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__nrecompute_set(self, nrecompute) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: nrecompute +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = nrecompute +call swigc_SUNAdjointStepper__nrecompute_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__nrecompute_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__nrecompute_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__user_data_set(self, user_data) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: user_data +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = user_data +call swigc_SUNAdjointStepper__user_data_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__user_data_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__user_data_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__content_set(self, content) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: content +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = content +call swigc_SUNAdjointStepper__content_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__content_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__content_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__sunctx_set(self, sunctx) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: sunctx +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = sunctx +call swigc_SUNAdjointStepper__sunctx_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__sunctx_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__sunctx_get(farg1) +swig_result = fresult +end function + +function swigf_create_SUNAdjointStepper_() & +result(self) +use, intrinsic :: ISO_C_BINDING +type(SUNAdjointStepper_) :: self +type(SwigClassWrapper) :: fresult + +fresult = swigc_new_SUNAdjointStepper_() +self%swigdata = fresult +end function + +subroutine swigf_release_SUNAdjointStepper_(self) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(inout) :: self +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +if (btest(farg1%cmemflags, swig_cmem_own_bit)) then +call swigc_delete_SUNAdjointStepper_(farg1) +endif +farg1%cptr = C_NULL_PTR +farg1%cmemflags = 0 +self%swigdata = farg1 +end subroutine + +subroutine swigf_SUNAdjointStepper__op_assign__(self, other) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(inout) :: self +type(SUNAdjointStepper_), intent(in) :: other +type(SwigClassWrapper) :: farg1 +type(SwigClassWrapper) :: farg2 + +farg1 = self%swigdata +farg2 = other%swigdata +call swigc_SUNAdjointStepper__op_assign__(farg1, farg2) +self%swigdata = farg1 +end subroutine + +function FSUNAdjointStepper_Create(fwd_sunstepper, adj_sunstepper, final_step_idx, sf, tf, checkpoint_scheme, sunctx, & + adj_stepper) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: fwd_sunstepper +type(C_PTR) :: adj_sunstepper +integer(C_INT64_T), intent(in) :: final_step_idx +type(N_Vector), target, intent(inout) :: sf +real(C_DOUBLE), intent(in) :: tf +type(SUNAdjointCheckpointScheme), target, intent(inout) :: checkpoint_scheme +type(C_PTR) :: sunctx +type(C_PTR), target, intent(inout) :: adj_stepper +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +integer(C_INT64_T) :: farg3 +type(C_PTR) :: farg4 +real(C_DOUBLE) :: farg5 +type(C_PTR) :: farg6 +type(C_PTR) :: farg7 +type(C_PTR) :: farg8 + +farg1 = fwd_sunstepper +farg2 = adj_sunstepper +farg3 = final_step_idx +farg4 = c_loc(sf) +farg5 = tf +farg6 = c_loc(checkpoint_scheme) +farg7 = sunctx +farg8 = c_loc(adj_stepper) +fresult = swigc_FSUNAdjointStepper_Create(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8) +swig_result = fresult +end function + +function FSUNAdjointStepper_ReInit(adj, y0, t0, sf, tf) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: adj +type(N_Vector), target, intent(inout) :: y0 +real(C_DOUBLE), intent(in) :: t0 +type(N_Vector), target, intent(inout) :: sf +real(C_DOUBLE), intent(in) :: tf +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +real(C_DOUBLE) :: farg3 +type(C_PTR) :: farg4 +real(C_DOUBLE) :: farg5 + +farg1 = adj +farg2 = c_loc(y0) +farg3 = t0 +farg4 = c_loc(sf) +farg5 = tf +fresult = swigc_FSUNAdjointStepper_ReInit(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNAdjointStepper_Evolve(adj_stepper, tout, sens, tret) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: adj_stepper +real(C_DOUBLE), intent(in) :: tout +type(N_Vector), target, intent(inout) :: sens +real(C_DOUBLE), dimension(*), target, intent(inout) :: tret +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 + +farg1 = adj_stepper +farg2 = tout +farg3 = c_loc(sens) +farg4 = c_loc(tret(1)) +fresult = swigc_FSUNAdjointStepper_Evolve(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNAdjointStepper_OneStep(adj_stepper, tout, sens, tret) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: adj_stepper +real(C_DOUBLE), intent(in) :: tout +type(N_Vector), target, intent(inout) :: sens +real(C_DOUBLE), dimension(*), target, intent(inout) :: tret +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 + +farg1 = adj_stepper +farg2 = tout +farg3 = c_loc(sens) +farg4 = c_loc(tret(1)) +fresult = swigc_FSUNAdjointStepper_OneStep(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNAdjointStepper_RecomputeFwd(adj_stepper, start_idx, t0, tf, y0) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: adj_stepper +integer(C_INT64_T), intent(in) :: start_idx +real(C_DOUBLE), intent(in) :: t0 +real(C_DOUBLE), intent(in) :: tf +type(N_Vector), target, intent(inout) :: y0 +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +real(C_DOUBLE) :: farg3 +real(C_DOUBLE) :: farg4 +type(C_PTR) :: farg5 + +farg1 = adj_stepper +farg2 = start_idx +farg3 = t0 +farg4 = tf +farg5 = c_loc(y0) +fresult = swigc_FSUNAdjointStepper_RecomputeFwd(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNAdjointStepper_SetJacFn(arg0, jacfn, jac, jacpfn, jp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arg0 +type(C_FUNPTR), intent(in), value :: jacfn +type(SUNMatrix), target, intent(inout) :: jac +type(C_FUNPTR), intent(in), value :: jacpfn +type(SUNMatrix), target, intent(inout) :: jp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_PTR) :: farg3 +type(C_FUNPTR) :: farg4 +type(C_PTR) :: farg5 + +farg1 = arg0 +farg2 = jacfn +farg3 = c_loc(jac) +farg4 = jacpfn +farg5 = c_loc(jp) +fresult = swigc_FSUNAdjointStepper_SetJacFn(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNAdjointStepper_SetJacTimesVecFn(arg0, jvp, jpvp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arg0 +type(C_FUNPTR), intent(in), value :: jvp +type(C_FUNPTR), intent(in), value :: jpvp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_FUNPTR) :: farg3 + +farg1 = arg0 +farg2 = jvp +farg3 = jpvp +fresult = swigc_FSUNAdjointStepper_SetJacTimesVecFn(farg1, farg2, farg3) +swig_result = fresult +end function + +function FSUNAdjointStepper_SetVecTimesJacFn(arg0, vjp, vjpp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arg0 +type(C_FUNPTR), intent(in), value :: vjp +type(C_FUNPTR), intent(in), value :: vjpp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_FUNPTR) :: farg3 + +farg1 = arg0 +farg2 = vjp +farg3 = vjpp +fresult = swigc_FSUNAdjointStepper_SetVecTimesJacFn(farg1, farg2, farg3) +swig_result = fresult +end function + +function FSUNAdjointStepper_SetUserData(arg0, user_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arg0 +type(C_PTR) :: user_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arg0 +farg2 = user_data +fresult = swigc_FSUNAdjointStepper_SetUserData(farg1, farg2) +swig_result = fresult +end function + +function FSUNAdjointStepper_PrintAllStats(adj_stepper, outfile, fmt) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: adj_stepper +type(C_PTR) :: outfile +integer(SUNOutputFormat), intent(in) :: fmt +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +integer(C_INT) :: farg3 + +farg1 = adj_stepper +farg2 = outfile +farg3 = fmt +fresult = swigc_FSUNAdjointStepper_PrintAllStats(farg1, farg2, farg3) +swig_result = fresult +end function + +function FSUNAdjointStepper_Destroy(arg0) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR), target, intent(inout) :: arg0 +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = c_loc(arg0) +fresult = swigc_FSUNAdjointStepper_Destroy(farg1) +swig_result = fresult +end function + + +end module diff --git a/src/sunadjoint/fmod_int64/CMakeLists.txt b/src/sunadjoint/fmod_int64/CMakeLists.txt new file mode 100644 index 0000000000..440f06eeb9 --- /dev/null +++ b/src/sunadjoint/fmod_int64/CMakeLists.txt @@ -0,0 +1,24 @@ +# --------------------------------------------------------------- +# SUNDIALS Copyright Start +# Copyright (c) 2002-2024, 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_add_f2003_library( + sundials_fsunadjoint_mod + SOURCES fsunadjointstepper_mod.f90 + fsunadjointstepper_mod.c + fsunadjointcheckpointscheme_mod.f90 + fsunadjointcheckpointscheme_mod.c + fsunadjointcheckpointscheme_fixed_mod.f90 + fsunadjointcheckpointscheme_fixed_mod.c + LINK_LIBRARIES PUBLIC sundials_fcore_mod + OUTPUT_NAME sundials_fsunadjoint_mod OBJECT_LIB_ONLY) + +message(STATUS "Added SUNAdjoint interface") diff --git a/src/sunadjoint/fmod_int64/fsunadjointcheckpointscheme_fixed_mod.c b/src/sunadjoint/fmod_int64/fsunadjointcheckpointscheme_fixed_mod.c new file mode 100644 index 0000000000..4a81825695 --- /dev/null +++ b/src/sunadjoint/fmod_int64/fsunadjointcheckpointscheme_fixed_mod.c @@ -0,0 +1,391 @@ +/* ---------------------------------------------------------------------------- + * 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-2024, 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; } + + +enum { + SWIG_MEM_OWN = 0x01, + SWIG_MEM_RVALUE = 0x02, + SWIG_MEM_CONST = 0x04 +}; + + +#define SWIG_check_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ + if (!(SWIG_CLASS_WRAPPER).cptr) { \ + SWIG_exception_impl(FUNCNAME, SWIG_TypeError, \ + "Cannot pass null " TYPENAME " (class " FNAME ") " \ + "as a reference", 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 "sunadjoint/sunadjoint_checkpointscheme_fixed.h" + + +typedef struct { + void* cptr; + int cmemflags; +} SwigClassWrapper; + + +SWIGINTERN SwigClassWrapper SwigClassWrapper_uninitialized() { + SwigClassWrapper result; + result.cptr = NULL; + result.cmemflags = 0; + return result; +} + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_Create_Fixed(int const *farg1, SwigClassWrapper const *farg2, int64_t const *farg3, int64_t const *farg4, int const *farg5, int const *farg6, void *farg7, void *farg8) { + int fresult ; + SUNDataIOMode arg1 ; + SUNMemoryHelper arg2 ; + int64_t arg3 ; + int64_t arg4 ; + int arg5 ; + int arg6 ; + SUNContext arg7 = (SUNContext) 0 ; + SUNAdjointCheckpointScheme *arg8 = (SUNAdjointCheckpointScheme *) 0 ; + SUNErrCode result; + + arg1 = (SUNDataIOMode)(*farg1); + SWIG_check_nonnull(*farg2, "SUNMemoryHelper", "SWIGTYPE_p_SUNMemoryHelper", "SUNAdjointCheckpointScheme_Create_Fixed(SUNDataIOMode,SUNMemoryHelper,int64_t,int64_t,int,int,SUNContext,SUNAdjointCheckpointScheme *)", return 0); + arg2 = *(SUNMemoryHelper *)(farg2->cptr); + arg3 = (int64_t)(*farg3); + arg4 = (int64_t)(*farg4); + arg5 = (int)(*farg5); + arg6 = (int)(*farg6); + arg7 = (SUNContext)(farg7); + arg8 = (SUNAdjointCheckpointScheme *)(farg8); + result = (SUNErrCode)SUNAdjointCheckpointScheme_Create_Fixed(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, double const *farg4, int *farg5) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + sunrealtype arg4 ; + int *arg5 = (int *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (sunrealtype)(*farg4); + arg5 = (int *)(farg5); + result = (SUNErrCode)SUNAdjointCheckpointScheme_ShouldWeSave_Fixed(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_InsertVector_Fixed(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, double const *farg4, N_Vector farg5) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + sunrealtype arg4 ; + N_Vector arg5 = (N_Vector) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (sunrealtype)(*farg4); + arg5 = (N_Vector)(farg5); + result = (SUNErrCode)SUNAdjointCheckpointScheme_InsertVector_Fixed(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, int *farg4) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + int *arg4 = (int *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (int *)(farg4); + result = (SUNErrCode)SUNAdjointCheckpointScheme_ShouldWeDelete_Fixed(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_RemoveVector_Fixed(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, void *farg4) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + N_Vector *arg4 = (N_Vector *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (N_Vector *)(farg4); + result = (SUNErrCode)SUNAdjointCheckpointScheme_RemoveVector_Fixed(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_LoadVector_Fixed(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, int const *farg4, void *farg5, double *farg6) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + int arg4 ; + N_Vector *arg5 = (N_Vector *) 0 ; + sunrealtype *arg6 = (sunrealtype *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (int)(*farg4); + arg5 = (N_Vector *)(farg5); + arg6 = (sunrealtype *)(farg6); + result = (SUNErrCode)SUNAdjointCheckpointScheme_LoadVector_Fixed(arg1,arg2,arg3,arg4,arg5,arg6); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_Destroy_Fixed(void *farg1) { + int fresult ; + SUNAdjointCheckpointScheme *arg1 = (SUNAdjointCheckpointScheme *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme *)(farg1); + result = (SUNErrCode)SUNAdjointCheckpointScheme_Destroy_Fixed(arg1); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_EnableDense_Fixed(SUNAdjointCheckpointScheme farg1, int const *farg2) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int arg2 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int)(*farg2); + result = (SUNErrCode)SUNAdjointCheckpointScheme_EnableDense_Fixed(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + + diff --git a/src/sunadjoint/fmod_int64/fsunadjointcheckpointscheme_fixed_mod.f90 b/src/sunadjoint/fmod_int64/fsunadjointcheckpointscheme_fixed_mod.f90 new file mode 100644 index 0000000000..6b019d2547 --- /dev/null +++ b/src/sunadjoint/fmod_int64/fsunadjointcheckpointscheme_fixed_mod.f90 @@ -0,0 +1,336 @@ +! This file was automatically generated by SWIG (http://www.swig.org). +! Version 4.0.0 +! +! 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-2024, 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 +! --------------------------------------------------------------- + +module fsunadjointcheckpointscheme_fixed_mod + use, intrinsic :: ISO_C_BINDING + use fsundials_core_mod + use fsunadjointcheckpointscheme_mod + use fsundials_core_mod + implicit none + private + + ! DECLARATION CONSTRUCTS + + integer, parameter :: swig_cmem_own_bit = 0 + integer, parameter :: swig_cmem_rvalue_bit = 1 + integer, parameter :: swig_cmem_const_bit = 2 + type, bind(C) :: SwigClassWrapper + type(C_PTR), public :: cptr = C_NULL_PTR + integer(C_INT), public :: cmemflags = 0 + end type + type, public :: SWIGTYPE_p_SUNMemoryHelper + type(SwigClassWrapper), public :: swigdata + end type + public :: FSUNAdjointCheckpointScheme_Create_Fixed + public :: FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed + public :: FSUNAdjointCheckpointScheme_InsertVector_Fixed + public :: FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed + public :: FSUNAdjointCheckpointScheme_RemoveVector_Fixed + public :: FSUNAdjointCheckpointScheme_LoadVector_Fixed + public :: FSUNAdjointCheckpointScheme_Destroy_Fixed + public :: FSUNAdjointCheckpointScheme_EnableDense_Fixed + +! WRAPPER DECLARATIONS +interface +function swigc_FSUNAdjointCheckpointScheme_Create_Fixed(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_Create_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +integer(C_INT), intent(in) :: farg1 +type(SwigClassWrapper) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +integer(C_INT64_T), intent(in) :: farg4 +integer(C_INT), intent(in) :: farg5 +integer(C_INT), intent(in) :: farg6 +type(C_PTR), value :: farg7 +type(C_PTR), value :: farg8 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +real(C_DOUBLE), intent(in) :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_InsertVector_Fixed(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_InsertVector_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +real(C_DOUBLE), intent(in) :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_RemoveVector_Fixed(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_RemoveVector_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_LoadVector_Fixed(farg1, farg2, farg3, farg4, farg5, farg6) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_LoadVector_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +integer(C_INT), intent(in) :: farg4 +type(C_PTR), value :: farg5 +type(C_PTR), value :: farg6 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_Destroy_Fixed(farg1) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_Destroy_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_EnableDense_Fixed(farg1, farg2) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_EnableDense_Fixed") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT), intent(in) :: farg2 +integer(C_INT) :: fresult +end function + +end interface + + +contains + ! MODULE SUBPROGRAMS +function FSUNAdjointCheckpointScheme_Create_Fixed(io_mode, mem_helper, interval, estimate, save_stages, keep, sunctx, & + check_scheme_ptr) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +integer(SUNDataIOMode), intent(in) :: io_mode +type(SWIGTYPE_p_SUNMemoryHelper), intent(in) :: mem_helper +integer(C_INT64_T), intent(in) :: interval +integer(C_INT64_T), intent(in) :: estimate +integer(C_INT), intent(in) :: save_stages +integer(C_INT), intent(in) :: keep +type(C_PTR) :: sunctx +type(C_PTR), target, intent(inout) :: check_scheme_ptr +integer(C_INT) :: fresult +integer(C_INT) :: farg1 +type(SwigClassWrapper) :: farg2 +integer(C_INT64_T) :: farg3 +integer(C_INT64_T) :: farg4 +integer(C_INT) :: farg5 +integer(C_INT) :: farg6 +type(C_PTR) :: farg7 +type(C_PTR) :: farg8 + +farg1 = io_mode +farg2 = mem_helper%swigdata +farg3 = interval +farg4 = estimate +farg5 = save_stages +farg6 = keep +farg7 = sunctx +farg8 = c_loc(check_scheme_ptr) +fresult = swigc_FSUNAdjointCheckpointScheme_Create_Fixed(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed(check_scheme, step_num, stage_num, t, yes_or_no) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +real(C_DOUBLE), intent(in) :: t +integer(C_INT), dimension(*), target, intent(inout) :: yes_or_no +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +real(C_DOUBLE) :: farg4 +type(C_PTR) :: farg5 + +farg1 = c_loc(check_scheme) +farg2 = step_num +farg3 = stage_num +farg4 = t +farg5 = c_loc(yes_or_no(1)) +fresult = swigc_FSUNAdjointCheckpointScheme_ShouldWeSave_Fixed(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_InsertVector_Fixed(check_scheme, step_num, stage_num, t, state) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +real(C_DOUBLE), intent(in) :: t +type(N_Vector), target, intent(inout) :: state +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +real(C_DOUBLE) :: farg4 +type(C_PTR) :: farg5 + +farg1 = c_loc(check_scheme) +farg2 = step_num +farg3 = stage_num +farg4 = t +farg5 = c_loc(state) +fresult = swigc_FSUNAdjointCheckpointScheme_InsertVector_Fixed(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed(check_scheme, step_num, stage_num, yes_or_no) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +integer(C_INT), dimension(*), target, intent(inout) :: yes_or_no +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +type(C_PTR) :: farg4 + +farg1 = c_loc(check_scheme) +farg2 = step_num +farg3 = stage_num +farg4 = c_loc(yes_or_no(1)) +fresult = swigc_FSUNAdjointCheckpointScheme_ShouldWeDelete_Fixed(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_RemoveVector_Fixed(check_scheme, step_num, stage_num, out) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +type(C_PTR) :: out +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +type(C_PTR) :: farg4 + +farg1 = c_loc(check_scheme) +farg2 = step_num +farg3 = stage_num +farg4 = out +fresult = swigc_FSUNAdjointCheckpointScheme_RemoveVector_Fixed(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_LoadVector_Fixed(check_scheme, step_num, stage_num, peek, out, tout) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +integer(C_INT), intent(in) :: peek +type(C_PTR) :: out +real(C_DOUBLE), dimension(*), target, intent(inout) :: tout +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +integer(C_INT) :: farg4 +type(C_PTR) :: farg5 +type(C_PTR) :: farg6 + +farg1 = c_loc(check_scheme) +farg2 = step_num +farg3 = stage_num +farg4 = peek +farg5 = out +farg6 = c_loc(tout(1)) +fresult = swigc_FSUNAdjointCheckpointScheme_LoadVector_Fixed(farg1, farg2, farg3, farg4, farg5, farg6) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_Destroy_Fixed(check_scheme_ptr) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR), target, intent(inout) :: check_scheme_ptr +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = c_loc(check_scheme_ptr) +fresult = swigc_FSUNAdjointCheckpointScheme_Destroy_Fixed(farg1) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_EnableDense_Fixed(check_scheme, on_or_off) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: check_scheme +integer(C_INT), intent(in) :: on_or_off +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = c_loc(check_scheme) +farg2 = on_or_off +fresult = swigc_FSUNAdjointCheckpointScheme_EnableDense_Fixed(farg1, farg2) +swig_result = fresult +end function + + +end module diff --git a/src/sunadjoint/fmod_int64/fsunadjointcheckpointscheme_mod.c b/src/sunadjoint/fmod_int64/fsunadjointcheckpointscheme_mod.c new file mode 100644 index 0000000000..c1806a1d40 --- /dev/null +++ b/src/sunadjoint/fmod_int64/fsunadjointcheckpointscheme_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-2024, 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 "sunadjoint/sunadjoint_checkpointscheme.h" + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_NewEmpty(void *farg1, void *farg2) { + int fresult ; + SUNContext arg1 = (SUNContext) 0 ; + SUNAdjointCheckpointScheme *arg2 = (SUNAdjointCheckpointScheme *) 0 ; + SUNErrCode result; + + arg1 = (SUNContext)(farg1); + arg2 = (SUNAdjointCheckpointScheme *)(farg2); + result = (SUNErrCode)SUNAdjointCheckpointScheme_NewEmpty(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_ShouldWeSave(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, double const *farg4, int *farg5) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + sunrealtype arg4 ; + int *arg5 = (int *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (sunrealtype)(*farg4); + arg5 = (int *)(farg5); + result = (SUNErrCode)SUNAdjointCheckpointScheme_ShouldWeSave(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_ShouldWeDelete(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, int *farg4) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + int *arg4 = (int *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (int *)(farg4); + result = (SUNErrCode)SUNAdjointCheckpointScheme_ShouldWeDelete(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_InsertVector(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, double const *farg4, N_Vector farg5) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + sunrealtype arg4 ; + N_Vector arg5 = (N_Vector) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (sunrealtype)(*farg4); + arg5 = (N_Vector)(farg5); + result = (SUNErrCode)SUNAdjointCheckpointScheme_InsertVector(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_LoadVector(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, int const *farg4, void *farg5, double *farg6) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + int arg4 ; + N_Vector *arg5 = (N_Vector *) 0 ; + sunrealtype *arg6 = (sunrealtype *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (int)(*farg4); + arg5 = (N_Vector *)(farg5); + arg6 = (sunrealtype *)(farg6); + result = (SUNErrCode)SUNAdjointCheckpointScheme_LoadVector(arg1,arg2,arg3,arg4,arg5,arg6); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_RemoveVector(SUNAdjointCheckpointScheme farg1, int64_t const *farg2, int64_t const *farg3, void *farg4) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int64_t arg2 ; + int64_t arg3 ; + N_Vector *arg4 = (N_Vector *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (int64_t)(*farg3); + arg4 = (N_Vector *)(farg4); + result = (SUNErrCode)SUNAdjointCheckpointScheme_RemoveVector(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_Destroy(void *farg1) { + int fresult ; + SUNAdjointCheckpointScheme *arg1 = (SUNAdjointCheckpointScheme *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme *)(farg1); + result = (SUNErrCode)SUNAdjointCheckpointScheme_Destroy(arg1); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointCheckpointScheme_EnableDense(SUNAdjointCheckpointScheme farg1, int const *farg2) { + int fresult ; + SUNAdjointCheckpointScheme arg1 = (SUNAdjointCheckpointScheme) 0 ; + int arg2 ; + SUNErrCode result; + + arg1 = (SUNAdjointCheckpointScheme)(farg1); + arg2 = (int)(*farg2); + result = (SUNErrCode)SUNAdjointCheckpointScheme_EnableDense(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + + diff --git a/src/sunadjoint/fmod_int64/fsunadjointcheckpointscheme_mod.f90 b/src/sunadjoint/fmod_int64/fsunadjointcheckpointscheme_mod.f90 new file mode 100644 index 0000000000..5a9825052c --- /dev/null +++ b/src/sunadjoint/fmod_int64/fsunadjointcheckpointscheme_mod.f90 @@ -0,0 +1,313 @@ +! This file was automatically generated by SWIG (http://www.swig.org). +! Version 4.0.0 +! +! 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-2024, 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 +! --------------------------------------------------------------- + +module fsunadjointcheckpointscheme_mod + use, intrinsic :: ISO_C_BINDING + use fsundials_core_mod + implicit none + private + + ! DECLARATION CONSTRUCTS + ! struct struct SUNAdjointCheckpointScheme_Ops_ + type, bind(C), public :: SUNAdjointCheckpointScheme_Ops + type(C_FUNPTR), public :: shouldWeSave + type(C_FUNPTR), public :: shouldWeDelete + type(C_FUNPTR), public :: insertVector + type(C_FUNPTR), public :: loadVector + type(C_FUNPTR), public :: removeVector + type(C_FUNPTR), public :: destroy + type(C_FUNPTR), public :: enableDense + end type SUNAdjointCheckpointScheme_Ops + ! struct struct SUNAdjointCheckpointScheme_ + type, bind(C), public :: SUNAdjointCheckpointScheme + type(C_PTR), public :: ops + type(C_PTR), public :: content + type(C_PTR), public :: sunctx + end type SUNAdjointCheckpointScheme + public :: FSUNAdjointCheckpointScheme_NewEmpty + public :: FSUNAdjointCheckpointScheme_ShouldWeSave + public :: FSUNAdjointCheckpointScheme_ShouldWeDelete + public :: FSUNAdjointCheckpointScheme_InsertVector + public :: FSUNAdjointCheckpointScheme_LoadVector + public :: FSUNAdjointCheckpointScheme_RemoveVector + public :: FSUNAdjointCheckpointScheme_Destroy + public :: FSUNAdjointCheckpointScheme_EnableDense + +! WRAPPER DECLARATIONS +interface +function swigc_FSUNAdjointCheckpointScheme_NewEmpty(farg1, farg2) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_NewEmpty") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_ShouldWeSave(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_ShouldWeSave") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +real(C_DOUBLE), intent(in) :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_ShouldWeDelete(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_ShouldWeDelete") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_InsertVector(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_InsertVector") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +real(C_DOUBLE), intent(in) :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_LoadVector(farg1, farg2, farg3, farg4, farg5, farg6) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_LoadVector") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +integer(C_INT), intent(in) :: farg4 +type(C_PTR), value :: farg5 +type(C_PTR), value :: farg6 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_RemoveVector(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_RemoveVector") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_Destroy(farg1) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_Destroy") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointCheckpointScheme_EnableDense(farg1, farg2) & +bind(C, name="_wrap_FSUNAdjointCheckpointScheme_EnableDense") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT), intent(in) :: farg2 +integer(C_INT) :: fresult +end function + +end interface + + +contains + ! MODULE SUBPROGRAMS +function FSUNAdjointCheckpointScheme_NewEmpty(sunctx, arg1) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: sunctx +type(C_PTR), target, intent(inout) :: arg1 +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = sunctx +farg2 = c_loc(arg1) +fresult = swigc_FSUNAdjointCheckpointScheme_NewEmpty(farg1, farg2) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_ShouldWeSave(arg0, step_num, stage_num, t, yes_or_no) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: arg0 +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +real(C_DOUBLE), intent(in) :: t +integer(C_INT), dimension(*), target, intent(inout) :: yes_or_no +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +real(C_DOUBLE) :: farg4 +type(C_PTR) :: farg5 + +farg1 = c_loc(arg0) +farg2 = step_num +farg3 = stage_num +farg4 = t +farg5 = c_loc(yes_or_no(1)) +fresult = swigc_FSUNAdjointCheckpointScheme_ShouldWeSave(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_ShouldWeDelete(arg0, step_num, stage_num, yes_or_no) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: arg0 +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +integer(C_INT), dimension(*), target, intent(inout) :: yes_or_no +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +type(C_PTR) :: farg4 + +farg1 = c_loc(arg0) +farg2 = step_num +farg3 = stage_num +farg4 = c_loc(yes_or_no(1)) +fresult = swigc_FSUNAdjointCheckpointScheme_ShouldWeDelete(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_InsertVector(arg0, step_num, stage_num, t, state) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: arg0 +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +real(C_DOUBLE), intent(in) :: t +type(N_Vector), target, intent(inout) :: state +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +real(C_DOUBLE) :: farg4 +type(C_PTR) :: farg5 + +farg1 = c_loc(arg0) +farg2 = step_num +farg3 = stage_num +farg4 = t +farg5 = c_loc(state) +fresult = swigc_FSUNAdjointCheckpointScheme_InsertVector(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_LoadVector(arg0, step_num, stage_num, peek, out, tout) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: arg0 +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +integer(C_INT), intent(in) :: peek +type(C_PTR) :: out +real(C_DOUBLE), dimension(*), target, intent(inout) :: tout +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +integer(C_INT) :: farg4 +type(C_PTR) :: farg5 +type(C_PTR) :: farg6 + +farg1 = c_loc(arg0) +farg2 = step_num +farg3 = stage_num +farg4 = peek +farg5 = out +farg6 = c_loc(tout(1)) +fresult = swigc_FSUNAdjointCheckpointScheme_LoadVector(farg1, farg2, farg3, farg4, farg5, farg6) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_RemoveVector(arg0, step_num, stage_num, out) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: arg0 +integer(C_INT64_T), intent(in) :: step_num +integer(C_INT64_T), intent(in) :: stage_num +type(C_PTR) :: out +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +type(C_PTR) :: farg4 + +farg1 = c_loc(arg0) +farg2 = step_num +farg3 = stage_num +farg4 = out +fresult = swigc_FSUNAdjointCheckpointScheme_RemoveVector(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_Destroy(arg0) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR), target, intent(inout) :: arg0 +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = c_loc(arg0) +fresult = swigc_FSUNAdjointCheckpointScheme_Destroy(farg1) +swig_result = fresult +end function + +function FSUNAdjointCheckpointScheme_EnableDense(arg0, on_or_off) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNAdjointCheckpointScheme), target, intent(inout) :: arg0 +integer(C_INT), intent(in) :: on_or_off +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = c_loc(arg0) +farg2 = on_or_off +fresult = swigc_FSUNAdjointCheckpointScheme_EnableDense(farg1, farg2) +swig_result = fresult +end function + + +end module diff --git a/src/sunadjoint/fmod_int64/fsunadjointstepper_mod.c b/src/sunadjoint/fmod_int64/fsunadjointstepper_mod.c new file mode 100644 index 0000000000..27ffa9c8dd --- /dev/null +++ b/src/sunadjoint/fmod_int64/fsunadjointstepper_mod.c @@ -0,0 +1,1151 @@ +/* ---------------------------------------------------------------------------- + * 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-2024, 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; } + + +enum { + SWIG_MEM_OWN = 0x01, + SWIG_MEM_RVALUE = 0x02, + SWIG_MEM_CONST = 0x04 +}; + + +#define SWIG_check_mutable(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ + if ((SWIG_CLASS_WRAPPER).cmemflags & SWIG_MEM_CONST) { \ + SWIG_exception_impl(FUNCNAME, SWIG_TypeError, \ + "Cannot pass const " TYPENAME " (class " FNAME ") " \ + "as a mutable reference", \ + RETURNNULL); \ + } + + +#define SWIG_check_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ + if (!(SWIG_CLASS_WRAPPER).cptr) { \ + SWIG_exception_impl(FUNCNAME, SWIG_TypeError, \ + "Cannot pass null " TYPENAME " (class " FNAME ") " \ + "as a reference", RETURNNULL); \ + } + + +#define SWIG_check_mutable_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \ + SWIG_check_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL); \ + SWIG_check_mutable(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, 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 "sunadjoint/sunadjoint_stepper.h" + + +typedef struct { + void* cptr; + int cmemflags; +} SwigClassWrapper; + + +SWIGINTERN SwigClassWrapper SwigClassWrapper_uninitialized() { + SwigClassWrapper result; + result.cptr = NULL; + result.cmemflags = 0; + return result; +} + + +#include +#ifdef _MSC_VER +# ifndef strtoull +# define strtoull _strtoui64 +# endif +# ifndef strtoll +# define strtoll _strtoi64 +# endif +#endif + + +#include + + +SWIGINTERN void SWIG_assign(SwigClassWrapper* self, SwigClassWrapper other) { + if (self->cptr == NULL) { + /* LHS is unassigned */ + if (other.cmemflags & SWIG_MEM_RVALUE) { + /* Capture pointer from RHS, clear 'moving' flag */ + self->cptr = other.cptr; + self->cmemflags = other.cmemflags & (~SWIG_MEM_RVALUE); + } else { + /* Become a reference to the other object */ + self->cptr = other.cptr; + self->cmemflags = other.cmemflags & (~SWIG_MEM_OWN); + } + } else if (other.cptr == NULL) { + /* Replace LHS with a null pointer */ + free(self->cptr); + *self = SwigClassWrapper_uninitialized(); + } else { + if (self->cmemflags & SWIG_MEM_OWN) { + free(self->cptr); + } + self->cptr = other.cptr; + if (other.cmemflags & SWIG_MEM_RVALUE) { + /* Capture RHS */ + self->cmemflags = other.cmemflags & ~SWIG_MEM_RVALUE; + } else { + /* Point to RHS */ + self->cmemflags = other.cmemflags & ~SWIG_MEM_OWN; + } + } +} + +SWIGEXPORT void _wrap_SUNAdjointStepper__adj_sunstepper_set(SwigClassWrapper const *farg1, void *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNStepper arg2 = (SUNStepper) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::adj_sunstepper", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNStepper)(farg2); + if (arg1) (arg1)->adj_sunstepper = arg2; +} + + +SWIGEXPORT void * _wrap_SUNAdjointStepper__adj_sunstepper_get(SwigClassWrapper const *farg1) { + void * fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNStepper result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::adj_sunstepper", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNStepper) ((arg1)->adj_sunstepper); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__fwd_sunstepper_set(SwigClassWrapper const *farg1, void *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNStepper arg2 = (SUNStepper) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::fwd_sunstepper", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNStepper)(farg2); + if (arg1) (arg1)->fwd_sunstepper = arg2; +} + + +SWIGEXPORT void * _wrap_SUNAdjointStepper__fwd_sunstepper_get(SwigClassWrapper const *farg1) { + void * fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNStepper result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::fwd_sunstepper", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNStepper) ((arg1)->fwd_sunstepper); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__checkpoint_scheme_set(SwigClassWrapper const *farg1, SUNAdjointCheckpointScheme farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNAdjointCheckpointScheme arg2 = (SUNAdjointCheckpointScheme) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::checkpoint_scheme", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNAdjointCheckpointScheme)(farg2); + if (arg1) (arg1)->checkpoint_scheme = arg2; +} + + +SWIGEXPORT SUNAdjointCheckpointScheme _wrap_SUNAdjointStepper__checkpoint_scheme_get(SwigClassWrapper const *farg1) { + SUNAdjointCheckpointScheme fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNAdjointCheckpointScheme result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::checkpoint_scheme", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNAdjointCheckpointScheme) ((arg1)->checkpoint_scheme); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__tf_set(SwigClassWrapper const *farg1, double const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + sunrealtype arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::tf", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (sunrealtype)(*farg2); + if (arg1) (arg1)->tf = arg2; +} + + +SWIGEXPORT double _wrap_SUNAdjointStepper__tf_get(SwigClassWrapper const *farg1) { + double fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + sunrealtype result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::tf", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (sunrealtype) ((arg1)->tf); + fresult = (sunrealtype)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__step_idx_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::step_idx", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->step_idx = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__step_idx_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::step_idx", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->step_idx); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__final_step_idx_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::final_step_idx", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->final_step_idx = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__final_step_idx_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::final_step_idx", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->final_step_idx); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__last_flag_set(SwigClassWrapper const *farg1, int const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::last_flag", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int)(*farg2); + if (arg1) (arg1)->last_flag = arg2; +} + + +SWIGEXPORT int _wrap_SUNAdjointStepper__last_flag_get(SwigClassWrapper const *farg1) { + int fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::last_flag", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (int) ((arg1)->last_flag); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__Jac_set(SwigClassWrapper const *farg1, SUNMatrix farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::Jac", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNMatrix)(farg2); + if (arg1) (arg1)->Jac = arg2; +} + + +SWIGEXPORT SUNMatrix _wrap_SUNAdjointStepper__Jac_get(SwigClassWrapper const *farg1) { + SUNMatrix fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNMatrix result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::Jac", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNMatrix) ((arg1)->Jac); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__JacP_set(SwigClassWrapper const *farg1, SUNMatrix farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNMatrix arg2 = (SUNMatrix) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JacP", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNMatrix)(farg2); + if (arg1) (arg1)->JacP = arg2; +} + + +SWIGEXPORT SUNMatrix _wrap_SUNAdjointStepper__JacP_get(SwigClassWrapper const *farg1) { + SUNMatrix fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNMatrix result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JacP", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNMatrix) ((arg1)->JacP); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__JacFn_set(SwigClassWrapper const *farg1, SUNRhsJacFn farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacFn arg2 = (SUNRhsJacFn) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JacFn", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNRhsJacFn)(farg2); + if (arg1) (arg1)->JacFn = arg2; +} + + +SWIGEXPORT SUNRhsJacFn _wrap_SUNAdjointStepper__JacFn_get(SwigClassWrapper const *farg1) { + SUNRhsJacFn fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacFn result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JacFn", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNRhsJacFn) ((arg1)->JacFn); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__JacPFn_set(SwigClassWrapper const *farg1, SUNRhsJacFn farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacFn arg2 = (SUNRhsJacFn) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JacPFn", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNRhsJacFn)(farg2); + if (arg1) (arg1)->JacPFn = arg2; +} + + +SWIGEXPORT SUNRhsJacFn _wrap_SUNAdjointStepper__JacPFn_get(SwigClassWrapper const *farg1) { + SUNRhsJacFn fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacFn result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JacPFn", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNRhsJacFn) ((arg1)->JacPFn); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__JvpFn_set(SwigClassWrapper const *farg1, SUNRhsJacTimesFn farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacTimesFn arg2 = (SUNRhsJacTimesFn) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JvpFn", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNRhsJacTimesFn)(farg2); + if (arg1) (arg1)->JvpFn = arg2; +} + + +SWIGEXPORT SUNRhsJacTimesFn _wrap_SUNAdjointStepper__JvpFn_get(SwigClassWrapper const *farg1) { + SUNRhsJacTimesFn fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacTimesFn result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JvpFn", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNRhsJacTimesFn) ((arg1)->JvpFn); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__JPvpFn_set(SwigClassWrapper const *farg1, SUNRhsJacTimesFn farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacTimesFn arg2 = (SUNRhsJacTimesFn) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JPvpFn", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNRhsJacTimesFn)(farg2); + if (arg1) (arg1)->JPvpFn = arg2; +} + + +SWIGEXPORT SUNRhsJacTimesFn _wrap_SUNAdjointStepper__JPvpFn_get(SwigClassWrapper const *farg1) { + SUNRhsJacTimesFn fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacTimesFn result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::JPvpFn", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNRhsJacTimesFn) ((arg1)->JPvpFn); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__vJpFn_set(SwigClassWrapper const *farg1, SUNRhsJacTimesFn farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacTimesFn arg2 = (SUNRhsJacTimesFn) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::vJpFn", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNRhsJacTimesFn)(farg2); + if (arg1) (arg1)->vJpFn = arg2; +} + + +SWIGEXPORT SUNRhsJacTimesFn _wrap_SUNAdjointStepper__vJpFn_get(SwigClassWrapper const *farg1) { + SUNRhsJacTimesFn fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacTimesFn result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::vJpFn", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNRhsJacTimesFn) ((arg1)->vJpFn); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__vJPpFn_set(SwigClassWrapper const *farg1, SUNRhsJacTimesFn farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacTimesFn arg2 = (SUNRhsJacTimesFn) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::vJPpFn", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNRhsJacTimesFn)(farg2); + if (arg1) (arg1)->vJPpFn = arg2; +} + + +SWIGEXPORT SUNRhsJacTimesFn _wrap_SUNAdjointStepper__vJPpFn_get(SwigClassWrapper const *farg1) { + SUNRhsJacTimesFn fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNRhsJacTimesFn result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::vJPpFn", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNRhsJacTimesFn) ((arg1)->vJPpFn); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__nst_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::nst", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->nst = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__nst_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::nst", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->nst); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__njeval_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::njeval", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->njeval = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__njeval_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::njeval", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->njeval); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__njpeval_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::njpeval", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->njpeval = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__njpeval_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::njpeval", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->njpeval); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__njtimesv_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::njtimesv", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->njtimesv = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__njtimesv_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::njtimesv", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->njtimesv); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__njptimesv_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::njptimesv", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->njptimesv = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__njptimesv_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::njptimesv", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->njptimesv); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__nvtimesj_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::nvtimesj", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->nvtimesj = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__nvtimesj_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::nvtimesj", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->nvtimesj); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__nvtimesjp_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::nvtimesjp", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->nvtimesjp = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__nvtimesjp_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::nvtimesjp", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->nvtimesjp); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__nrecompute_set(SwigClassWrapper const *farg1, int64_t const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::nrecompute", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (int64_t)(*farg2); + if (arg1) (arg1)->nrecompute = arg2; +} + + +SWIGEXPORT int64_t _wrap_SUNAdjointStepper__nrecompute_get(SwigClassWrapper const *farg1) { + int64_t fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + int64_t result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::nrecompute", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = ((arg1)->nrecompute); + fresult = (int64_t)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__user_data_set(SwigClassWrapper const *farg1, void *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + void *arg2 = (void *) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::user_data", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (void *)(farg2); + if (arg1) (arg1)->user_data = arg2; +} + + +SWIGEXPORT void * _wrap_SUNAdjointStepper__user_data_get(SwigClassWrapper const *farg1) { + void * fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + void *result = 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::user_data", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (void *) ((arg1)->user_data); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__content_set(SwigClassWrapper const *farg1, void *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + void *arg2 = (void *) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::content", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (void *)(farg2); + if (arg1) (arg1)->content = arg2; +} + + +SWIGEXPORT void * _wrap_SUNAdjointStepper__content_get(SwigClassWrapper const *farg1) { + void * fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + void *result = 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::content", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (void *) ((arg1)->content); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__sunctx_set(SwigClassWrapper const *farg1, void *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNContext arg2 = (SUNContext) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::sunctx", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + arg2 = (SUNContext)(farg2); + if (arg1) (arg1)->sunctx = arg2; +} + + +SWIGEXPORT void * _wrap_SUNAdjointStepper__sunctx_get(SwigClassWrapper const *farg1) { + void * fresult ; + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + SUNContext result; + + SWIG_check_mutable_nonnull(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::sunctx", return 0); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + result = (SUNContext) ((arg1)->sunctx); + fresult = result; + return fresult; +} + + +SWIGEXPORT SwigClassWrapper _wrap_new_SUNAdjointStepper_() { + SwigClassWrapper fresult ; + struct SUNAdjointStepper_ *result = 0 ; + + result = (struct SUNAdjointStepper_ *)calloc(1, sizeof(struct SUNAdjointStepper_)); + fresult.cptr = result; + fresult.cmemflags = SWIG_MEM_RVALUE | (1 ? SWIG_MEM_OWN : 0); + return fresult; +} + + +SWIGEXPORT void _wrap_delete_SUNAdjointStepper_(SwigClassWrapper *farg1) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + + SWIG_check_mutable(*farg1, "struct SUNAdjointStepper_ *", "SUNAdjointStepper_", "SUNAdjointStepper_::~SUNAdjointStepper_()", return ); + arg1 = (struct SUNAdjointStepper_ *)(farg1->cptr); + free((char *) arg1); +} + + +SWIGEXPORT void _wrap_SUNAdjointStepper__op_assign__(SwigClassWrapper *farg1, SwigClassWrapper const *farg2) { + struct SUNAdjointStepper_ *arg1 = (struct SUNAdjointStepper_ *) 0 ; + struct SUNAdjointStepper_ *arg2 = 0 ; + + (void)sizeof(arg1); + (void)sizeof(arg2); + SWIG_assign(farg1, *farg2); + +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_Create(void *farg1, void *farg2, int64_t const *farg3, N_Vector farg4, double const *farg5, SUNAdjointCheckpointScheme farg6, void *farg7, void *farg8) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + SUNStepper arg2 = (SUNStepper) 0 ; + int64_t arg3 ; + N_Vector arg4 = (N_Vector) 0 ; + sunrealtype arg5 ; + SUNAdjointCheckpointScheme arg6 = (SUNAdjointCheckpointScheme) 0 ; + SUNContext arg7 = (SUNContext) 0 ; + SUNAdjointStepper *arg8 = (SUNAdjointStepper *) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (SUNStepper)(farg2); + arg3 = (int64_t)(*farg3); + arg4 = (N_Vector)(farg4); + arg5 = (sunrealtype)(*farg5); + arg6 = (SUNAdjointCheckpointScheme)(farg6); + arg7 = (SUNContext)(farg7); + arg8 = (SUNAdjointStepper *)(farg8); + result = (SUNErrCode)SUNAdjointStepper_Create(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_ReInit(void *farg1, N_Vector farg2, double const *farg3, N_Vector farg4, double const *farg5) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + sunrealtype arg3 ; + N_Vector arg4 = (N_Vector) 0 ; + sunrealtype arg5 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (sunrealtype)(*farg3); + arg4 = (N_Vector)(farg4); + arg5 = (sunrealtype)(*farg5); + result = (SUNErrCode)SUNAdjointStepper_ReInit(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_Evolve(void *farg1, double const *farg2, N_Vector farg3, double *farg4) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + sunrealtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + sunrealtype *arg4 = (sunrealtype *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (sunrealtype)(*farg2); + arg3 = (N_Vector)(farg3); + arg4 = (sunrealtype *)(farg4); + result = (SUNErrCode)SUNAdjointStepper_Evolve(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_OneStep(void *farg1, double const *farg2, N_Vector farg3, double *farg4) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + sunrealtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + sunrealtype *arg4 = (sunrealtype *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (sunrealtype)(*farg2); + arg3 = (N_Vector)(farg3); + arg4 = (sunrealtype *)(farg4); + result = (SUNErrCode)SUNAdjointStepper_OneStep(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_RecomputeFwd(void *farg1, int64_t const *farg2, double const *farg3, double const *farg4, N_Vector farg5) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + int64_t arg2 ; + sunrealtype arg3 ; + sunrealtype arg4 ; + N_Vector arg5 = (N_Vector) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (int64_t)(*farg2); + arg3 = (sunrealtype)(*farg3); + arg4 = (sunrealtype)(*farg4); + arg5 = (N_Vector)(farg5); + result = (SUNErrCode)SUNAdjointStepper_RecomputeFwd(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_SetJacFn(void *farg1, SUNRhsJacFn farg2, SUNMatrix farg3, SUNRhsJacFn farg4, SUNMatrix farg5) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + SUNRhsJacFn arg2 = (SUNRhsJacFn) 0 ; + SUNMatrix arg3 = (SUNMatrix) 0 ; + SUNRhsJacFn arg4 = (SUNRhsJacFn) 0 ; + SUNMatrix arg5 = (SUNMatrix) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (SUNRhsJacFn)(farg2); + arg3 = (SUNMatrix)(farg3); + arg4 = (SUNRhsJacFn)(farg4); + arg5 = (SUNMatrix)(farg5); + result = (SUNErrCode)SUNAdjointStepper_SetJacFn(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_SetJacTimesVecFn(void *farg1, SUNRhsJacTimesFn farg2, SUNRhsJacTimesFn farg3) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + SUNRhsJacTimesFn arg2 = (SUNRhsJacTimesFn) 0 ; + SUNRhsJacTimesFn arg3 = (SUNRhsJacTimesFn) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (SUNRhsJacTimesFn)(farg2); + arg3 = (SUNRhsJacTimesFn)(farg3); + result = (SUNErrCode)SUNAdjointStepper_SetJacTimesVecFn(arg1,arg2,arg3); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_SetVecTimesJacFn(void *farg1, SUNRhsJacTimesFn farg2, SUNRhsJacTimesFn farg3) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + SUNRhsJacTimesFn arg2 = (SUNRhsJacTimesFn) 0 ; + SUNRhsJacTimesFn arg3 = (SUNRhsJacTimesFn) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (SUNRhsJacTimesFn)(farg2); + arg3 = (SUNRhsJacTimesFn)(farg3); + result = (SUNErrCode)SUNAdjointStepper_SetVecTimesJacFn(arg1,arg2,arg3); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_SetUserData(void *farg1, void *farg2) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + void *arg2 = (void *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (void *)(farg2); + result = (SUNErrCode)SUNAdjointStepper_SetUserData(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_PrintAllStats(void *farg1, void *farg2, int const *farg3) { + int fresult ; + SUNAdjointStepper arg1 = (SUNAdjointStepper) 0 ; + FILE *arg2 = (FILE *) 0 ; + SUNOutputFormat arg3 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper)(farg1); + arg2 = (FILE *)(farg2); + arg3 = (SUNOutputFormat)(*farg3); + result = (SUNErrCode)SUNAdjointStepper_PrintAllStats(arg1,arg2,arg3); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNAdjointStepper_Destroy(void *farg1) { + int fresult ; + SUNAdjointStepper *arg1 = (SUNAdjointStepper *) 0 ; + SUNErrCode result; + + arg1 = (SUNAdjointStepper *)(farg1); + result = (SUNErrCode)SUNAdjointStepper_Destroy(arg1); + fresult = (SUNErrCode)(result); + return fresult; +} + + + diff --git a/src/sunadjoint/fmod_int64/fsunadjointstepper_mod.f90 b/src/sunadjoint/fmod_int64/fsunadjointstepper_mod.f90 new file mode 100644 index 0000000000..4001e38336 --- /dev/null +++ b/src/sunadjoint/fmod_int64/fsunadjointstepper_mod.f90 @@ -0,0 +1,1633 @@ +! This file was automatically generated by SWIG (http://www.swig.org). +! Version 4.0.0 +! +! 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-2024, 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 +! --------------------------------------------------------------- + +module fsunadjointstepper_mod + use, intrinsic :: ISO_C_BINDING + use fsundials_core_mod + use fsunadjointcheckpointscheme_mod + use fsundials_core_mod + implicit none + private + + ! DECLARATION CONSTRUCTS + + integer, parameter :: swig_cmem_own_bit = 0 + integer, parameter :: swig_cmem_rvalue_bit = 1 + integer, parameter :: swig_cmem_const_bit = 2 + type, bind(C) :: SwigClassWrapper + type(C_PTR), public :: cptr = C_NULL_PTR + integer(C_INT), public :: cmemflags = 0 + end type + ! struct struct SUNAdjointStepper_ + type, public :: SUNAdjointStepper_ + type(SwigClassWrapper), public :: swigdata + contains + procedure :: set_adj_sunstepper => swigf_SUNAdjointStepper__adj_sunstepper_set + procedure :: get_adj_sunstepper => swigf_SUNAdjointStepper__adj_sunstepper_get + procedure :: set_fwd_sunstepper => swigf_SUNAdjointStepper__fwd_sunstepper_set + procedure :: get_fwd_sunstepper => swigf_SUNAdjointStepper__fwd_sunstepper_get + procedure :: set_checkpoint_scheme => swigf_SUNAdjointStepper__checkpoint_scheme_set + procedure :: get_checkpoint_scheme => swigf_SUNAdjointStepper__checkpoint_scheme_get + procedure :: set_tf => swigf_SUNAdjointStepper__tf_set + procedure :: get_tf => swigf_SUNAdjointStepper__tf_get + procedure :: set_step_idx => swigf_SUNAdjointStepper__step_idx_set + procedure :: get_step_idx => swigf_SUNAdjointStepper__step_idx_get + procedure :: set_final_step_idx => swigf_SUNAdjointStepper__final_step_idx_set + procedure :: get_final_step_idx => swigf_SUNAdjointStepper__final_step_idx_get + procedure :: set_last_flag => swigf_SUNAdjointStepper__last_flag_set + procedure :: get_last_flag => swigf_SUNAdjointStepper__last_flag_get + procedure :: set_Jac => swigf_SUNAdjointStepper__Jac_set + procedure :: get_Jac => swigf_SUNAdjointStepper__Jac_get + procedure :: set_JacP => swigf_SUNAdjointStepper__JacP_set + procedure :: get_JacP => swigf_SUNAdjointStepper__JacP_get + procedure :: set_JacFn => swigf_SUNAdjointStepper__JacFn_set + procedure :: get_JacFn => swigf_SUNAdjointStepper__JacFn_get + procedure :: set_JacPFn => swigf_SUNAdjointStepper__JacPFn_set + procedure :: get_JacPFn => swigf_SUNAdjointStepper__JacPFn_get + procedure :: set_JvpFn => swigf_SUNAdjointStepper__JvpFn_set + procedure :: get_JvpFn => swigf_SUNAdjointStepper__JvpFn_get + procedure :: set_JPvpFn => swigf_SUNAdjointStepper__JPvpFn_set + procedure :: get_JPvpFn => swigf_SUNAdjointStepper__JPvpFn_get + procedure :: set_vJpFn => swigf_SUNAdjointStepper__vJpFn_set + procedure :: get_vJpFn => swigf_SUNAdjointStepper__vJpFn_get + procedure :: set_vJPpFn => swigf_SUNAdjointStepper__vJPpFn_set + procedure :: get_vJPpFn => swigf_SUNAdjointStepper__vJPpFn_get + procedure :: set_nst => swigf_SUNAdjointStepper__nst_set + procedure :: get_nst => swigf_SUNAdjointStepper__nst_get + procedure :: set_njeval => swigf_SUNAdjointStepper__njeval_set + procedure :: get_njeval => swigf_SUNAdjointStepper__njeval_get + procedure :: set_njpeval => swigf_SUNAdjointStepper__njpeval_set + procedure :: get_njpeval => swigf_SUNAdjointStepper__njpeval_get + procedure :: set_njtimesv => swigf_SUNAdjointStepper__njtimesv_set + procedure :: get_njtimesv => swigf_SUNAdjointStepper__njtimesv_get + procedure :: set_njptimesv => swigf_SUNAdjointStepper__njptimesv_set + procedure :: get_njptimesv => swigf_SUNAdjointStepper__njptimesv_get + procedure :: set_nvtimesj => swigf_SUNAdjointStepper__nvtimesj_set + procedure :: get_nvtimesj => swigf_SUNAdjointStepper__nvtimesj_get + procedure :: set_nvtimesjp => swigf_SUNAdjointStepper__nvtimesjp_set + procedure :: get_nvtimesjp => swigf_SUNAdjointStepper__nvtimesjp_get + procedure :: set_nrecompute => swigf_SUNAdjointStepper__nrecompute_set + procedure :: get_nrecompute => swigf_SUNAdjointStepper__nrecompute_get + procedure :: set_user_data => swigf_SUNAdjointStepper__user_data_set + procedure :: get_user_data => swigf_SUNAdjointStepper__user_data_get + procedure :: set_content => swigf_SUNAdjointStepper__content_set + procedure :: get_content => swigf_SUNAdjointStepper__content_get + procedure :: set_sunctx => swigf_SUNAdjointStepper__sunctx_set + procedure :: get_sunctx => swigf_SUNAdjointStepper__sunctx_get + procedure :: release => swigf_release_SUNAdjointStepper_ + procedure, private :: swigf_SUNAdjointStepper__op_assign__ + generic :: assignment(=) => swigf_SUNAdjointStepper__op_assign__ + end type SUNAdjointStepper_ + interface SUNAdjointStepper_ + module procedure swigf_create_SUNAdjointStepper_ + end interface + public :: FSUNAdjointStepper_Create + public :: FSUNAdjointStepper_ReInit + public :: FSUNAdjointStepper_Evolve + public :: FSUNAdjointStepper_OneStep + public :: FSUNAdjointStepper_RecomputeFwd + public :: FSUNAdjointStepper_SetJacFn + public :: FSUNAdjointStepper_SetJacTimesVecFn + public :: FSUNAdjointStepper_SetVecTimesJacFn + public :: FSUNAdjointStepper_SetUserData + public :: FSUNAdjointStepper_PrintAllStats + public :: FSUNAdjointStepper_Destroy + +! WRAPPER DECLARATIONS +interface +subroutine swigc_SUNAdjointStepper__adj_sunstepper_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__adj_sunstepper_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__adj_sunstepper_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__adj_sunstepper_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__fwd_sunstepper_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__fwd_sunstepper_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__fwd_sunstepper_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__fwd_sunstepper_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__checkpoint_scheme_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__checkpoint_scheme_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__checkpoint_scheme_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__checkpoint_scheme_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__tf_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__tf_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__tf_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__tf_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +real(C_DOUBLE) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__step_idx_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__step_idx_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__step_idx_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__step_idx_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__final_step_idx_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__final_step_idx_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__final_step_idx_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__final_step_idx_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__last_flag_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__last_flag_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__last_flag_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__last_flag_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__Jac_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__Jac_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__Jac_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__Jac_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__JacP_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__JacP_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__JacP_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__JacP_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__JacFn_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__JacFn_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__JacFn_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__JacFn_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__JacPFn_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__JacPFn_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__JacPFn_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__JacPFn_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__JvpFn_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__JvpFn_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__JvpFn_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__JvpFn_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__JPvpFn_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__JPvpFn_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__JPvpFn_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__JPvpFn_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__vJpFn_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__vJpFn_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__vJpFn_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__vJpFn_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__vJPpFn_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__vJPpFn_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__vJPpFn_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__vJPpFn_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__nst_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__nst_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__nst_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__nst_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__njeval_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__njeval_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__njeval_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__njeval_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__njpeval_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__njpeval_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__njpeval_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__njpeval_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__njtimesv_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__njtimesv_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__njtimesv_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__njtimesv_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__njptimesv_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__njptimesv_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__njptimesv_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__njptimesv_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__nvtimesj_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__nvtimesj_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__nvtimesj_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__nvtimesj_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__nvtimesjp_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__nvtimesjp_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__nvtimesjp_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__nvtimesjp_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__nrecompute_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__nrecompute_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__nrecompute_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__nrecompute_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__user_data_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__user_data_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__user_data_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__user_data_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__content_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__content_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__content_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__content_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_SUNAdjointStepper__sunctx_set(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__sunctx_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_SUNAdjointStepper__sunctx_get(farg1) & +bind(C, name="_wrap_SUNAdjointStepper__sunctx_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +function swigc_new_SUNAdjointStepper_() & +bind(C, name="_wrap_new_SUNAdjointStepper_") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: fresult +end function + +subroutine swigc_delete_SUNAdjointStepper_(farg1) & +bind(C, name="_wrap_delete_SUNAdjointStepper_") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper), intent(inout) :: farg1 +end subroutine + +subroutine swigc_SUNAdjointStepper__op_assign__(farg1, farg2) & +bind(C, name="_wrap_SUNAdjointStepper__op_assign__") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper), intent(inout) :: farg1 +type(SwigClassWrapper) :: farg2 +end subroutine + +function swigc_FSUNAdjointStepper_Create(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8) & +bind(C, name="_wrap_FSUNAdjointStepper_Create") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT64_T), intent(in) :: farg3 +type(C_PTR), value :: farg4 +real(C_DOUBLE), intent(in) :: farg5 +type(C_PTR), value :: farg6 +type(C_PTR), value :: farg7 +type(C_PTR), value :: farg8 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_ReInit(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNAdjointStepper_ReInit") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +real(C_DOUBLE), intent(in) :: farg3 +type(C_PTR), value :: farg4 +real(C_DOUBLE), intent(in) :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_Evolve(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNAdjointStepper_Evolve") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_OneStep(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNAdjointStepper_OneStep") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_RecomputeFwd(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNAdjointStepper_RecomputeFwd") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT64_T), intent(in) :: farg2 +real(C_DOUBLE), intent(in) :: farg3 +real(C_DOUBLE), intent(in) :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_SetJacFn(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNAdjointStepper_SetJacFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +type(C_PTR), value :: farg3 +type(C_FUNPTR), value :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_SetJacTimesVecFn(farg1, farg2, farg3) & +bind(C, name="_wrap_FSUNAdjointStepper_SetJacTimesVecFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +type(C_FUNPTR), value :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_SetVecTimesJacFn(farg1, farg2, farg3) & +bind(C, name="_wrap_FSUNAdjointStepper_SetVecTimesJacFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +type(C_FUNPTR), value :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_SetUserData(farg1, farg2) & +bind(C, name="_wrap_FSUNAdjointStepper_SetUserData") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_PrintAllStats(farg1, farg2, farg3) & +bind(C, name="_wrap_FSUNAdjointStepper_PrintAllStats") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT), intent(in) :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FSUNAdjointStepper_Destroy(farg1) & +bind(C, name="_wrap_FSUNAdjointStepper_Destroy") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +end interface + + +contains + ! MODULE SUBPROGRAMS +subroutine swigf_SUNAdjointStepper__adj_sunstepper_set(self, adj_sunstepper) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: adj_sunstepper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = adj_sunstepper +call swigc_SUNAdjointStepper__adj_sunstepper_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__adj_sunstepper_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__adj_sunstepper_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__fwd_sunstepper_set(self, fwd_sunstepper) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fwd_sunstepper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = fwd_sunstepper +call swigc_SUNAdjointStepper__fwd_sunstepper_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__fwd_sunstepper_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__fwd_sunstepper_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__checkpoint_scheme_set(self, checkpoint_scheme) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(SUNAdjointCheckpointScheme), target, intent(inout) :: checkpoint_scheme +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = c_loc(checkpoint_scheme) +call swigc_SUNAdjointStepper__checkpoint_scheme_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__checkpoint_scheme_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(SUNAdjointCheckpointScheme), pointer :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__checkpoint_scheme_get(farg1) +call c_f_pointer(fresult, swig_result) +end function + +subroutine swigf_SUNAdjointStepper__tf_set(self, tf) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +real(C_DOUBLE), intent(in) :: tf +type(SwigClassWrapper) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = self%swigdata +farg2 = tf +call swigc_SUNAdjointStepper__tf_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__tf_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +real(C_DOUBLE) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +real(C_DOUBLE) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__tf_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__step_idx_set(self, step_idx) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: step_idx +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = step_idx +call swigc_SUNAdjointStepper__step_idx_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__step_idx_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__step_idx_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__final_step_idx_set(self, final_step_idx) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: final_step_idx +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = final_step_idx +call swigc_SUNAdjointStepper__final_step_idx_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__final_step_idx_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__final_step_idx_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__last_flag_set(self, last_flag) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT), intent(in) :: last_flag +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: farg2 + +farg1 = self%swigdata +farg2 = last_flag +call swigc_SUNAdjointStepper__last_flag_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__last_flag_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__last_flag_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__Jac_set(self, jac) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(SUNMatrix), target, intent(inout) :: jac +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = c_loc(jac) +call swigc_SUNAdjointStepper__Jac_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__Jac_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(SUNMatrix), pointer :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__Jac_get(farg1) +call c_f_pointer(fresult, swig_result) +end function + +subroutine swigf_SUNAdjointStepper__JacP_set(self, jacp) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(SUNMatrix), target, intent(inout) :: jacp +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = c_loc(jacp) +call swigc_SUNAdjointStepper__JacP_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__JacP_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(SUNMatrix), pointer :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__JacP_get(farg1) +call c_f_pointer(fresult, swig_result) +end function + +subroutine swigf_SUNAdjointStepper__JacFn_set(self, jacfn) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR), intent(in), value :: jacfn +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = self%swigdata +farg2 = jacfn +call swigc_SUNAdjointStepper__JacFn_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__JacFn_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_FUNPTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__JacFn_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__JacPFn_set(self, jacpfn) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR), intent(in), value :: jacpfn +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = self%swigdata +farg2 = jacpfn +call swigc_SUNAdjointStepper__JacPFn_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__JacPFn_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_FUNPTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__JacPFn_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__JvpFn_set(self, jvpfn) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR), intent(in), value :: jvpfn +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = self%swigdata +farg2 = jvpfn +call swigc_SUNAdjointStepper__JvpFn_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__JvpFn_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_FUNPTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__JvpFn_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__JPvpFn_set(self, jpvpfn) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR), intent(in), value :: jpvpfn +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = self%swigdata +farg2 = jpvpfn +call swigc_SUNAdjointStepper__JPvpFn_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__JPvpFn_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_FUNPTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__JPvpFn_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__vJpFn_set(self, vjpfn) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR), intent(in), value :: vjpfn +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = self%swigdata +farg2 = vjpfn +call swigc_SUNAdjointStepper__vJpFn_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__vJpFn_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_FUNPTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__vJpFn_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__vJPpFn_set(self, vjppfn) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR), intent(in), value :: vjppfn +type(SwigClassWrapper) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = self%swigdata +farg2 = vjppfn +call swigc_SUNAdjointStepper__vJPpFn_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__vJPpFn_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_FUNPTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_FUNPTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__vJPpFn_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__nst_set(self, nst) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: nst +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = nst +call swigc_SUNAdjointStepper__nst_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__nst_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__nst_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__njeval_set(self, njeval) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: njeval +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = njeval +call swigc_SUNAdjointStepper__njeval_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__njeval_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__njeval_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__njpeval_set(self, njpeval) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: njpeval +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = njpeval +call swigc_SUNAdjointStepper__njpeval_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__njpeval_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__njpeval_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__njtimesv_set(self, njtimesv) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: njtimesv +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = njtimesv +call swigc_SUNAdjointStepper__njtimesv_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__njtimesv_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__njtimesv_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__njptimesv_set(self, njptimesv) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: njptimesv +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = njptimesv +call swigc_SUNAdjointStepper__njptimesv_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__njptimesv_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__njptimesv_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__nvtimesj_set(self, nvtimesj) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: nvtimesj +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = nvtimesj +call swigc_SUNAdjointStepper__nvtimesj_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__nvtimesj_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__nvtimesj_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__nvtimesjp_set(self, nvtimesjp) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: nvtimesjp +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = nvtimesjp +call swigc_SUNAdjointStepper__nvtimesjp_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__nvtimesjp_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__nvtimesjp_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__nrecompute_set(self, nrecompute) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T), intent(in) :: nrecompute +type(SwigClassWrapper) :: farg1 +integer(C_INT64_T) :: farg2 + +farg1 = self%swigdata +farg2 = nrecompute +call swigc_SUNAdjointStepper__nrecompute_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__nrecompute_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT64_T) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +integer(C_INT64_T) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__nrecompute_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__user_data_set(self, user_data) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: user_data +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = user_data +call swigc_SUNAdjointStepper__user_data_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__user_data_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__user_data_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__content_set(self, content) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: content +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = content +call swigc_SUNAdjointStepper__content_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__content_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__content_get(farg1) +swig_result = fresult +end function + +subroutine swigf_SUNAdjointStepper__sunctx_set(self, sunctx) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: sunctx +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = sunctx +call swigc_SUNAdjointStepper__sunctx_set(farg1, farg2) +end subroutine + +function swigf_SUNAdjointStepper__sunctx_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +class(SUNAdjointStepper_), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_SUNAdjointStepper__sunctx_get(farg1) +swig_result = fresult +end function + +function swigf_create_SUNAdjointStepper_() & +result(self) +use, intrinsic :: ISO_C_BINDING +type(SUNAdjointStepper_) :: self +type(SwigClassWrapper) :: fresult + +fresult = swigc_new_SUNAdjointStepper_() +self%swigdata = fresult +end function + +subroutine swigf_release_SUNAdjointStepper_(self) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(inout) :: self +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +if (btest(farg1%cmemflags, swig_cmem_own_bit)) then +call swigc_delete_SUNAdjointStepper_(farg1) +endif +farg1%cptr = C_NULL_PTR +farg1%cmemflags = 0 +self%swigdata = farg1 +end subroutine + +subroutine swigf_SUNAdjointStepper__op_assign__(self, other) +use, intrinsic :: ISO_C_BINDING +class(SUNAdjointStepper_), intent(inout) :: self +type(SUNAdjointStepper_), intent(in) :: other +type(SwigClassWrapper) :: farg1 +type(SwigClassWrapper) :: farg2 + +farg1 = self%swigdata +farg2 = other%swigdata +call swigc_SUNAdjointStepper__op_assign__(farg1, farg2) +self%swigdata = farg1 +end subroutine + +function FSUNAdjointStepper_Create(fwd_sunstepper, adj_sunstepper, final_step_idx, sf, tf, checkpoint_scheme, sunctx, & + adj_stepper) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: fwd_sunstepper +type(C_PTR) :: adj_sunstepper +integer(C_INT64_T), intent(in) :: final_step_idx +type(N_Vector), target, intent(inout) :: sf +real(C_DOUBLE), intent(in) :: tf +type(SUNAdjointCheckpointScheme), target, intent(inout) :: checkpoint_scheme +type(C_PTR) :: sunctx +type(C_PTR), target, intent(inout) :: adj_stepper +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +integer(C_INT64_T) :: farg3 +type(C_PTR) :: farg4 +real(C_DOUBLE) :: farg5 +type(C_PTR) :: farg6 +type(C_PTR) :: farg7 +type(C_PTR) :: farg8 + +farg1 = fwd_sunstepper +farg2 = adj_sunstepper +farg3 = final_step_idx +farg4 = c_loc(sf) +farg5 = tf +farg6 = c_loc(checkpoint_scheme) +farg7 = sunctx +farg8 = c_loc(adj_stepper) +fresult = swigc_FSUNAdjointStepper_Create(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8) +swig_result = fresult +end function + +function FSUNAdjointStepper_ReInit(adj, y0, t0, sf, tf) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: adj +type(N_Vector), target, intent(inout) :: y0 +real(C_DOUBLE), intent(in) :: t0 +type(N_Vector), target, intent(inout) :: sf +real(C_DOUBLE), intent(in) :: tf +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +real(C_DOUBLE) :: farg3 +type(C_PTR) :: farg4 +real(C_DOUBLE) :: farg5 + +farg1 = adj +farg2 = c_loc(y0) +farg3 = t0 +farg4 = c_loc(sf) +farg5 = tf +fresult = swigc_FSUNAdjointStepper_ReInit(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNAdjointStepper_Evolve(adj_stepper, tout, sens, tret) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: adj_stepper +real(C_DOUBLE), intent(in) :: tout +type(N_Vector), target, intent(inout) :: sens +real(C_DOUBLE), dimension(*), target, intent(inout) :: tret +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 + +farg1 = adj_stepper +farg2 = tout +farg3 = c_loc(sens) +farg4 = c_loc(tret(1)) +fresult = swigc_FSUNAdjointStepper_Evolve(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNAdjointStepper_OneStep(adj_stepper, tout, sens, tret) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: adj_stepper +real(C_DOUBLE), intent(in) :: tout +type(N_Vector), target, intent(inout) :: sens +real(C_DOUBLE), dimension(*), target, intent(inout) :: tret +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 + +farg1 = adj_stepper +farg2 = tout +farg3 = c_loc(sens) +farg4 = c_loc(tret(1)) +fresult = swigc_FSUNAdjointStepper_OneStep(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNAdjointStepper_RecomputeFwd(adj_stepper, start_idx, t0, tf, y0) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: adj_stepper +integer(C_INT64_T), intent(in) :: start_idx +real(C_DOUBLE), intent(in) :: t0 +real(C_DOUBLE), intent(in) :: tf +type(N_Vector), target, intent(inout) :: y0 +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +real(C_DOUBLE) :: farg3 +real(C_DOUBLE) :: farg4 +type(C_PTR) :: farg5 + +farg1 = adj_stepper +farg2 = start_idx +farg3 = t0 +farg4 = tf +farg5 = c_loc(y0) +fresult = swigc_FSUNAdjointStepper_RecomputeFwd(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNAdjointStepper_SetJacFn(arg0, jacfn, jac, jacpfn, jp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arg0 +type(C_FUNPTR), intent(in), value :: jacfn +type(SUNMatrix), target, intent(inout) :: jac +type(C_FUNPTR), intent(in), value :: jacpfn +type(SUNMatrix), target, intent(inout) :: jp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_PTR) :: farg3 +type(C_FUNPTR) :: farg4 +type(C_PTR) :: farg5 + +farg1 = arg0 +farg2 = jacfn +farg3 = c_loc(jac) +farg4 = jacpfn +farg5 = c_loc(jp) +fresult = swigc_FSUNAdjointStepper_SetJacFn(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNAdjointStepper_SetJacTimesVecFn(arg0, jvp, jpvp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arg0 +type(C_FUNPTR), intent(in), value :: jvp +type(C_FUNPTR), intent(in), value :: jpvp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_FUNPTR) :: farg3 + +farg1 = arg0 +farg2 = jvp +farg3 = jpvp +fresult = swigc_FSUNAdjointStepper_SetJacTimesVecFn(farg1, farg2, farg3) +swig_result = fresult +end function + +function FSUNAdjointStepper_SetVecTimesJacFn(arg0, vjp, vjpp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arg0 +type(C_FUNPTR), intent(in), value :: vjp +type(C_FUNPTR), intent(in), value :: vjpp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_FUNPTR) :: farg3 + +farg1 = arg0 +farg2 = vjp +farg3 = vjpp +fresult = swigc_FSUNAdjointStepper_SetVecTimesJacFn(farg1, farg2, farg3) +swig_result = fresult +end function + +function FSUNAdjointStepper_SetUserData(arg0, user_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arg0 +type(C_PTR) :: user_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arg0 +farg2 = user_data +fresult = swigc_FSUNAdjointStepper_SetUserData(farg1, farg2) +swig_result = fresult +end function + +function FSUNAdjointStepper_PrintAllStats(adj_stepper, outfile, fmt) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: adj_stepper +type(C_PTR) :: outfile +integer(SUNOutputFormat), intent(in) :: fmt +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +integer(C_INT) :: farg3 + +farg1 = adj_stepper +farg2 = outfile +farg3 = fmt +fresult = swigc_FSUNAdjointStepper_PrintAllStats(farg1, farg2, farg3) +swig_result = fresult +end function + +function FSUNAdjointStepper_Destroy(arg0) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR), target, intent(inout) :: arg0 +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = c_loc(arg0) +fresult = swigc_FSUNAdjointStepper_Destroy(farg1) +swig_result = fresult +end function + + +end module diff --git a/src/sunadjoint/fmod_int64/fsundials_core_mod.f90 b/src/sunadjoint/fmod_int64/fsundials_core_mod.f90 new file mode 100644 index 0000000000..66272af29f --- /dev/null +++ b/src/sunadjoint/fmod_int64/fsundials_core_mod.f90 @@ -0,0 +1,29 @@ +! This file was automatically generated by SWIG (http://www.swig.org). +! Version 4.0.0 +! +! 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-2024, 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 +! --------------------------------------------------------------- + +module fsundials_core_mod + use, intrinsic :: ISO_C_BINDING + use fsundials_core_mod + implicit none + private + + ! DECLARATION CONSTRUCTS + +end module diff --git a/src/sunadjoint/sunadjoint_checkpointscheme.c b/src/sunadjoint/sunadjoint_checkpointscheme.c new file mode 100644 index 0000000000..0a8eea7750 --- /dev/null +++ b/src/sunadjoint/sunadjoint_checkpointscheme.c @@ -0,0 +1,162 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 + * ----------------------------------------------------------------- + * SUNAdjointCheckpointScheme class definition. + * ----------------------------------------------------------------*/ + +#include +#include +#include + +#include "sundials/priv/sundials_errors_impl.h" +#include "sundials/sundials_errors.h" +#include "sundials/sundials_types.h" + +SUNErrCode SUNAdjointCheckpointScheme_NewEmpty( + SUNContext sunctx, SUNAdjointCheckpointScheme* check_scheme_ptr) +{ + SUNFunctionBegin(sunctx); + + SUNAdjointCheckpointScheme check_scheme = NULL; + check_scheme = malloc(sizeof(*check_scheme)); + SUNAssert(check_scheme, SUN_ERR_MALLOC_FAIL); + + check_scheme->sunctx = sunctx; + check_scheme->content = NULL; + check_scheme->ops = NULL; + + SUNAdjointCheckpointScheme_Ops ops = NULL; + ops = malloc(sizeof(*ops)); + SUNAssert(ops, SUN_ERR_MALLOC_FAIL); + + ops->shouldWeSave = NULL; + ops->shouldWeDelete = NULL; + ops->insertVector = NULL; + ops->loadVector = NULL; + ops->removeVector = NULL; + ops->enableDense = NULL; + ops->destroy = NULL; + + check_scheme->ops = ops; + *check_scheme_ptr = check_scheme; + + return SUN_SUCCESS; +} + +SUNErrCode SUNAdjointCheckpointScheme_ShouldWeSave( + SUNAdjointCheckpointScheme check_scheme, int64_t step_num, int64_t stage_num, + sunrealtype t, sunbooleantype* yes_or_no) +{ + SUNFunctionBegin(check_scheme->sunctx); + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + if (check_scheme->ops->shouldWeSave) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return check_scheme->ops->shouldWeSave(check_scheme, step_num, stage_num, t, + yes_or_no); + } + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNAdjointCheckpointScheme_ShouldWeDelete( + SUNAdjointCheckpointScheme check_scheme, int64_t step_num, int64_t stage_num, + sunbooleantype* yes_or_no) +{ + SUNFunctionBegin(check_scheme->sunctx); + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + if (check_scheme->ops->shouldWeDelete) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return check_scheme->ops->shouldWeDelete(check_scheme, step_num, stage_num, + yes_or_no); + } + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNAdjointCheckpointScheme_InsertVector( + SUNAdjointCheckpointScheme check_scheme, int64_t step_num, int64_t stage_num, + sunrealtype t, N_Vector state) +{ + SUNFunctionBegin(check_scheme->sunctx); + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + if (check_scheme->ops->insertVector) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return check_scheme->ops->insertVector(check_scheme, step_num, stage_num, t, + state); + } + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNAdjointCheckpointScheme_LoadVector( + SUNAdjointCheckpointScheme check_scheme, int64_t step_num, int64_t stage_num, + sunbooleantype peek, N_Vector* out, sunrealtype* tout) +{ + SUNFunctionBegin(check_scheme->sunctx); + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + if (check_scheme->ops->loadVector) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return check_scheme->ops->loadVector(check_scheme, step_num, stage_num, + peek, out, tout); + } + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNAdjointCheckpointScheme_RemoveVector( + SUNAdjointCheckpointScheme check_scheme, int64_t step_num, int64_t stage_num, + N_Vector* out) +{ + SUNFunctionBegin(check_scheme->sunctx); + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + if (check_scheme->ops->removeVector) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return check_scheme->ops->removeVector(check_scheme, step_num, stage_num, + out); + } + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNAdjointCheckpointScheme_Destroy( + SUNAdjointCheckpointScheme* check_scheme_ptr) +{ + SUNFunctionBegin((*check_scheme_ptr)->sunctx); + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + if ((*check_scheme_ptr)->ops->destroy) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return (*check_scheme_ptr)->ops->destroy(check_scheme_ptr); + } + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNAdjointCheckpointScheme_EnableDense( + SUNAdjointCheckpointScheme check_scheme, sunbooleantype on_or_off) +{ + SUNFunctionBegin(check_scheme->sunctx); + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + if (check_scheme->ops->enableDense) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return check_scheme->ops->enableDense(check_scheme, on_or_off); + } + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} diff --git a/src/sunadjoint/sunadjoint_checkpointscheme_fixed.c b/src/sunadjoint/sunadjoint_checkpointscheme_fixed.c new file mode 100644 index 0000000000..a87ce2958c --- /dev/null +++ b/src/sunadjoint/sunadjoint_checkpointscheme_fixed.c @@ -0,0 +1,313 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 + * ----------------------------------------------------------------- + * SUNAdjointCheckpointScheme_Fixed class definition. + * ----------------------------------------------------------------*/ + +#include +#include + +#include "sunadjoint/sunadjoint_checkpointscheme.h" +#include "sundatanode/sundatanode_inmem.h" +#include "sundials/sundials_errors.h" +#include "sundials/sundials_logger.h" +#include "sundials/sundials_memory.h" +#include "sundials/sundials_types.h" +#include "sundials_datanode.h" +#include "sundials_macros.h" +#include "sundials_utils.h" + +struct SUNAdjointCheckpointScheme_Fixed_Content_ +{ + SUNMemoryHelper mem_helper; + int64_t backup_interval; + int64_t interval; + sunbooleantype save_stages; + sunbooleantype keep; + SUNDataIOMode io_mode; + SUNDataNode root_node; + int64_t stepnum_of_current_insert; + SUNDataNode current_insert_step_node; + int64_t stepnum_of_current_load; + SUNDataNode current_load_step_node; +}; + +typedef struct SUNAdjointCheckpointScheme_Fixed_Content_* + SUNAdjointCheckpointScheme_Fixed_Content; + +#define GET_CONTENT(S) ((SUNAdjointCheckpointScheme_Fixed_Content)S->content) +#define PROPERTY(S, prop) (GET_CONTENT(S)->prop) + +SUNErrCode SUNAdjointCheckpointScheme_Create_Fixed( + SUNDataIOMode io_mode, SUNMemoryHelper mem_helper, int64_t interval, + int64_t estimate, sunbooleantype save_stages, sunbooleantype keep, + SUNContext sunctx, SUNAdjointCheckpointScheme* check_scheme_ptr) +{ + SUNFunctionBegin(sunctx); + + SUNAdjointCheckpointScheme check_scheme = NULL; + SUNCheckCall(SUNAdjointCheckpointScheme_NewEmpty(sunctx, &check_scheme)); + + check_scheme->ops->shouldWeSave = SUNAdjointCheckpointScheme_ShouldWeSave_Fixed; + check_scheme->ops->insertVector = SUNAdjointCheckpointScheme_InsertVector_Fixed; + check_scheme->ops->loadVector = SUNAdjointCheckpointScheme_LoadVector_Fixed; + check_scheme->ops->enableDense = SUNAdjointCheckpointScheme_EnableDense_Fixed; + check_scheme->ops->destroy = SUNAdjointCheckpointScheme_Destroy_Fixed; + + SUNAdjointCheckpointScheme_Fixed_Content content = NULL; + + content = malloc(sizeof(*content)); + SUNAssert(content, SUN_ERR_MALLOC_FAIL); + + content->mem_helper = mem_helper; + content->interval = interval; + content->save_stages = save_stages; + content->keep = keep; + content->root_node = NULL; + content->current_insert_step_node = NULL; + content->stepnum_of_current_insert = -2; + content->current_load_step_node = NULL; + content->stepnum_of_current_load = -2; + content->io_mode = io_mode; + + SUNCheckCall( + SUNDataNode_CreateObject(io_mode, estimate, sunctx, &content->root_node)); + + check_scheme->content = content; + *check_scheme_ptr = check_scheme; + + return SUN_SUCCESS; +} + +SUNErrCode SUNAdjointCheckpointScheme_ShouldWeSave_Fixed( + SUNAdjointCheckpointScheme self, int64_t step_num, int64_t stage_num, + SUNDIALS_MAYBE_UNUSED sunrealtype t, sunbooleantype* yes_or_no) +{ + SUNFunctionBegin(self->sunctx); + + if (!(step_num % PROPERTY(self, interval))) + { + if (stage_num == 0) { *yes_or_no = SUNTRUE; } + else if (PROPERTY(self, save_stages)) { *yes_or_no = SUNTRUE; } + else { *yes_or_no = SUNFALSE; } + } + else { *yes_or_no = SUNFALSE; } + + return SUN_SUCCESS; +} + +SUNErrCode SUNAdjointCheckpointScheme_InsertVector_Fixed( + SUNAdjointCheckpointScheme self, int64_t step_num, int64_t stage_num, + sunrealtype t, N_Vector state) +{ + SUNFunctionBegin(self->sunctx); + + /* If this is the first state for a step, then we need to create a + list node first to store the step and all stage solutions in. + We keep a pointer to the list node until this step is over for + fast access when inserting stages. */ + SUNDataNode step_data_node = NULL; + if (step_num != PROPERTY(self, stepnum_of_current_insert)) + { + SUNCheckCall(SUNDataNode_CreateList(PROPERTY(self, io_mode), 0, SUNCTX_, + &step_data_node)); + PROPERTY(self, current_insert_step_node) = step_data_node; + PROPERTY(self, stepnum_of_current_insert) = step_num; + + /* Store the step node in the root node object. */ + char* key = sunSignedToString(step_num); +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_EXTRA_DEBUG + SUNLogger_QueueMsg(SUNCTX_->logger, SUN_LOGLEVEL_DEBUG, __func__, + "insert-new-step", "step_num = %d", step_num); + +#endif + SUNCheckCall(SUNDataNode_AddNamedChild(PROPERTY(self, root_node), key, + step_data_node)); + free(key); + } + else { step_data_node = PROPERTY(self, current_insert_step_node); } + + /* Add the state data as a leaf node in the step node's list of children. */ + SUNDataNode solution_node = NULL; + SUNCheckCall(SUNDataNode_CreateLeaf(PROPERTY(self, io_mode), + PROPERTY(self, mem_helper), SUNCTX_, + &solution_node)); + SUNCheckCall(SUNDataNode_SetDataNvector(solution_node, state, t)); + +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_EXTRA_DEBUG + SUNLogger_QueueMsg(SUNCTX_->logger, SUN_LOGLEVEL_DEBUG, __func__, + "insert-stage", "step_num = %d, stage_num = %d, t = %g", + step_num, stage_num, t); +#endif + SUNCheckCall(SUNDataNode_AddChild(step_data_node, solution_node)); + + return SUN_SUCCESS; +} + +SUNErrCode SUNAdjointCheckpointScheme_LoadVector_Fixed( + SUNAdjointCheckpointScheme self, int64_t step_num, int64_t stage_num, + sunbooleantype peek, N_Vector* loaded_state, sunrealtype* t) +{ + SUNFunctionBegin(self->sunctx); + + SUNErrCode errcode = SUN_SUCCESS; + + /* If we are trying to load the step solution, we need to load the list which holds + the step and stage solutions. We keep a pointer to the list node until + this step is over for fast access when loading stages. */ + SUNDataNode step_data_node = NULL; + if (step_num != PROPERTY(self, stepnum_of_current_load)) + { + char* key = sunSignedToString(step_num); +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_EXTRA_DEBUG + SUNLogger_QueueMsg(SUNCTX_->logger, SUN_LOGLEVEL_DEBUG, __func__, + "try-load-new-step", "step_num = %d, stage_num = %d", + step_num, stage_num); +#endif + errcode = SUNDataNode_GetNamedChild(PROPERTY(self, root_node), key, + &step_data_node); + if (errcode == SUN_SUCCESS) + { + PROPERTY(self, current_load_step_node) = step_data_node; + PROPERTY(self, stepnum_of_current_load) = step_num; + } + else if (errcode == SUN_ERR_DATANODE_NODENOTFOUND) + { + step_data_node = NULL; + } + else { SUNCheckCall(errcode); } + free(key); + } + else { step_data_node = PROPERTY(self, current_load_step_node); } + + if (!step_data_node) + { +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_EXTRA_DEBUG + SUNLogger_QueueMsg(SUNCTX_->logger, SUN_LOGLEVEL_DEBUG, __func__, + "step-not-found", "step_num = %d, stage_num = %d", + step_num, stage_num); +#endif + return SUN_ERR_CHECKPOINT_NOT_FOUND; + } + +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_EXTRA_DEBUG + SUNLogger_QueueMsg(SUNCTX_->logger, SUN_LOGLEVEL_DEBUG, __func__, "step-loaded", + "step_num = %d, stage_num = %d", step_num, stage_num); +#endif + + SUNDataNode solution_node = NULL; + if (PROPERTY(self, keep) || peek) + { +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_EXTRA_DEBUG + SUNLogger_QueueMsg(SUNCTX_->logger, SUN_LOGLEVEL_DEBUG, __func__, + "try-load-stage", + "keep = 1, step_num = %d, stage_num = %d", step_num, + stage_num); +#endif + errcode = SUNDataNode_GetChild(step_data_node, stage_num, &solution_node); + if (errcode == SUN_ERR_DATANODE_NODENOTFOUND) { solution_node = NULL; } + else { SUNCheckCall(errcode); } + } + else + { + sunbooleantype has_children = SUNFALSE; + SUNCheckCall(SUNDataNode_HasChildren(step_data_node, &has_children)); + + if (has_children) + { +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_EXTRA_DEBUG + SUNLogger_QueueMsg(SUNCTX_->logger, SUN_LOGLEVEL_DEBUG, __func__, + "try-load-stage", + "keep = 0, step_num = %d, stage_num = %d", step_num, + stage_num); +#endif + errcode = SUNDataNode_RemoveChild(step_data_node, stage_num, + &solution_node); + if (errcode == SUN_ERR_DATANODE_NODENOTFOUND) { solution_node = NULL; } + else { SUNCheckCall(errcode); } + } + + SUNCheckCall(SUNDataNode_HasChildren(step_data_node, &has_children)); + if (!has_children) + { + char* key = sunSignedToString(step_num); +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_EXTRA_DEBUG + SUNLogger_QueueMsg(SUNCTX_->logger, SUN_LOGLEVEL_DEBUG, __func__, + "remove-step", "step_num = %d", step_num); +#endif + SUNCheckCall(SUNDataNode_RemoveNamedChild(PROPERTY(self, root_node), key, + &step_data_node)); + free(key); + SUNCheckCall(SUNDataNode_Destroy(&step_data_node)); + } + } + + if (!solution_node) + { +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_EXTRA_DEBUG + SUNLogger_QueueMsg(SUNCTX_->logger, SUN_LOGLEVEL_DEBUG, __func__, + "stage-not-found", "step_num = %d, stage_num = %d", + step_num, stage_num); +#endif + return SUN_ERR_CHECKPOINT_NOT_FOUND; + } + + SUNCheckCall(SUNDataNode_GetDataNvector(solution_node, *loaded_state, t)); +#if SUNDIALS_LOGGING_LEVEL >= SUNDIALS_LOGGING_EXTRA_DEBUG + SUNLogger_QueueMsg(SUNCTX_->logger, SUN_LOGLEVEL_DEBUG, __func__, + "stage-loaded", "step_num = %d, stage_num = %d, t = %g", + step_num, stage_num, *t); +#endif + + /* Cleanup the checkpoint memory if need be */ + if (!(PROPERTY(self, keep) || peek)) + { + SUNCheckCall(SUNDataNode_Destroy(&solution_node)); + } + + return SUN_SUCCESS; +} + +SUNErrCode SUNAdjointCheckpointScheme_Destroy_Fixed( + SUNAdjointCheckpointScheme* check_scheme_ptr) +{ + SUNFunctionBegin((*check_scheme_ptr)->sunctx); + + SUNAdjointCheckpointScheme self = *check_scheme_ptr; + SUNAdjointCheckpointScheme_Fixed_Content content = + (SUNAdjointCheckpointScheme_Fixed_Content)self->content; + + SUNCheckCall(SUNDataNode_Destroy(&content->root_node)); + free(content); + free(self); + + *check_scheme_ptr = NULL; + + return SUN_SUCCESS; +} + +SUNErrCode SUNAdjointCheckpointScheme_EnableDense_Fixed( + SUNAdjointCheckpointScheme check_scheme, sunbooleantype on_or_off) +{ + SUNFunctionBegin(check_scheme->sunctx); + + if (on_or_off) + { + PROPERTY(check_scheme, backup_interval) = PROPERTY(check_scheme, interval); + PROPERTY(check_scheme, interval) = 1; + } + else + { + PROPERTY(check_scheme, interval) = PROPERTY(check_scheme, backup_interval); + } + + return SUN_SUCCESS; +} diff --git a/src/sunadjoint/sunadjoint_stepper.c b/src/sunadjoint/sunadjoint_stepper.c new file mode 100644 index 0000000000..41eb3ab1d4 --- /dev/null +++ b/src/sunadjoint/sunadjoint_stepper.c @@ -0,0 +1,313 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 + * -----------------------------------------------------------------*/ + +#include +#include +#include +#include +#include +#include "sundials/sundials_types.h" +#include "sundials_macros.h" +#include "sundials_stepper_impl.h" + +SUNErrCode SUNAdjointStepper_Create( + SUNStepper fwd_sunstepper, SUNStepper adj_sunstepper, int64_t final_step_idx, + SUNDIALS_MAYBE_UNUSED N_Vector sf, sunrealtype tf, + SUNAdjointCheckpointScheme checkpoint_scheme, SUNContext sunctx, + SUNAdjointStepper* adj_stepper_ptr) +{ + SUNFunctionBegin(sunctx); + + SUNAdjointStepper adj_stepper = malloc(sizeof(struct SUNAdjointStepper_)); + SUNAssert(adj_stepper, SUN_ERR_MALLOC_FAIL); + + adj_stepper->fwd_sunstepper = fwd_sunstepper; + adj_stepper->adj_sunstepper = adj_sunstepper; + adj_stepper->checkpoint_scheme = checkpoint_scheme; + adj_stepper->Jac = NULL; + adj_stepper->JacP = NULL; + + adj_stepper->JacFn = NULL; + adj_stepper->JacPFn = NULL; + adj_stepper->JvpFn = NULL; + adj_stepper->JPvpFn = NULL; + adj_stepper->vJpFn = NULL; + adj_stepper->vJPpFn = NULL; + + adj_stepper->tf = tf; + adj_stepper->step_idx = final_step_idx; + adj_stepper->final_step_idx = final_step_idx; + adj_stepper->nst = 0; + + adj_stepper->njeval = 0; + adj_stepper->njpeval = 0; + adj_stepper->njtimesv = 0; + adj_stepper->njptimesv = 0; + adj_stepper->nvtimesj = 0; + adj_stepper->nvtimesjp = 0; + adj_stepper->nrecompute = 0; + + adj_stepper->user_data = NULL; + adj_stepper->sunctx = sunctx; + + *adj_stepper_ptr = adj_stepper; + + return SUN_SUCCESS; +} + +SUNErrCode SUNAdjointStepper_ReInit(SUNAdjointStepper adj, N_Vector y0, + sunrealtype t0, N_Vector sf, sunrealtype tf) +{ + SUNFunctionBegin(adj->sunctx); + adj->tf = tf; + adj->step_idx = adj->final_step_idx; + adj->njeval = 0; + adj->njpeval = 0; + adj->njtimesv = 0; + adj->njptimesv = 0; + adj->nvtimesj = 0; + adj->nvtimesjp = 0; + adj->nrecompute = 0; + adj->nst = 0; + SUNStepper_Reset(adj->adj_sunstepper, tf, sf, 0); + SUNStepper_Reset(adj->fwd_sunstepper, t0, y0, 0); + return SUN_SUCCESS; +} + +SUNErrCode SUNAdjointStepper_Evolve(SUNAdjointStepper adj_stepper, + sunrealtype tout, N_Vector sens, + sunrealtype* tret) + +{ + SUNFunctionBegin(adj_stepper->sunctx); + + SUNErrCode retcode = SUN_SUCCESS; + const sunrealtype zero = SUN_RCONST(0.0); + const sunrealtype one = SUN_RCONST(1.0); + sunrealtype t = adj_stepper->tf; + sunrealtype direction = (t - tout) > zero ? -one : one; + + adj_stepper->last_flag = 0; + + while ((direction == -one && t > tout) || (direction == one && t < tout)) + { + SUNCheckCall(SUNAdjointStepper_OneStep(adj_stepper, tout, sens, tret)); + if (adj_stepper->last_flag < 0) + { + retcode = SUN_ERR_ADJOINT_STEPPERFAILED; + break; + } + else { t = *tret; } + } + + return retcode; +} + +SUNErrCode SUNAdjointStepper_OneStep(SUNAdjointStepper adj_stepper, + sunrealtype tout, N_Vector sens, + sunrealtype* tret) + +{ + SUNFunctionBegin(adj_stepper->sunctx); + SUNStepper adj_sunstepper = adj_stepper->adj_sunstepper; + + SUNErrCode retcode = SUN_SUCCESS; + sunrealtype t = adj_stepper->tf; + SUNCheckCall(SUNStepper_OneStep(adj_sunstepper, tout, sens, &t)); + adj_stepper->last_flag = adj_sunstepper->last_flag; + + adj_stepper->step_idx--; + adj_stepper->nst++; + + if (adj_stepper->last_flag < 0) { retcode = SUN_ERR_ADJOINT_STEPPERFAILED; } + else if (adj_stepper->last_flag > 0) + { + retcode = SUN_ERR_ADJOINT_STEPPERINVALIDSTOP; + } + + *tret = t; + + return retcode; +} + +SUNErrCode SUNAdjointStepper_RecomputeFwd(SUNAdjointStepper adj_stepper, + int64_t start_idx, sunrealtype t0, + sunrealtype tf, N_Vector y0) +{ + SUNFunctionBegin(adj_stepper->sunctx); + + SUNErrCode retcode = SUN_SUCCESS; + + sunrealtype fwd_t = t0; + SUNStepper fwd_stepper = adj_stepper->fwd_sunstepper; + SUNCheckCall(SUNStepper_Reset(fwd_stepper, t0, y0, start_idx)); + + SUNCheckCall( + SUNAdjointCheckpointScheme_EnableDense(adj_stepper->checkpoint_scheme, 1)); + + SUNCheckCall(SUNStepper_SetStopTime(fwd_stepper, tf)); + + SUNCheckCall(SUNStepper_Evolve(fwd_stepper, tf, y0, &fwd_t)); + adj_stepper->nrecompute++; + + if (fwd_stepper->last_flag < 0) { retcode = SUN_ERR_ADJOINT_STEPPERFAILED; } + else if (fwd_stepper->last_flag > 1) + { + /* if last_flags is not a successful (0) or tstop (1) return, + we do not have a way to handle it */ + retcode = SUN_ERR_ADJOINT_STEPPERINVALIDSTOP; + } + + SUNCheckCall( + SUNAdjointCheckpointScheme_EnableDense(adj_stepper->checkpoint_scheme, 0)); + + return retcode; +} + +SUNErrCode SUNAdjointStepper_Destroy(SUNAdjointStepper* adj_stepper_ptr) +{ + SUNAdjointStepper adj_stepper = *adj_stepper_ptr; + SUNStepper_Destroy(&adj_stepper->fwd_sunstepper); + SUNStepper_Destroy(&adj_stepper->adj_sunstepper); + free(adj_stepper); + *adj_stepper_ptr = NULL; + return SUN_SUCCESS; +} + +SUNErrCode SUNAdjointStepper_SetJacFn(SUNAdjointStepper adj_stepper, + SUNRhsJacFn JacFn, SUNMatrix Jac, + SUNRhsJacFn JacPFn, SUNMatrix JacP) +{ + SUNFunctionBegin(adj_stepper->sunctx); + + adj_stepper->JacFn = JacFn; + adj_stepper->Jac = Jac; + adj_stepper->JacPFn = JacPFn; + adj_stepper->JacP = JacP; + + return SUN_SUCCESS; +} + +SUNErrCode SUNAdjointStepper_SetJacTimesVecFn(SUNAdjointStepper adj_stepper, + SUNRhsJacTimesFn Jvp, + SUNRhsJacTimesFn JPvp) +{ + SUNFunctionBegin(adj_stepper->sunctx); + + adj_stepper->JvpFn = Jvp; + adj_stepper->JPvpFn = JPvp; + + return SUN_SUCCESS; +} + +SUNErrCode SUNAdjointStepper_SetVecTimesJacFn(SUNAdjointStepper adj_stepper, + SUNRhsJacTimesFn vJp, + SUNRhsJacTimesFn vJPp) +{ + SUNFunctionBegin(adj_stepper->sunctx); + + adj_stepper->vJpFn = vJp; + adj_stepper->vJPpFn = vJPp; + + return SUN_SUCCESS; +} + +SUNErrCode SUNAdjointStepper_SetUserData(SUNAdjointStepper adj_stepper, + void* user_data) +{ + SUNFunctionBegin(adj_stepper->sunctx); + + adj_stepper->user_data = user_data; + + return SUN_SUCCESS; +} + +SUNErrCode SUNAdjointStepper_PrintAllStats(SUNAdjointStepper adj_stepper, + FILE* outfile, SUNOutputFormat fmt) +{ + switch (fmt) + { + case SUN_OUTPUTFORMAT_TABLE: + fprintf(outfile, "Num backwards steps = %lld\n", + (long long)adj_stepper->nst); + fprintf(outfile, "Num recompute passes = %lld\n", + (long long)adj_stepper->nrecompute); + if (adj_stepper->JacFn) + { + fprintf(outfile, "Jac fn evals = %lld\n", + (long long)adj_stepper->njeval); + } + if (adj_stepper->JacPFn) + { + fprintf(outfile, "JacP fn evals = %lld\n", + (long long)adj_stepper->njpeval); + } + if (adj_stepper->JvpFn) + { + fprintf(outfile, "Jac-times-v evals = %lld\n", + (long long)adj_stepper->njtimesv); + } + if (adj_stepper->JPvpFn) + { + fprintf(outfile, "JacP-times-v evals = %lld\n", + (long long)adj_stepper->njptimesv); + } + if (adj_stepper->vJpFn) + { + fprintf(outfile, "v-times-Jac evals = %lld\n", + (long long)adj_stepper->nvtimesj); + } + if (adj_stepper->vJPpFn) + { + fprintf(outfile, "v-times-Jacp evals = %lld\n", + (long long)adj_stepper->nvtimesjp); + } + break; + case SUN_OUTPUTFORMAT_CSV: + fprintf(outfile, "Num backwards steps,%lld", (long long)adj_stepper->nst); + fprintf(outfile, "Num recompute passes,%lld", + (long long)adj_stepper->nrecompute); + if (adj_stepper->JacFn) + { + fprintf(outfile, ",Jac fn evals,%lld", (long long)adj_stepper->njeval); + } + if (adj_stepper->JacPFn) + { + fprintf(outfile, ",JacP fn evals,%lld", (long long)adj_stepper->njpeval); + } + if (adj_stepper->JvpFn) + { + fprintf(outfile, ",Jac-times-v evals,%lld", + (long long)adj_stepper->njtimesv); + } + if (adj_stepper->JPvpFn) + { + fprintf(outfile, ",JacP-times-v evals,%lld", + (long long)adj_stepper->njptimesv); + } + if (adj_stepper->vJpFn) + { + fprintf(outfile, ",v-times-Jac evals,%lld", + (long long)adj_stepper->nvtimesj); + } + if (adj_stepper->vJPpFn) + { + fprintf(outfile, ",v-times-Jacp evals,%lld", + (long long)adj_stepper->nvtimesjp); + } + + break; + default: return SUN_ERR_ARG_INCOMPATIBLE; + } + + return SUN_SUCCESS; +} diff --git a/src/sundials/CMakeLists.txt b/src/sundials/CMakeLists.txt index cf31cb497e..2ab91f15e2 100644 --- a/src/sundials/CMakeLists.txt +++ b/src/sundials/CMakeLists.txt @@ -49,6 +49,7 @@ set(sundials_HEADERS sundials_nvector.hpp sundials_profiler.h sundials_profiler.hpp + sundials_stepper.h sundials_types_deprecated.h sundials_types.h sundials_version.h) @@ -78,10 +79,12 @@ endif() add_prefix(${SUNDIALS_SOURCE_DIR}/include/sundials/ sundials_HEADERS) set(sundials_SOURCES + sundatanode/sundatanode_inmem.c sundials_adaptcontroller.c sundials_band.c sundials_context.c sundials_dense.c + sundials_datanode.c sundials_direct.c sundials_errors.c sundials_futils.c @@ -95,6 +98,7 @@ set(sundials_SOURCES sundials_nonlinearsolver.c sundials_nvector_senswrapper.c sundials_nvector.c + sundials_stepper.c sundials_profiler.c sundials_version.c) diff --git a/src/sundials/fmod_int32/fsundials_core_mod.c b/src/sundials/fmod_int32/fsundials_core_mod.c index 62e0215249..6603cb741f 100644 --- a/src/sundials/fmod_int32/fsundials_core_mod.c +++ b/src/sundials/fmod_int32/fsundials_core_mod.c @@ -291,6 +291,9 @@ SWIGINTERN SwigArrayWrapper SwigArrayWrapper_uninitialized() { #include "sundials/sundials_adaptcontroller.h" + +#include "sundials/sundials_stepper.h" + SWIGEXPORT void _wrap_FSUNLogErrHandlerFn(int const *farg1, SwigArrayWrapper *farg2, SwigArrayWrapper *farg3, SwigArrayWrapper *farg4, int const *farg5, void *farg6, void *farg7) { int arg1 ; char *arg2 = (char *) 0 ; @@ -1825,6 +1828,22 @@ SWIGEXPORT int _wrap_FSUNMatMatvec(SUNMatrix farg1, N_Vector farg2, N_Vector far } +SWIGEXPORT int _wrap_FSUNMatMatTransposeVec(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 ; + SUNErrCode result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (SUNErrCode)SUNMatMatTransposeVec(arg1,arg2,arg3); + fresult = (SUNErrCode)(result); + return fresult; +} + + SWIGEXPORT int _wrap_FSUNMatSpace(SUNMatrix farg1, long *farg2, long *farg3) { int fresult ; SUNMatrix arg1 = (SUNMatrix) 0 ; @@ -2641,4 +2660,292 @@ SWIGEXPORT int _wrap_FSUNAdaptController_Space(SUNAdaptController farg1, long *f } +SWIGEXPORT int _wrap_FSUNStepper_Create(void *farg1, void *farg2) { + int fresult ; + SUNContext arg1 = (SUNContext) 0 ; + SUNStepper *arg2 = (SUNStepper *) 0 ; + SUNErrCode result; + + arg1 = (SUNContext)(farg1); + arg2 = (SUNStepper *)(farg2); + result = (SUNErrCode)SUNStepper_Create(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_Destroy(void *farg1) { + int fresult ; + SUNStepper *arg1 = (SUNStepper *) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper *)(farg1); + result = (SUNErrCode)SUNStepper_Destroy(arg1); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_Evolve(void *farg1, double const *farg2, N_Vector farg3, double *farg4) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + sunrealtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + sunrealtype *arg4 = (sunrealtype *) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (sunrealtype)(*farg2); + arg3 = (N_Vector)(farg3); + arg4 = (sunrealtype *)(farg4); + result = (SUNErrCode)SUNStepper_Evolve(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_OneStep(void *farg1, double const *farg2, N_Vector farg3, double *farg4) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + sunrealtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + sunrealtype *arg4 = (sunrealtype *) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (sunrealtype)(*farg2); + arg3 = (N_Vector)(farg3); + arg4 = (sunrealtype *)(farg4); + result = (SUNErrCode)SUNStepper_OneStep(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_FullRhs(void *farg1, double const *farg2, N_Vector farg3, N_Vector farg4, int const *farg5) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + sunrealtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + SUNFullRhsMode arg5 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (sunrealtype)(*farg2); + arg3 = (N_Vector)(farg3); + arg4 = (N_Vector)(farg4); + arg5 = (SUNFullRhsMode)(*farg5); + result = (SUNErrCode)SUNStepper_FullRhs(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_Reset(void *farg1, double const *farg2, N_Vector farg3, int64_t const *farg4) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + sunrealtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + int64_t arg4 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (sunrealtype)(*farg2); + arg3 = (N_Vector)(farg3); + arg4 = (int64_t)(*farg4); + result = (SUNErrCode)SUNStepper_Reset(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetStopTime(void *farg1, double const *farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + sunrealtype arg2 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (sunrealtype)(*farg2); + result = (SUNErrCode)SUNStepper_SetStopTime(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetForcing(void *farg1, double const *farg2, double const *farg3, void *farg4, int const *farg5) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + sunrealtype arg2 ; + sunrealtype arg3 ; + N_Vector *arg4 = (N_Vector *) 0 ; + int arg5 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (sunrealtype)(*farg2); + arg3 = (sunrealtype)(*farg3); + arg4 = (N_Vector *)(farg4); + arg5 = (int)(*farg5); + result = (SUNErrCode)SUNStepper_SetForcing(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetContent(void *farg1, void *farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + void *arg2 = (void *) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (void *)(farg2); + result = (SUNErrCode)SUNStepper_SetContent(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_GetContent(void *farg1, void *farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + void **arg2 = (void **) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (void **)(farg2); + result = (SUNErrCode)SUNStepper_GetContent(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetLastFlag(void *farg1, int const *farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + int arg2 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (int)(*farg2); + result = (SUNErrCode)SUNStepper_SetLastFlag(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_GetLastFlag(void *farg1, int *farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + int *arg2 = (int *) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (int *)(farg2); + result = (SUNErrCode)SUNStepper_GetLastFlag(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetEvolveFn(void *farg1, SUNStepperEvolveFn farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + SUNStepperEvolveFn arg2 = (SUNStepperEvolveFn) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (SUNStepperEvolveFn)(farg2); + result = (SUNErrCode)SUNStepper_SetEvolveFn(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetOneStepFn(void *farg1, SUNStepperOneStepFn farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + SUNStepperOneStepFn arg2 = (SUNStepperOneStepFn) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (SUNStepperOneStepFn)(farg2); + result = (SUNErrCode)SUNStepper_SetOneStepFn(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetFullRhsFn(void *farg1, SUNStepperFullRhsFn farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + SUNStepperFullRhsFn arg2 = (SUNStepperFullRhsFn) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (SUNStepperFullRhsFn)(farg2); + result = (SUNErrCode)SUNStepper_SetFullRhsFn(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetResetFn(void *farg1, SUNStepperResetFn farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + SUNStepperResetFn arg2 = (SUNStepperResetFn) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (SUNStepperResetFn)(farg2); + result = (SUNErrCode)SUNStepper_SetResetFn(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetStopTimeFn(void *farg1, SUNStepperSetStopTimeFn farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + SUNStepperSetStopTimeFn arg2 = (SUNStepperSetStopTimeFn) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (SUNStepperSetStopTimeFn)(farg2); + result = (SUNErrCode)SUNStepper_SetStopTimeFn(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetForcingFn(void *farg1, SUNStepperSetForcingFn farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + SUNStepperSetForcingFn arg2 = (SUNStepperSetForcingFn) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (SUNStepperSetForcingFn)(farg2); + result = (SUNErrCode)SUNStepper_SetForcingFn(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetDestroyFn(void *farg1, SUNStepperDestroyFn farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + SUNStepperDestroyFn arg2 = (SUNStepperDestroyFn) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (SUNStepperDestroyFn)(farg2); + result = (SUNErrCode)SUNStepper_SetDestroyFn(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + diff --git a/src/sundials/fmod_int32/fsundials_core_mod.f90 b/src/sundials/fmod_int32/fsundials_core_mod.f90 index 2bda4cb0fe..7676e30df2 100644 --- a/src/sundials/fmod_int32/fsundials_core_mod.f90 +++ b/src/sundials/fmod_int32/fsundials_core_mod.f90 @@ -56,6 +56,12 @@ module fsundials_core_mod end enum integer, parameter, public :: SUNOutputFormat = kind(SUN_OUTPUTFORMAT_TABLE) public :: SUN_OUTPUTFORMAT_TABLE, SUN_OUTPUTFORMAT_CSV + ! typedef enum SUNDataIOMode + enum, bind(c) + enumerator :: SUNDATAIOMODE_INMEM + end enum + integer, parameter, public :: SUNDataIOMode = kind(SUNDATAIOMODE_INMEM) + public :: SUNDATAIOMODE_INMEM enum, bind(c) enumerator :: SUN_ERR_MINIMUM = -10000 enumerator :: SUN_ERR_ARG_CORRUPT @@ -74,11 +80,15 @@ module fsundials_core_mod enumerator :: SUN_ERR_DESTROY_FAIL enumerator :: SUN_ERR_NOT_IMPLEMENTED enumerator :: SUN_ERR_USER_FCN_FAIL + enumerator :: SUN_ERR_DATANODE_NODENOTFOUND enumerator :: SUN_ERR_PROFILER_MAPFULL enumerator :: SUN_ERR_PROFILER_MAPGET enumerator :: SUN_ERR_PROFILER_MAPINSERT enumerator :: SUN_ERR_PROFILER_MAPKEYNOTFOUND enumerator :: SUN_ERR_PROFILER_MAPSORT + enumerator :: SUN_ERR_ADJOINT_STEPPERFAILED + enumerator :: SUN_ERR_ADJOINT_STEPPERINVALIDSTOP + enumerator :: SUN_ERR_CHECKPOINT_NOT_FOUND enumerator :: SUN_ERR_SUNCTX_CORRUPT enumerator :: SUN_ERR_MPI_FAIL enumerator :: SUN_ERR_UNREACHABLE @@ -89,9 +99,10 @@ module fsundials_core_mod public :: SUN_ERR_MINIMUM, SUN_ERR_ARG_CORRUPT, SUN_ERR_ARG_INCOMPATIBLE, SUN_ERR_ARG_OUTOFRANGE, SUN_ERR_ARG_WRONGTYPE, & SUN_ERR_ARG_DIMSMISMATCH, SUN_ERR_GENERIC, SUN_ERR_CORRUPT, SUN_ERR_OUTOFRANGE, SUN_ERR_FILE_OPEN, SUN_ERR_OP_FAIL, & SUN_ERR_MEM_FAIL, SUN_ERR_MALLOC_FAIL, SUN_ERR_EXT_FAIL, SUN_ERR_DESTROY_FAIL, SUN_ERR_NOT_IMPLEMENTED, & - SUN_ERR_USER_FCN_FAIL, SUN_ERR_PROFILER_MAPFULL, SUN_ERR_PROFILER_MAPGET, SUN_ERR_PROFILER_MAPINSERT, & - SUN_ERR_PROFILER_MAPKEYNOTFOUND, SUN_ERR_PROFILER_MAPSORT, SUN_ERR_SUNCTX_CORRUPT, SUN_ERR_MPI_FAIL, SUN_ERR_UNREACHABLE, & - SUN_ERR_UNKNOWN, SUN_ERR_MAXIMUM, SUN_SUCCESS + SUN_ERR_USER_FCN_FAIL, SUN_ERR_DATANODE_NODENOTFOUND, SUN_ERR_PROFILER_MAPFULL, SUN_ERR_PROFILER_MAPGET, & + SUN_ERR_PROFILER_MAPINSERT, SUN_ERR_PROFILER_MAPKEYNOTFOUND, SUN_ERR_PROFILER_MAPSORT, SUN_ERR_ADJOINT_STEPPERFAILED, & + SUN_ERR_ADJOINT_STEPPERINVALIDSTOP, SUN_ERR_CHECKPOINT_NOT_FOUND, SUN_ERR_SUNCTX_CORRUPT, SUN_ERR_MPI_FAIL, & + SUN_ERR_UNREACHABLE, SUN_ERR_UNKNOWN, SUN_ERR_MAXIMUM, SUN_SUCCESS type, bind(C) :: SwigArrayWrapper type(C_PTR), public :: data = C_NULL_PTR integer(C_SIZE_T), public :: size = 0 @@ -324,6 +335,7 @@ module fsundials_core_mod type(C_FUNPTR), public :: scaleaddi type(C_FUNPTR), public :: matvecsetup type(C_FUNPTR), public :: matvec + type(C_FUNPTR), public :: mattransposevec type(C_FUNPTR), public :: space end type SUNMatrix_Ops ! struct struct _generic_SUNMatrix @@ -344,6 +356,7 @@ module fsundials_core_mod public :: FSUNMatScaleAddI public :: FSUNMatMatvecSetup public :: FSUNMatMatvec + public :: FSUNMatMatTransposeVec public :: FSUNMatSpace enum, bind(c) enumerator :: SUN_PREC_NONE @@ -543,6 +556,33 @@ module fsundials_core_mod public :: FSUNAdaptController_SetErrorBias public :: FSUNAdaptController_UpdateH public :: FSUNAdaptController_Space + ! typedef enum SUNFullRhsMode + enum, bind(c) + enumerator :: SUN_FULLRHS_START + enumerator :: SUN_FULLRHS_END + enumerator :: SUN_FULLRHS_OTHER + end enum + integer, parameter, public :: SUNFullRhsMode = kind(SUN_FULLRHS_START) + public :: SUN_FULLRHS_START, SUN_FULLRHS_END, SUN_FULLRHS_OTHER + public :: FSUNStepper_Create + public :: FSUNStepper_Destroy + public :: FSUNStepper_Evolve + public :: FSUNStepper_OneStep + public :: FSUNStepper_FullRhs + public :: FSUNStepper_Reset + public :: FSUNStepper_SetStopTime + public :: FSUNStepper_SetForcing + public :: FSUNStepper_SetContent + public :: FSUNStepper_GetContent + public :: FSUNStepper_SetLastFlag + public :: FSUNStepper_GetLastFlag + public :: FSUNStepper_SetEvolveFn + public :: FSUNStepper_SetOneStepFn + public :: FSUNStepper_SetFullRhsFn + public :: FSUNStepper_SetResetFn + public :: FSUNStepper_SetStopTimeFn + public :: FSUNStepper_SetForcingFn + public :: FSUNStepper_SetDestroyFn ! WRAPPER DECLARATIONS interface @@ -1525,6 +1565,16 @@ function swigc_FSUNMatMatvec(farg1, farg2, farg3) & integer(C_INT) :: fresult end function +function swigc_FSUNMatMatTransposeVec(farg1, farg2, farg3) & +bind(C, name="_wrap_FSUNMatMatTransposeVec") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT) :: fresult +end function + function swigc_FSUNMatSpace(farg1, farg2, farg3) & bind(C, name="_wrap_FSUNMatSpace") & result(fresult) @@ -2041,6 +2091,188 @@ function swigc_FSUNAdaptController_Space(farg1, farg2, farg3) & integer(C_INT) :: fresult end function +function swigc_FSUNStepper_Create(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_Create") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_Destroy(farg1) & +bind(C, name="_wrap_FSUNStepper_Destroy") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_Evolve(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNStepper_Evolve") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_OneStep(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNStepper_OneStep") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_FullRhs(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNStepper_FullRhs") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT), intent(in) :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_Reset(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNStepper_Reset") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT64_T), intent(in) :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetStopTime(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetStopTime") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetForcing(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNStepper_SetForcing") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +real(C_DOUBLE), intent(in) :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT), intent(in) :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetContent(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetContent") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_GetContent(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_GetContent") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetLastFlag(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetLastFlag") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT), intent(in) :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_GetLastFlag(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_GetLastFlag") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetEvolveFn(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetEvolveFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetOneStepFn(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetOneStepFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetFullRhsFn(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetFullRhsFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetResetFn(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetResetFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetStopTimeFn(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetStopTimeFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetForcingFn(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetForcingFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetDestroyFn(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetDestroyFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +integer(C_INT) :: fresult +end function + end interface @@ -3822,6 +4054,25 @@ function FSUNMatMatvec(a, x, y) & swig_result = fresult end function +function FSUNMatMatTransposeVec(a, x, y) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNMatrix), target, intent(inout) :: a +type(N_Vector), target, intent(inout) :: x +type(N_Vector), target, intent(inout) :: y +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = c_loc(a) +farg2 = c_loc(x) +farg3 = c_loc(y) +fresult = swigc_FSUNMatMatTransposeVec(farg1, farg2, farg3) +swig_result = fresult +end function + function FSUNMatSpace(a, lenrw, leniw) & result(swig_result) use, intrinsic :: ISO_C_BINDING @@ -4782,5 +5033,342 @@ function FSUNAdaptController_Space(c, lenrw, leniw) & swig_result = fresult end function +function FSUNStepper_Create(sunctx, stepper) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: sunctx +type(C_PTR), target, intent(inout) :: stepper +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = sunctx +farg2 = c_loc(stepper) +fresult = swigc_FSUNStepper_Create(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_Destroy(stepper) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR), target, intent(inout) :: stepper +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = c_loc(stepper) +fresult = swigc_FSUNStepper_Destroy(farg1) +swig_result = fresult +end function + +function FSUNStepper_Evolve(stepper, tout, vret, tret) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +real(C_DOUBLE), intent(in) :: tout +type(N_Vector), target, intent(inout) :: vret +real(C_DOUBLE), dimension(*), target, intent(inout) :: tret +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 + +farg1 = stepper +farg2 = tout +farg3 = c_loc(vret) +farg4 = c_loc(tret(1)) +fresult = swigc_FSUNStepper_Evolve(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNStepper_OneStep(stepper, tout, vout, tret) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +real(C_DOUBLE), intent(in) :: tout +type(N_Vector), target, intent(inout) :: vout +real(C_DOUBLE), dimension(*), target, intent(inout) :: tret +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 + +farg1 = stepper +farg2 = tout +farg3 = c_loc(vout) +farg4 = c_loc(tret(1)) +fresult = swigc_FSUNStepper_OneStep(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNStepper_FullRhs(stepper, t, v, f, mode) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +real(C_DOUBLE), intent(in) :: t +type(N_Vector), target, intent(inout) :: v +type(N_Vector), target, intent(inout) :: f +integer(SUNFullRhsMode), intent(in) :: mode +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 +integer(C_INT) :: farg5 + +farg1 = stepper +farg2 = t +farg3 = c_loc(v) +farg4 = c_loc(f) +farg5 = mode +fresult = swigc_FSUNStepper_FullRhs(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNStepper_Reset(stepper, tr, vr, ckptidxr) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +real(C_DOUBLE), intent(in) :: tr +type(N_Vector), target, intent(inout) :: vr +integer(C_INT64_T), intent(in) :: ckptidxr +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 +integer(C_INT64_T) :: farg4 + +farg1 = stepper +farg2 = tr +farg3 = c_loc(vr) +farg4 = ckptidxr +fresult = swigc_FSUNStepper_Reset(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNStepper_SetStopTime(stepper, tstop) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +real(C_DOUBLE), intent(in) :: tstop +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = stepper +farg2 = tstop +fresult = swigc_FSUNStepper_SetStopTime(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetForcing(stepper, tshift, tscale, forcing, nforcing) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +real(C_DOUBLE), intent(in) :: tshift +real(C_DOUBLE), intent(in) :: tscale +type(C_PTR) :: forcing +integer(C_INT), intent(in) :: nforcing +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +real(C_DOUBLE) :: farg3 +type(C_PTR) :: farg4 +integer(C_INT) :: farg5 + +farg1 = stepper +farg2 = tshift +farg3 = tscale +farg4 = forcing +farg5 = nforcing +fresult = swigc_FSUNStepper_SetForcing(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNStepper_SetContent(stepper, content) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_PTR) :: content +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = stepper +farg2 = content +fresult = swigc_FSUNStepper_SetContent(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_GetContent(stepper, content) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_PTR), target, intent(inout) :: content +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = stepper +farg2 = c_loc(content) +fresult = swigc_FSUNStepper_GetContent(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetLastFlag(stepper, last_flag) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +integer(C_INT), intent(in) :: last_flag +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = stepper +farg2 = last_flag +fresult = swigc_FSUNStepper_SetLastFlag(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_GetLastFlag(stepper, last_flag) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +integer(C_INT), dimension(*), target, intent(inout) :: last_flag +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = stepper +farg2 = c_loc(last_flag(1)) +fresult = swigc_FSUNStepper_GetLastFlag(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetEvolveFn(stepper, fn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_FUNPTR), intent(in), value :: fn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = stepper +farg2 = fn +fresult = swigc_FSUNStepper_SetEvolveFn(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetOneStepFn(stepper, fn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_FUNPTR), intent(in), value :: fn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = stepper +farg2 = fn +fresult = swigc_FSUNStepper_SetOneStepFn(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetFullRhsFn(stepper, fn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_FUNPTR), intent(in), value :: fn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = stepper +farg2 = fn +fresult = swigc_FSUNStepper_SetFullRhsFn(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetResetFn(stepper, fn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_FUNPTR), intent(in), value :: fn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = stepper +farg2 = fn +fresult = swigc_FSUNStepper_SetResetFn(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetStopTimeFn(stepper, fn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_FUNPTR), intent(in), value :: fn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = stepper +farg2 = fn +fresult = swigc_FSUNStepper_SetStopTimeFn(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetForcingFn(stepper, fn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_FUNPTR), intent(in), value :: fn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = stepper +farg2 = fn +fresult = swigc_FSUNStepper_SetForcingFn(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetDestroyFn(stepper, fn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_FUNPTR), intent(in), value :: fn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = stepper +farg2 = fn +fresult = swigc_FSUNStepper_SetDestroyFn(farg1, farg2) +swig_result = fresult +end function + end module diff --git a/src/sundials/fmod_int64/fsundials_core_mod.c b/src/sundials/fmod_int64/fsundials_core_mod.c index 2478b92d68..bf6f97c4c4 100644 --- a/src/sundials/fmod_int64/fsundials_core_mod.c +++ b/src/sundials/fmod_int64/fsundials_core_mod.c @@ -291,6 +291,9 @@ SWIGINTERN SwigArrayWrapper SwigArrayWrapper_uninitialized() { #include "sundials/sundials_adaptcontroller.h" + +#include "sundials/sundials_stepper.h" + SWIGEXPORT void _wrap_FSUNLogErrHandlerFn(int const *farg1, SwigArrayWrapper *farg2, SwigArrayWrapper *farg3, SwigArrayWrapper *farg4, int const *farg5, void *farg6, void *farg7) { int arg1 ; char *arg2 = (char *) 0 ; @@ -1825,6 +1828,22 @@ SWIGEXPORT int _wrap_FSUNMatMatvec(SUNMatrix farg1, N_Vector farg2, N_Vector far } +SWIGEXPORT int _wrap_FSUNMatMatTransposeVec(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 ; + SUNErrCode result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (SUNErrCode)SUNMatMatTransposeVec(arg1,arg2,arg3); + fresult = (SUNErrCode)(result); + return fresult; +} + + SWIGEXPORT int _wrap_FSUNMatSpace(SUNMatrix farg1, long *farg2, long *farg3) { int fresult ; SUNMatrix arg1 = (SUNMatrix) 0 ; @@ -2641,4 +2660,292 @@ SWIGEXPORT int _wrap_FSUNAdaptController_Space(SUNAdaptController farg1, long *f } +SWIGEXPORT int _wrap_FSUNStepper_Create(void *farg1, void *farg2) { + int fresult ; + SUNContext arg1 = (SUNContext) 0 ; + SUNStepper *arg2 = (SUNStepper *) 0 ; + SUNErrCode result; + + arg1 = (SUNContext)(farg1); + arg2 = (SUNStepper *)(farg2); + result = (SUNErrCode)SUNStepper_Create(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_Destroy(void *farg1) { + int fresult ; + SUNStepper *arg1 = (SUNStepper *) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper *)(farg1); + result = (SUNErrCode)SUNStepper_Destroy(arg1); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_Evolve(void *farg1, double const *farg2, N_Vector farg3, double *farg4) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + sunrealtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + sunrealtype *arg4 = (sunrealtype *) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (sunrealtype)(*farg2); + arg3 = (N_Vector)(farg3); + arg4 = (sunrealtype *)(farg4); + result = (SUNErrCode)SUNStepper_Evolve(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_OneStep(void *farg1, double const *farg2, N_Vector farg3, double *farg4) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + sunrealtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + sunrealtype *arg4 = (sunrealtype *) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (sunrealtype)(*farg2); + arg3 = (N_Vector)(farg3); + arg4 = (sunrealtype *)(farg4); + result = (SUNErrCode)SUNStepper_OneStep(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_FullRhs(void *farg1, double const *farg2, N_Vector farg3, N_Vector farg4, int const *farg5) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + sunrealtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + N_Vector arg4 = (N_Vector) 0 ; + SUNFullRhsMode arg5 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (sunrealtype)(*farg2); + arg3 = (N_Vector)(farg3); + arg4 = (N_Vector)(farg4); + arg5 = (SUNFullRhsMode)(*farg5); + result = (SUNErrCode)SUNStepper_FullRhs(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_Reset(void *farg1, double const *farg2, N_Vector farg3, int64_t const *farg4) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + sunrealtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + int64_t arg4 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (sunrealtype)(*farg2); + arg3 = (N_Vector)(farg3); + arg4 = (int64_t)(*farg4); + result = (SUNErrCode)SUNStepper_Reset(arg1,arg2,arg3,arg4); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetStopTime(void *farg1, double const *farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + sunrealtype arg2 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (sunrealtype)(*farg2); + result = (SUNErrCode)SUNStepper_SetStopTime(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetForcing(void *farg1, double const *farg2, double const *farg3, void *farg4, int const *farg5) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + sunrealtype arg2 ; + sunrealtype arg3 ; + N_Vector *arg4 = (N_Vector *) 0 ; + int arg5 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (sunrealtype)(*farg2); + arg3 = (sunrealtype)(*farg3); + arg4 = (N_Vector *)(farg4); + arg5 = (int)(*farg5); + result = (SUNErrCode)SUNStepper_SetForcing(arg1,arg2,arg3,arg4,arg5); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetContent(void *farg1, void *farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + void *arg2 = (void *) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (void *)(farg2); + result = (SUNErrCode)SUNStepper_SetContent(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_GetContent(void *farg1, void *farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + void **arg2 = (void **) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (void **)(farg2); + result = (SUNErrCode)SUNStepper_GetContent(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetLastFlag(void *farg1, int const *farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + int arg2 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (int)(*farg2); + result = (SUNErrCode)SUNStepper_SetLastFlag(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_GetLastFlag(void *farg1, int *farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + int *arg2 = (int *) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (int *)(farg2); + result = (SUNErrCode)SUNStepper_GetLastFlag(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetEvolveFn(void *farg1, SUNStepperEvolveFn farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + SUNStepperEvolveFn arg2 = (SUNStepperEvolveFn) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (SUNStepperEvolveFn)(farg2); + result = (SUNErrCode)SUNStepper_SetEvolveFn(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetOneStepFn(void *farg1, SUNStepperOneStepFn farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + SUNStepperOneStepFn arg2 = (SUNStepperOneStepFn) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (SUNStepperOneStepFn)(farg2); + result = (SUNErrCode)SUNStepper_SetOneStepFn(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetFullRhsFn(void *farg1, SUNStepperFullRhsFn farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + SUNStepperFullRhsFn arg2 = (SUNStepperFullRhsFn) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (SUNStepperFullRhsFn)(farg2); + result = (SUNErrCode)SUNStepper_SetFullRhsFn(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetResetFn(void *farg1, SUNStepperResetFn farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + SUNStepperResetFn arg2 = (SUNStepperResetFn) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (SUNStepperResetFn)(farg2); + result = (SUNErrCode)SUNStepper_SetResetFn(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetStopTimeFn(void *farg1, SUNStepperSetStopTimeFn farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + SUNStepperSetStopTimeFn arg2 = (SUNStepperSetStopTimeFn) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (SUNStepperSetStopTimeFn)(farg2); + result = (SUNErrCode)SUNStepper_SetStopTimeFn(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetForcingFn(void *farg1, SUNStepperSetForcingFn farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + SUNStepperSetForcingFn arg2 = (SUNStepperSetForcingFn) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (SUNStepperSetForcingFn)(farg2); + result = (SUNErrCode)SUNStepper_SetForcingFn(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FSUNStepper_SetDestroyFn(void *farg1, SUNStepperDestroyFn farg2) { + int fresult ; + SUNStepper arg1 = (SUNStepper) 0 ; + SUNStepperDestroyFn arg2 = (SUNStepperDestroyFn) 0 ; + SUNErrCode result; + + arg1 = (SUNStepper)(farg1); + arg2 = (SUNStepperDestroyFn)(farg2); + result = (SUNErrCode)SUNStepper_SetDestroyFn(arg1,arg2); + fresult = (SUNErrCode)(result); + return fresult; +} + + diff --git a/src/sundials/fmod_int64/fsundials_core_mod.f90 b/src/sundials/fmod_int64/fsundials_core_mod.f90 index 7096d0c6ce..614a0e76db 100644 --- a/src/sundials/fmod_int64/fsundials_core_mod.f90 +++ b/src/sundials/fmod_int64/fsundials_core_mod.f90 @@ -56,6 +56,12 @@ module fsundials_core_mod end enum integer, parameter, public :: SUNOutputFormat = kind(SUN_OUTPUTFORMAT_TABLE) public :: SUN_OUTPUTFORMAT_TABLE, SUN_OUTPUTFORMAT_CSV + ! typedef enum SUNDataIOMode + enum, bind(c) + enumerator :: SUNDATAIOMODE_INMEM + end enum + integer, parameter, public :: SUNDataIOMode = kind(SUNDATAIOMODE_INMEM) + public :: SUNDATAIOMODE_INMEM enum, bind(c) enumerator :: SUN_ERR_MINIMUM = -10000 enumerator :: SUN_ERR_ARG_CORRUPT @@ -74,11 +80,15 @@ module fsundials_core_mod enumerator :: SUN_ERR_DESTROY_FAIL enumerator :: SUN_ERR_NOT_IMPLEMENTED enumerator :: SUN_ERR_USER_FCN_FAIL + enumerator :: SUN_ERR_DATANODE_NODENOTFOUND enumerator :: SUN_ERR_PROFILER_MAPFULL enumerator :: SUN_ERR_PROFILER_MAPGET enumerator :: SUN_ERR_PROFILER_MAPINSERT enumerator :: SUN_ERR_PROFILER_MAPKEYNOTFOUND enumerator :: SUN_ERR_PROFILER_MAPSORT + enumerator :: SUN_ERR_ADJOINT_STEPPERFAILED + enumerator :: SUN_ERR_ADJOINT_STEPPERINVALIDSTOP + enumerator :: SUN_ERR_CHECKPOINT_NOT_FOUND enumerator :: SUN_ERR_SUNCTX_CORRUPT enumerator :: SUN_ERR_MPI_FAIL enumerator :: SUN_ERR_UNREACHABLE @@ -89,9 +99,10 @@ module fsundials_core_mod public :: SUN_ERR_MINIMUM, SUN_ERR_ARG_CORRUPT, SUN_ERR_ARG_INCOMPATIBLE, SUN_ERR_ARG_OUTOFRANGE, SUN_ERR_ARG_WRONGTYPE, & SUN_ERR_ARG_DIMSMISMATCH, SUN_ERR_GENERIC, SUN_ERR_CORRUPT, SUN_ERR_OUTOFRANGE, SUN_ERR_FILE_OPEN, SUN_ERR_OP_FAIL, & SUN_ERR_MEM_FAIL, SUN_ERR_MALLOC_FAIL, SUN_ERR_EXT_FAIL, SUN_ERR_DESTROY_FAIL, SUN_ERR_NOT_IMPLEMENTED, & - SUN_ERR_USER_FCN_FAIL, SUN_ERR_PROFILER_MAPFULL, SUN_ERR_PROFILER_MAPGET, SUN_ERR_PROFILER_MAPINSERT, & - SUN_ERR_PROFILER_MAPKEYNOTFOUND, SUN_ERR_PROFILER_MAPSORT, SUN_ERR_SUNCTX_CORRUPT, SUN_ERR_MPI_FAIL, SUN_ERR_UNREACHABLE, & - SUN_ERR_UNKNOWN, SUN_ERR_MAXIMUM, SUN_SUCCESS + SUN_ERR_USER_FCN_FAIL, SUN_ERR_DATANODE_NODENOTFOUND, SUN_ERR_PROFILER_MAPFULL, SUN_ERR_PROFILER_MAPGET, & + SUN_ERR_PROFILER_MAPINSERT, SUN_ERR_PROFILER_MAPKEYNOTFOUND, SUN_ERR_PROFILER_MAPSORT, SUN_ERR_ADJOINT_STEPPERFAILED, & + SUN_ERR_ADJOINT_STEPPERINVALIDSTOP, SUN_ERR_CHECKPOINT_NOT_FOUND, SUN_ERR_SUNCTX_CORRUPT, SUN_ERR_MPI_FAIL, & + SUN_ERR_UNREACHABLE, SUN_ERR_UNKNOWN, SUN_ERR_MAXIMUM, SUN_SUCCESS type, bind(C) :: SwigArrayWrapper type(C_PTR), public :: data = C_NULL_PTR integer(C_SIZE_T), public :: size = 0 @@ -324,6 +335,7 @@ module fsundials_core_mod type(C_FUNPTR), public :: scaleaddi type(C_FUNPTR), public :: matvecsetup type(C_FUNPTR), public :: matvec + type(C_FUNPTR), public :: mattransposevec type(C_FUNPTR), public :: space end type SUNMatrix_Ops ! struct struct _generic_SUNMatrix @@ -344,6 +356,7 @@ module fsundials_core_mod public :: FSUNMatScaleAddI public :: FSUNMatMatvecSetup public :: FSUNMatMatvec + public :: FSUNMatMatTransposeVec public :: FSUNMatSpace enum, bind(c) enumerator :: SUN_PREC_NONE @@ -543,6 +556,33 @@ module fsundials_core_mod public :: FSUNAdaptController_SetErrorBias public :: FSUNAdaptController_UpdateH public :: FSUNAdaptController_Space + ! typedef enum SUNFullRhsMode + enum, bind(c) + enumerator :: SUN_FULLRHS_START + enumerator :: SUN_FULLRHS_END + enumerator :: SUN_FULLRHS_OTHER + end enum + integer, parameter, public :: SUNFullRhsMode = kind(SUN_FULLRHS_START) + public :: SUN_FULLRHS_START, SUN_FULLRHS_END, SUN_FULLRHS_OTHER + public :: FSUNStepper_Create + public :: FSUNStepper_Destroy + public :: FSUNStepper_Evolve + public :: FSUNStepper_OneStep + public :: FSUNStepper_FullRhs + public :: FSUNStepper_Reset + public :: FSUNStepper_SetStopTime + public :: FSUNStepper_SetForcing + public :: FSUNStepper_SetContent + public :: FSUNStepper_GetContent + public :: FSUNStepper_SetLastFlag + public :: FSUNStepper_GetLastFlag + public :: FSUNStepper_SetEvolveFn + public :: FSUNStepper_SetOneStepFn + public :: FSUNStepper_SetFullRhsFn + public :: FSUNStepper_SetResetFn + public :: FSUNStepper_SetStopTimeFn + public :: FSUNStepper_SetForcingFn + public :: FSUNStepper_SetDestroyFn ! WRAPPER DECLARATIONS interface @@ -1525,6 +1565,16 @@ function swigc_FSUNMatMatvec(farg1, farg2, farg3) & integer(C_INT) :: fresult end function +function swigc_FSUNMatMatTransposeVec(farg1, farg2, farg3) & +bind(C, name="_wrap_FSUNMatMatTransposeVec") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT) :: fresult +end function + function swigc_FSUNMatSpace(farg1, farg2, farg3) & bind(C, name="_wrap_FSUNMatSpace") & result(fresult) @@ -2041,6 +2091,188 @@ function swigc_FSUNAdaptController_Space(farg1, farg2, farg3) & integer(C_INT) :: fresult end function +function swigc_FSUNStepper_Create(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_Create") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_Destroy(farg1) & +bind(C, name="_wrap_FSUNStepper_Destroy") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_Evolve(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNStepper_Evolve") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_OneStep(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNStepper_OneStep") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_FullRhs(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNStepper_FullRhs") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT), intent(in) :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_Reset(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FSUNStepper_Reset") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT64_T), intent(in) :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetStopTime(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetStopTime") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetForcing(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FSUNStepper_SetForcing") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +real(C_DOUBLE), intent(in) :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT), intent(in) :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetContent(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetContent") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_GetContent(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_GetContent") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetLastFlag(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetLastFlag") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT), intent(in) :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_GetLastFlag(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_GetLastFlag") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetEvolveFn(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetEvolveFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetOneStepFn(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetOneStepFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetFullRhsFn(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetFullRhsFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetResetFn(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetResetFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetStopTimeFn(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetStopTimeFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetForcingFn(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetForcingFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FSUNStepper_SetDestroyFn(farg1, farg2) & +bind(C, name="_wrap_FSUNStepper_SetDestroyFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +integer(C_INT) :: fresult +end function + end interface @@ -3822,6 +4054,25 @@ function FSUNMatMatvec(a, x, y) & swig_result = fresult end function +function FSUNMatMatTransposeVec(a, x, y) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNMatrix), target, intent(inout) :: a +type(N_Vector), target, intent(inout) :: x +type(N_Vector), target, intent(inout) :: y +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = c_loc(a) +farg2 = c_loc(x) +farg3 = c_loc(y) +fresult = swigc_FSUNMatMatTransposeVec(farg1, farg2, farg3) +swig_result = fresult +end function + function FSUNMatSpace(a, lenrw, leniw) & result(swig_result) use, intrinsic :: ISO_C_BINDING @@ -4782,5 +5033,342 @@ function FSUNAdaptController_Space(c, lenrw, leniw) & swig_result = fresult end function +function FSUNStepper_Create(sunctx, stepper) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: sunctx +type(C_PTR), target, intent(inout) :: stepper +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = sunctx +farg2 = c_loc(stepper) +fresult = swigc_FSUNStepper_Create(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_Destroy(stepper) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR), target, intent(inout) :: stepper +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = c_loc(stepper) +fresult = swigc_FSUNStepper_Destroy(farg1) +swig_result = fresult +end function + +function FSUNStepper_Evolve(stepper, tout, vret, tret) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +real(C_DOUBLE), intent(in) :: tout +type(N_Vector), target, intent(inout) :: vret +real(C_DOUBLE), dimension(*), target, intent(inout) :: tret +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 + +farg1 = stepper +farg2 = tout +farg3 = c_loc(vret) +farg4 = c_loc(tret(1)) +fresult = swigc_FSUNStepper_Evolve(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNStepper_OneStep(stepper, tout, vout, tret) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +real(C_DOUBLE), intent(in) :: tout +type(N_Vector), target, intent(inout) :: vout +real(C_DOUBLE), dimension(*), target, intent(inout) :: tret +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 + +farg1 = stepper +farg2 = tout +farg3 = c_loc(vout) +farg4 = c_loc(tret(1)) +fresult = swigc_FSUNStepper_OneStep(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNStepper_FullRhs(stepper, t, v, f, mode) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +real(C_DOUBLE), intent(in) :: t +type(N_Vector), target, intent(inout) :: v +type(N_Vector), target, intent(inout) :: f +integer(SUNFullRhsMode), intent(in) :: mode +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 +integer(C_INT) :: farg5 + +farg1 = stepper +farg2 = t +farg3 = c_loc(v) +farg4 = c_loc(f) +farg5 = mode +fresult = swigc_FSUNStepper_FullRhs(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNStepper_Reset(stepper, tr, vr, ckptidxr) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +real(C_DOUBLE), intent(in) :: tr +type(N_Vector), target, intent(inout) :: vr +integer(C_INT64_T), intent(in) :: ckptidxr +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 +integer(C_INT64_T) :: farg4 + +farg1 = stepper +farg2 = tr +farg3 = c_loc(vr) +farg4 = ckptidxr +fresult = swigc_FSUNStepper_Reset(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FSUNStepper_SetStopTime(stepper, tstop) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +real(C_DOUBLE), intent(in) :: tstop +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = stepper +farg2 = tstop +fresult = swigc_FSUNStepper_SetStopTime(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetForcing(stepper, tshift, tscale, forcing, nforcing) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +real(C_DOUBLE), intent(in) :: tshift +real(C_DOUBLE), intent(in) :: tscale +type(C_PTR) :: forcing +integer(C_INT), intent(in) :: nforcing +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +real(C_DOUBLE) :: farg3 +type(C_PTR) :: farg4 +integer(C_INT) :: farg5 + +farg1 = stepper +farg2 = tshift +farg3 = tscale +farg4 = forcing +farg5 = nforcing +fresult = swigc_FSUNStepper_SetForcing(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FSUNStepper_SetContent(stepper, content) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_PTR) :: content +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = stepper +farg2 = content +fresult = swigc_FSUNStepper_SetContent(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_GetContent(stepper, content) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_PTR), target, intent(inout) :: content +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = stepper +farg2 = c_loc(content) +fresult = swigc_FSUNStepper_GetContent(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetLastFlag(stepper, last_flag) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +integer(C_INT), intent(in) :: last_flag +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = stepper +farg2 = last_flag +fresult = swigc_FSUNStepper_SetLastFlag(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_GetLastFlag(stepper, last_flag) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +integer(C_INT), dimension(*), target, intent(inout) :: last_flag +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = stepper +farg2 = c_loc(last_flag(1)) +fresult = swigc_FSUNStepper_GetLastFlag(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetEvolveFn(stepper, fn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_FUNPTR), intent(in), value :: fn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = stepper +farg2 = fn +fresult = swigc_FSUNStepper_SetEvolveFn(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetOneStepFn(stepper, fn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_FUNPTR), intent(in), value :: fn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = stepper +farg2 = fn +fresult = swigc_FSUNStepper_SetOneStepFn(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetFullRhsFn(stepper, fn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_FUNPTR), intent(in), value :: fn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = stepper +farg2 = fn +fresult = swigc_FSUNStepper_SetFullRhsFn(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetResetFn(stepper, fn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_FUNPTR), intent(in), value :: fn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = stepper +farg2 = fn +fresult = swigc_FSUNStepper_SetResetFn(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetStopTimeFn(stepper, fn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_FUNPTR), intent(in), value :: fn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = stepper +farg2 = fn +fresult = swigc_FSUNStepper_SetStopTimeFn(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetForcingFn(stepper, fn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_FUNPTR), intent(in), value :: fn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = stepper +farg2 = fn +fresult = swigc_FSUNStepper_SetForcingFn(farg1, farg2) +swig_result = fresult +end function + +function FSUNStepper_SetDestroyFn(stepper, fn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: stepper +type(C_FUNPTR), intent(in), value :: fn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = stepper +farg2 = fn +fresult = swigc_FSUNStepper_SetDestroyFn(farg1, farg2) +swig_result = fresult +end function + end module diff --git a/src/sundials/stl/sunstl_vector.h b/src/sundials/stl/sunstl_vector.h new file mode 100644 index 0000000000..53386c56e5 --- /dev/null +++ b/src/sundials/stl/sunstl_vector.h @@ -0,0 +1,180 @@ +/* ----------------------------------------------------------------- + * Programmer: Cody J. Balos @ LLNL + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 of a resizable container similar to a std::vector. + * The values can be anything but data must be contiguous. + * + * To use the StlVector, first define TTYPE with your data type + * before including this header. The name of the class for your data + * type will then be SUNStlVector_TTYPE and functions will be + * SUNStlVector_TTYPE_. E.g. + * #define TTYPE int + * #include "sunstl_vector.h' + * #undef TTYPE + * SUNStlVector_int_New(10, destroyIntFn); + * If you need StlVectors that hold different types in the same file, + * then define TTYPE for the first, include this header, undefine + * TTYPE then repeat. + * -----------------------------------------------------------------*/ + +#include +#include + +#ifndef TTYPE +#error "Must define template type for SUNStlVector" +#endif + +#define CONCAT(a, b) a##b +#define PASTE(a, b) CONCAT(a, b) +#define MAKE_NAME(prefix, name) PASTE(prefix, PASTE(_, name)) + +#define SUNStlVectorTtype_s MAKE_NAME(SUNStlVector, PASTE(TTYPE, _s)) +#define SUNStlVectorTtype MAKE_NAME(SUNStlVector, TTYPE) + +typedef struct SUNStlVectorTtype_s* SUNStlVectorTtype; + +struct SUNStlVectorTtype_s +{ + int64_t size; + int64_t capacity; + TTYPE* values; + void (*destroyValue)(TTYPE*); +}; + +// This constant controls how much space will be allocated when a resize is needed. +// The new capacity is GROWTH_FACTOR*current_capacity. +// Some std::vector implementations use 2, but 1.5 will be more conservative in terms +// of the memory usage but yields a larger constant factor in terms of the +// amortized constant time complexity. +#define GROWTH_FACTOR 1.5 + +static inline SUNStlVectorTtype MAKE_NAME(SUNStlVectorTtype, + New)(int64_t init_capacity, + void (*destroyValue)(TTYPE*)) +{ + SUNStlVectorTtype self = + (SUNStlVectorTtype)malloc(sizeof(struct SUNStlVectorTtype_s)); + self->size = 0; + self->capacity = init_capacity > 0 ? init_capacity : 1; + self->values = (TTYPE*)malloc(sizeof(TTYPE) * self->capacity); + self->destroyValue = destroyValue; + return self; +} + +static inline sunbooleantype MAKE_NAME(SUNStlVectorTtype, + IsEmpty)(SUNStlVectorTtype self) +{ + return self->size == 0; +} + +static inline void MAKE_NAME(SUNStlVectorTtype, Resize)(SUNStlVectorTtype self, + int64_t new_capacity) +{ + if (new_capacity <= self->capacity) return; + TTYPE* new_values = (TTYPE*)realloc(self->values, sizeof(TTYPE) * new_capacity); + self->values = new_values; + self->capacity = new_capacity; +} + +static inline void MAKE_NAME(SUNStlVectorTtype, Grow)(SUNStlVectorTtype self) +{ + if (self->size == self->capacity) + { + int64_t new_capacity = + (int64_t)(ceil(((double)self->capacity) * GROWTH_FACTOR)); + MAKE_NAME(SUNStlVectorTtype, Resize)(self, new_capacity); + } +} + +static inline void MAKE_NAME(SUNStlVectorTtype, + PushBack)(SUNStlVectorTtype self, TTYPE element) +{ + if (self->size == self->capacity) + { + MAKE_NAME(SUNStlVectorTtype, Grow)(self); + } + self->values[self->size++] = element; +} + +static inline TTYPE* MAKE_NAME(SUNStlVectorTtype, At)(SUNStlVectorTtype self, + int64_t index) +{ + if (index >= self->size || index < 0) + { + // Handle index out of bounds + return NULL; + } + return &(self->values[index]); +} + +static inline void MAKE_NAME(SUNStlVectorTtype, Set)(SUNStlVectorTtype self, + int64_t index, TTYPE element) +{ + if (index >= self->size) + { + // Handle index out of bounds + return; + } + self->values[index] = element; +} + +static inline void MAKE_NAME(SUNStlVectorTtype, PopBack)(SUNStlVectorTtype self) +{ + static TTYPE nullish; + if (self->size == 0) return; + self->size--; + MAKE_NAME(SUNStlVectorTtype, Set)(self, self->size, nullish); +} + +static inline void MAKE_NAME(SUNStlVectorTtype, Erase)(SUNStlVectorTtype self, + int64_t index) +{ + static TTYPE nullish; + if (self->size == 0) return; + MAKE_NAME(SUNStlVectorTtype, Set)(self, index, nullish); + for (int64_t i = index; i < self->size - 1; i++) + { + self->values[i] = self->values[i + 1]; + self->values[i + 1] = nullish; + } + self->size -= 1; +} + +static inline int64_t MAKE_NAME(SUNStlVectorTtype, Size)(SUNStlVectorTtype self) +{ + return self->size; +} + +static inline int64_t MAKE_NAME(SUNStlVectorTtype, + Capacity)(SUNStlVectorTtype self) +{ + return self->capacity; +} + +static inline void MAKE_NAME(SUNStlVectorTtype, + Destroy)(SUNStlVectorTtype* self_ptr) +{ + static TTYPE nullish; + + if (!self_ptr || !(*self_ptr)) return; + + SUNStlVectorTtype self = *self_ptr; + + for (int64_t i = 0; i < MAKE_NAME(SUNStlVectorTtype, Size)(self); i++) + { + self->destroyValue(&(self->values[i])); + self->values[i] = nullish; + } + + *self_ptr = NULL; +} diff --git a/src/sundials/sundatanode/sundatanode_inmem.c b/src/sundials/sundatanode/sundatanode_inmem.c new file mode 100644 index 0000000000..ca63c4d103 --- /dev/null +++ b/src/sundials/sundatanode/sundatanode_inmem.c @@ -0,0 +1,471 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 + * -----------------------------------------------------------------*/ + +#include + +#include "sundatanode/sundatanode_inmem.h" +#include "sundials/priv/sundials_errors_impl.h" +#include "sundials/sundials_errors.h" +#include "sundials/sundials_memory.h" +#include "sundials/sundials_nvector.h" +#include "sundials/sundials_types.h" +#include "sundials_datanode.h" +#include "sundials_hashmap_impl.h" +#include "sundials_macros.h" + +#define GET_IMPL(node) ((SUNDataNode_InMemContent)(node)->content) +#define IMPL_PROP(node, prop) (GET_IMPL(node)->prop) +#define BASE_PROP(node, prop) ((node)->prop) + +static SUNDataNode sunDataNodeInMem_CreateEmpty(SUNContext sunctx) +{ + SUNFunctionBegin(sunctx); + + SUNDataNode node; + SUNCheckCallNoRet(SUNDataNode_CreateEmpty(sunctx, &node)); + + node->ops->hasChildren = SUNDataNode_HasChildren_InMem; + node->ops->isLeaf = SUNDataNode_IsLeaf_InMem; + node->ops->isList = SUNDataNode_IsList_InMem; + node->ops->isObject = SUNDataNode_IsObject_InMem; + node->ops->addChild = SUNDataNode_AddChild_InMem; + node->ops->addNamedChild = SUNDataNode_AddNamedChild_InMem; + node->ops->getChild = SUNDataNode_GetChild_InMem; + node->ops->getNamedChild = SUNDataNode_GetNamedChild_InMem; + node->ops->removeChild = SUNDataNode_RemoveChild_InMem; + node->ops->removeNamedChild = SUNDataNode_RemoveNamedChild_InMem; + node->ops->getData = SUNDataNode_GetData_InMem; + node->ops->getDataNvector = SUNDataNode_GetDataNvector_InMem; + node->ops->setData = SUNDataNode_SetData_InMem; + node->ops->setDataNvector = SUNDataNode_SetDataNvector_InMem; + node->ops->destroy = SUNDataNode_Destroy_InMem; + + SUNDataNode_InMemContent content = + (SUNDataNode_InMemContent)malloc(sizeof(struct SUNDataNode_InMemImpl_)); + SUNAssertNoRet(content, SUN_ERR_MEM_FAIL); + + content->parent = NULL; + content->mem_helper = NULL; + content->leaf_data = NULL; + content->name = NULL; + content->named_children = NULL; + content->num_named_children = 0; + content->anon_children = NULL; + + node->content = (void*)content; + + return node; +} + +static void sunDataNodeInMem_DestroyEmpty(SUNDataNode* node) +{ + if (!node || !(*node)) { return; } + if (BASE_PROP(*node, content)) { free(BASE_PROP(*node, content)); } + BASE_PROP(*node, content) = NULL; + free(*node); + *node = NULL; +} + +static void sunDataNodeFreeKeyValue(SUNHashMapKeyValue* kv_ptr); +static void sunDataNodeFreeValue(SUNDataNode* nodeptr); + +SUNErrCode SUNDataNode_CreateList_InMem(sundataindex init_size, + SUNContext sunctx, SUNDataNode* node_out) +{ + SUNFunctionBegin(sunctx); + + SUNDataNode node = sunDataNodeInMem_CreateEmpty(sunctx); + + BASE_PROP(node, dtype) = SUNDATANODE_LIST; + IMPL_PROP(node, anon_children) = + SUNStlVector_SUNDataNode_New(init_size, sunDataNodeFreeValue); + + *node_out = node; + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_CreateObject_InMem(sundataindex init_size, + SUNContext sunctx, + SUNDataNode* node_out) +{ + SUNFunctionBegin(sunctx); + + SUNDataNode node = sunDataNodeInMem_CreateEmpty(sunctx); + + BASE_PROP(node, dtype) = SUNDATANODE_OBJECT; + + SUNHashMap map; + SUNCheckCall(SUNHashMap_New(init_size, sunDataNodeFreeKeyValue, &map)); + + IMPL_PROP(node, named_children) = map; + + *node_out = node; + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_CreateLeaf_InMem(SUNMemoryHelper mem_helper, + SUNContext sunctx, SUNDataNode* node_out) +{ + SUNFunctionBegin(sunctx); + + SUNDataNode node = sunDataNodeInMem_CreateEmpty(sunctx); + + BASE_PROP(node, dtype) = SUNDATANODE_LEAF; + IMPL_PROP(node, mem_helper) = mem_helper; + IMPL_PROP(node, leaf_data) = NULL; + + *node_out = node; + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_IsLeaf_InMem(const SUNDataNode self, + sunbooleantype* yes_or_no) +{ + SUNFunctionBegin(self->sunctx); + *yes_or_no = BASE_PROP(self, dtype) == SUNDATANODE_LEAF; + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_IsList_InMem(const SUNDataNode self, + sunbooleantype* yes_or_no) +{ + SUNFunctionBegin(self->sunctx); + *yes_or_no = BASE_PROP(self, dtype) == SUNDATANODE_LIST; + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_IsObject_InMem(const SUNDataNode self, + sunbooleantype* yes_or_no) +{ + SUNFunctionBegin(self->sunctx); + *yes_or_no = BASE_PROP(self, dtype) == SUNDATANODE_OBJECT; + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_HasChildren_InMem(const SUNDataNode self, + sunbooleantype* yes_or_no) +{ + SUNFunctionBegin(self->sunctx); + *yes_or_no = + (IMPL_PROP(self, anon_children) && + SUNStlVector_SUNDataNode_Size(IMPL_PROP(self, anon_children)) != 0) || + IMPL_PROP(self, num_named_children) != 0; + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_AddChild_InMem(SUNDataNode self, SUNDataNode child_node) +{ + SUNFunctionBegin(self->sunctx); + + SUNAssert(BASE_PROP(self, dtype) == SUNDATANODE_LIST, SUN_ERR_ARG_WRONGTYPE); + SUNStlVector_SUNDataNode_PushBack(IMPL_PROP(self, anon_children), child_node); + IMPL_PROP(child_node, parent) = self; + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_AddNamedChild_InMem(SUNDataNode self, const char* name, + SUNDataNode child_node) +{ + SUNFunctionBegin(self->sunctx); + + SUNAssert(BASE_PROP(self, dtype) == SUNDATANODE_OBJECT, SUN_ERR_ARG_WRONGTYPE); + + IMPL_PROP(child_node, name) = name; + if (SUNHashMap_Insert(IMPL_PROP(self, named_children), name, child_node)) + { + return SUN_ERR_OP_FAIL; + } + + IMPL_PROP(child_node, parent) = self; + IMPL_PROP(self, num_named_children)++; + + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_GetChild_InMem(const SUNDataNode self, sundataindex index, + SUNDataNode* child_node) +{ + SUNFunctionBegin(self->sunctx); + + sunbooleantype has_children; + SUNCheckCall(SUNDataNode_HasChildren_InMem(self, &has_children)); + + if (!has_children) { return SUN_ERR_DATANODE_NODENOTFOUND; } + + SUNDataNode* child_node_ptr = + SUNStlVector_SUNDataNode_At(IMPL_PROP(self, anon_children), index); + if (child_node_ptr) { *child_node = *child_node_ptr; } + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_GetNamedChild_InMem(const SUNDataNode self, + const char* name, + SUNDataNode* child_node) +{ + SUNFunctionBegin(self->sunctx); + + *child_node = NULL; + + sunbooleantype has_children; + SUNCheckCall(SUNDataNode_HasChildren_InMem(self, &has_children)); + + if (has_children) + { + if (SUNHashMap_GetValue(IMPL_PROP(self, named_children), name, + (void**)child_node)) + { + return SUN_ERR_DATANODE_NODENOTFOUND; + } + } + + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_RemoveChild_InMem(SUNDataNode self, sundataindex index, + SUNDataNode* child_node) +{ + SUNFunctionBegin(self->sunctx); + + sunbooleantype has_children; + SUNCheckCall(SUNDataNode_HasChildren_InMem(self, &has_children)); + + if (!has_children) { return SUN_SUCCESS; } + + SUNDataNode* child_node_ptr = + SUNStlVector_SUNDataNode_At(IMPL_PROP(self, anon_children), index); + if (child_node_ptr) + { + *child_node = *child_node_ptr; + if (*child_node) + { + IMPL_PROP(*child_node, parent) = NULL; + SUNStlVector_SUNDataNode_Erase(IMPL_PROP(self, anon_children), index); + } + } + + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_RemoveNamedChild_InMem(const SUNDataNode self, + const char* name, + SUNDataNode* child_node) +{ + SUNFunctionBegin(self->sunctx); + + *child_node = NULL; + + sunbooleantype has_children; + SUNCheckCall(SUNDataNode_HasChildren_InMem(self, &has_children)); + + if (has_children) + { + if (SUNHashMap_Remove(IMPL_PROP(self, named_children), name, + (void**)child_node)) + { + return SUN_ERR_DATANODE_NODENOTFOUND; + } + IMPL_PROP(*child_node, parent) = NULL; + IMPL_PROP(self, num_named_children)--; + } + + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_GetData_InMem(const SUNDataNode self, void** data, + size_t* data_stride, size_t* data_bytes) +{ + SUNFunctionBegin(self->sunctx); + + SUNMemory leaf_data = (SUNMemory)IMPL_PROP(self, leaf_data); + + *data_stride = leaf_data->stride; + *data_bytes = leaf_data->bytes; + *data = leaf_data->ptr; + + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_GetDataNvector_InMem(const SUNDataNode self, N_Vector v, + sunrealtype* t) +{ + SUNFunctionBegin(self->sunctx); + + void* queue = NULL; + + SUNMemory leaf_data = (SUNMemory)IMPL_PROP(self, leaf_data); + + SUNMemoryType leaf_mem_type = leaf_data->type; + SUNMemoryType buffer_mem_type = N_VGetDeviceArrayPointer(v) ? SUNMEMTYPE_DEVICE + : SUNMEMTYPE_HOST; + + sunindextype buffer_size = 0; + SUNCheckCall(N_VBufSize(v, &buffer_size)); + SUNAssert((buffer_size + sizeof(sunrealtype)) == leaf_data->bytes, + SUN_ERR_ARG_INCOMPATIBLE); + + if (leaf_mem_type == buffer_mem_type) + { + sunrealtype* data_ptr = leaf_data->ptr; + *t = data_ptr[0]; + SUNCheckCall(N_VBufUnpack(v, &data_ptr[1])); + } + else + { + SUNMemory buffer_data = NULL; + SUNCheckCall(SUNMemoryHelper_Alloc(IMPL_PROP(self, mem_helper), &buffer_data, + buffer_size, buffer_mem_type, queue)); + + SUNCheckCall(SUNMemoryHelper_Copy(IMPL_PROP(self, mem_helper), buffer_data, + leaf_data, buffer_size, queue)); + + sunrealtype* data_ptr = leaf_data->ptr; + *t = data_ptr[0]; + data_ptr = buffer_data->ptr; + + SUNCheckCall(N_VBufUnpack(v, &data_ptr[1])); + + SUNCheckCall( + SUNMemoryHelper_Dealloc(IMPL_PROP(self, mem_helper), buffer_data, queue)); + } + + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_SetData_InMem(SUNDataNode self, SUNMemoryType src_mem_type, + SUNMemoryType node_mem_type, void* data, + size_t data_stride, size_t data_bytes) +{ + SUNFunctionBegin(self->sunctx); + + void* queue = NULL; + + SUNAssert(BASE_PROP(self, dtype) == SUNDATANODE_LEAF, SUN_ERR_ARG_WRONGTYPE); + + SUNMemory data_mem_src = SUNMemoryHelper_Wrap(IMPL_PROP(self, mem_helper), + data, src_mem_type); + SUNCheckLastErr(); + + SUNMemory data_mem_dst = NULL; + SUNCheckCall(SUNMemoryHelper_AllocStrided(IMPL_PROP(self, mem_helper), + &data_mem_dst, data_bytes, + data_stride, node_mem_type, queue)); + + SUNCheckCall(SUNMemoryHelper_Copy(IMPL_PROP(self, mem_helper), data_mem_dst, + data_mem_src, data_bytes, queue)); + + SUNMemoryHelper_Dealloc(IMPL_PROP(self, mem_helper), data_mem_src, queue); + + IMPL_PROP(self, leaf_data) = data_mem_dst; + + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_SetDataNvector_InMem(SUNDataNode self, N_Vector v, + sunrealtype t) +{ + SUNFunctionBegin(self->sunctx); + + void* queue = NULL; + + SUNMemoryType leaf_mem_type = SUNMEMTYPE_HOST; + SUNMemoryType buffer_mem_type = N_VGetDeviceArrayPointer(v) ? SUNMEMTYPE_DEVICE + : SUNMEMTYPE_HOST; + + sunindextype buffer_size = 0; + SUNCheckCall(N_VBufSize(v, &buffer_size)); + + /* We allocate 1 extra sunrealtype for storing t */ + SUNMemory leaf_data = NULL; + SUNCheckCall( + SUNMemoryHelper_AllocStrided(IMPL_PROP(self, mem_helper), &leaf_data, + buffer_size + sizeof(sunrealtype), + sizeof(sunrealtype), leaf_mem_type, queue)); + + if (leaf_mem_type == buffer_mem_type) + { + sunrealtype* data_ptr = leaf_data->ptr; + data_ptr[0] = t; + SUNCheckCall(N_VBufPack(v, &data_ptr[1])); + } + else + { + /* If the node memory type is not the same as the N_Vector's memory type, + then we will first need to create a buffer of the same type as the N_Vector's + and then copy it to the node data. */ + SUNMemory buffer_data = NULL; + SUNCheckCall( + SUNMemoryHelper_AllocStrided(IMPL_PROP(self, mem_helper), &buffer_data, + buffer_size + sizeof(sunrealtype), + sizeof(sunrealtype), buffer_mem_type, queue)); + + sunrealtype* data_ptr = buffer_data->ptr; + data_ptr[0] = t; + SUNCheckCall(N_VBufPack(v, &data_ptr[1])); + + SUNCheckCall(SUNMemoryHelper_Copy(IMPL_PROP(self, mem_helper), leaf_data, + buffer_data, + buffer_size + sizeof(sunrealtype), queue)); + + SUNCheckCall( + SUNMemoryHelper_Dealloc(IMPL_PROP(self, mem_helper), buffer_data, queue)); + } + + IMPL_PROP(self, leaf_data) = leaf_data; + + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_Destroy_InMem(SUNDataNode* node) +{ + SUNFunctionBegin((*node)->sunctx); + + void* queue = NULL; + + if (BASE_PROP(*node, dtype) == SUNDATANODE_OBJECT) + { + SUNHashMap map = IMPL_PROP(*node, named_children); + SUNHashMap_Destroy(&map); + } + else if (BASE_PROP(*node, dtype) == SUNDATANODE_LIST) + { + SUNStlVector_SUNDataNode_Destroy(&IMPL_PROP(*node, anon_children)); + } + else if (BASE_PROP(*node, dtype) == SUNDATANODE_LEAF) + { + if (IMPL_PROP(*node, leaf_data)) + { + SUNCheckCall(SUNMemoryHelper_Dealloc(IMPL_PROP(*node, mem_helper), + IMPL_PROP(*node, leaf_data), queue)); + } + } + + sunDataNodeInMem_DestroyEmpty(node); + *node = NULL; + + return SUN_SUCCESS; +} + +/* This function is the callback provided to the child hashmap as the destroy function. */ +static void sunDataNodeFreeKeyValue(SUNDIALS_MAYBE_UNUSED SUNHashMapKeyValue* kv_ptr) +{ + /* Do nothing. We want the user of the class to have to call SUNDataNode_Destroy + for each SUNDataNode, even child nodes.*/ + return; +} + +/* This function is the callback provided to the child stlvector as the destroy function. */ +static void sunDataNodeFreeValue(SUNDIALS_MAYBE_UNUSED SUNDataNode* nodeptr) +{ + /* Do nothing. We want the user of the class to have to call SUNDataNode_Destroy + for each SUNDataNode, even child nodes.*/ + return; +} diff --git a/src/sundials/sundatanode/sundatanode_inmem.h b/src/sundials/sundatanode/sundatanode_inmem.h new file mode 100644 index 0000000000..4e7f752429 --- /dev/null +++ b/src/sundials/sundatanode/sundatanode_inmem.h @@ -0,0 +1,113 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 + * -----------------------------------------------------------------*/ + +#include +#include "sundials_datanode.h" + +#include "sundials/sundials_memory.h" +#include "sundials_hashmap_impl.h" + +#ifndef SUNDATANODE_INMEM_H_ +#define SUNDATANODE_INMEM_H_ + +#ifdef __cplusplus +extern "C" { +#endif + +#define TTYPE SUNDataNode +#include "stl/sunstl_vector.h" +#undef TTYPE + +typedef struct SUNDataNode_InMemImpl_* SUNDataNode_InMemContent; + +struct SUNDataNode_InMemImpl_ +{ + // Reference to the parent node of this node. + SUNDataNode parent; + + // Node can only be an object, leaf, or list. It cannot be more than one of these at a time. + + // Properties for Leaf nodes (nodes that store data) + SUNMemoryHelper mem_helper; + SUNMemory leaf_data; + + // Properties for Object nodes (nodes that are a collection of named nodes) + const char* name; + SUNHashMap named_children; + sundataindex num_named_children; + + // Properties for a List node (nodes that are a collection of anonymous nodes) + SUNStlVector_SUNDataNode anon_children; +}; + +SUNErrCode SUNDataNode_CreateList_InMem(sundataindex init_size, + SUNContext sunctx, SUNDataNode* node_out); + +SUNErrCode SUNDataNode_CreateObject_InMem(sundataindex init_size, + SUNContext sunctx, + SUNDataNode* node_out); + +SUNErrCode SUNDataNode_CreateLeaf_InMem(SUNMemoryHelper mem_helper, + SUNContext sunctx, SUNDataNode* node_out); + +SUNErrCode SUNDataNode_IsLeaf_InMem(const SUNDataNode self, + sunbooleantype* yes_or_no); + +SUNErrCode SUNDataNode_IsList_InMem(const SUNDataNode self, + sunbooleantype* yes_or_no); + +SUNErrCode SUNDataNode_IsObject_InMem(const SUNDataNode self, + sunbooleantype* yes_or_no); + +SUNErrCode SUNDataNode_HasChildren_InMem(const SUNDataNode self, + sunbooleantype* yes_or_no); + +SUNErrCode SUNDataNode_AddChild_InMem(SUNDataNode parent_node, + SUNDataNode child_node); + +SUNErrCode SUNDataNode_AddNamedChild_InMem(SUNDataNode parent_node, + const char* name, + SUNDataNode child_node); + +SUNErrCode SUNDataNode_GetChild_InMem(const SUNDataNode self, sundataindex index, + SUNDataNode* child_node); + +SUNErrCode SUNDataNode_GetNamedChild_InMem(const SUNDataNode self, + const char* name, + SUNDataNode* child_node); + +SUNErrCode SUNDataNode_RemoveChild_InMem(SUNDataNode self, sundataindex index, + SUNDataNode* child_node); + +SUNErrCode SUNDataNode_RemoveNamedChild_InMem(SUNDataNode self, const char* name, + SUNDataNode* child_node); + +SUNErrCode SUNDataNode_GetData_InMem(const SUNDataNode self, void** data, + size_t* data_stride, size_t* data_bytes); + +SUNErrCode SUNDataNode_GetDataNvector_InMem(const SUNDataNode self, N_Vector v, + sunrealtype* t); + +SUNErrCode SUNDataNode_SetData_InMem(SUNDataNode self, SUNMemoryType src_mem_type, + SUNMemoryType node_mem_type, void* data, + size_t data_stride, size_t data_bytes); + +SUNErrCode SUNDataNode_SetDataNvector_InMem(SUNDataNode self, N_Vector v, + sunrealtype t); + +SUNErrCode SUNDataNode_Destroy_InMem(SUNDataNode* node); + +#ifdef __cplusplus +} +#endif + +#endif // SUNDATANODE_INMEM_H_ diff --git a/src/sundials/sundials_datanode.c b/src/sundials/sundials_datanode.c new file mode 100644 index 0000000000..8779d63b7e --- /dev/null +++ b/src/sundials/sundials_datanode.c @@ -0,0 +1,352 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 + * -----------------------------------------------------------------*/ + +#include +#include + +#include "sundatanode/sundatanode_inmem.h" +#include "sundials/sundials_errors.h" +#include "sundials/sundials_memory.h" +#include "sundials_datanode.h" + +SUNErrCode SUNDataNode_CreateEmpty(SUNContext sunctx, SUNDataNode* node_out) +{ + SUNFunctionBegin(sunctx); + + SUNDataNode self; + self = (SUNDataNode)malloc(sizeof(*self)); + SUNAssert(self, SUN_ERR_MEM_FAIL); + + SUNDataNode_Ops ops; + ops = (SUNDataNode_Ops)malloc(sizeof(*ops)); + SUNAssert(self, SUN_ERR_MEM_FAIL); + + ops->hasChildren = NULL; + ops->isLeaf = NULL; + ops->isList = NULL; + ops->isObject = NULL; + ops->addChild = NULL; + ops->getChild = NULL; + ops->removeChild = NULL; + ops->getData = NULL; + ops->setData = NULL; + ops->destroy = NULL; + + self->dtype = 0; + self->ops = ops; + self->content = NULL; + self->sunctx = sunctx; + + *node_out = self; + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_CreateLeaf(SUNDataIOMode io_mode, + SUNMemoryHelper mem_helper, SUNContext sunctx, + SUNDataNode* node_out) +{ + SUNFunctionBegin(sunctx); + + switch (io_mode) + { + case (SUNDATAIOMODE_INMEM): + SUNCheckCall(SUNDataNode_CreateLeaf_InMem(mem_helper, sunctx, node_out)); + break; + default: return SUN_ERR_ARG_OUTOFRANGE; + } + + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_CreateList(SUNDataIOMode io_mode, + sundataindex num_elements, SUNContext sunctx, + SUNDataNode* node_out) +{ + SUNFunctionBegin(sunctx); + + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + switch (io_mode) + { + case (SUNDATAIOMODE_INMEM): + SUNCheckCall(SUNDataNode_CreateList_InMem(num_elements, sunctx, node_out)); + break; + default: + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_ARG_OUTOFRANGE; + } + + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_CreateObject(SUNDataIOMode io_mode, + sundataindex num_elements, + SUNContext sunctx, SUNDataNode* node_out) +{ + SUNFunctionBegin(sunctx); + + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + switch (io_mode) + { + case (SUNDATAIOMODE_INMEM): + SUNCheckCall(SUNDataNode_CreateObject_InMem(num_elements, sunctx, node_out)); + break; + default: + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_ARG_OUTOFRANGE; + } + + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + + return SUN_SUCCESS; +} + +SUNErrCode SUNDataNode_IsLeaf(const SUNDataNode self, sunbooleantype* yes_or_no) +{ + SUNFunctionBegin(self->sunctx); + + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + if (self->ops->isLeaf) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return self->ops->isLeaf(self, yes_or_no); + } + + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNDataNode_IsList(const SUNDataNode self, sunbooleantype* yes_or_no) +{ + SUNFunctionBegin(self->sunctx); + + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + if (self->ops->isList) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return self->ops->isList(self, yes_or_no); + } + + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNDataNode_HasChildren(const SUNDataNode self, + sunbooleantype* yes_or_no) +{ + SUNFunctionBegin(self->sunctx); + + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + if (self->ops->hasChildren) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return self->ops->hasChildren(self, yes_or_no); + } + + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNDataNode_AddChild(SUNDataNode self, SUNDataNode child_node) +{ + SUNFunctionBegin(self->sunctx); + + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + if (self->ops->addChild) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return self->ops->addChild(self, child_node); + } + + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNDataNode_AddNamedChild(SUNDataNode self, const char* name, + SUNDataNode child_node) +{ + SUNFunctionBegin(self->sunctx); + + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + if (self->ops->addNamedChild) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return self->ops->addNamedChild(self, name, child_node); + } + + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNDataNode_GetChild(const SUNDataNode self, sundataindex index, + SUNDataNode* child_node) +{ + SUNFunctionBegin(self->sunctx); + + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + if (self->ops->getChild) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return self->ops->getChild(self, index, child_node); + } + + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNDataNode_GetNamedChild(const SUNDataNode self, const char* name, + SUNDataNode* child_node) +{ + SUNFunctionBegin(self->sunctx); + + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + if (self->ops->getNamedChild) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return self->ops->getNamedChild(self, name, child_node); + } + + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNDataNode_RemoveNamedChild(const SUNDataNode self, const char* name, + SUNDataNode* child_node) +{ + SUNFunctionBegin(self->sunctx); + + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + if (self->ops->removeNamedChild) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return self->ops->removeNamedChild(self, name, child_node); + } + + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNDataNode_RemoveChild(SUNDataNode self, sundataindex index, + SUNDataNode* child_node) +{ + SUNFunctionBegin(self->sunctx); + + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + if (self->ops->removeChild) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return self->ops->removeChild(self, index, child_node); + } + + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNDataNode_GetData(const SUNDataNode self, void** data, + size_t* data_stride, size_t* data_bytes) +{ + SUNFunctionBegin(self->sunctx); + + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + if (self->ops->getData) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return self->ops->getData(self, data, data_stride, data_bytes); + } + + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNDataNode_GetDataNvector(SUNDataNode self, N_Vector v, sunrealtype* t) +{ + SUNFunctionBegin(self->sunctx); + + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + if (self->ops->getDataNvector) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return self->ops->getDataNvector(self, v, t); + } + + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNDataNode_SetData(SUNDataNode self, SUNMemoryType src_mem_type, + SUNMemoryType node_mem_type, void* data, + size_t data_stride, size_t data_bytes) +{ + SUNFunctionBegin(self->sunctx); + + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + if (self->ops->setData) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return self->ops->setData(self, src_mem_type, node_mem_type, data, + data_stride, data_bytes); + } + + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNDataNode_SetDataNvector(SUNDataNode self, N_Vector v, sunrealtype t) +{ + SUNFunctionBegin(self->sunctx); + + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + if (self->ops->setDataNvector) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return self->ops->setDataNvector(self, v, t); + } + + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNDataNode_Destroy(SUNDataNode* node) +{ + SUNFunctionBegin((*node)->sunctx); + + SUNDIALS_MARK_FUNCTION_BEGIN(SUNCTX_->profiler); + + if ((*node)->ops->destroy) + { + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return (*node)->ops->destroy(node); + } + + free(*node); + *node = NULL; + + SUNDIALS_MARK_FUNCTION_END(SUNCTX_->profiler); + return SUN_SUCCESS; +} diff --git a/src/sundials/sundials_datanode.h b/src/sundials/sundials_datanode.h new file mode 100644 index 0000000000..07ee527b85 --- /dev/null +++ b/src/sundials/sundials_datanode.h @@ -0,0 +1,152 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 + * ----------------------------------------------------------------- + * SUNDataNode class definition. A SUNDataNode is a hierarchical + * object that can hold arbitrary data in arbitrary storage locations. + * The data may be held directly (a leaf node) or indirectly by + * holding references to child nodes (list or object nodes). A + * SUNDataNode maps well to a JSON node. + * ----------------------------------------------------------------*/ + +#ifndef _SUNDIALS_DATANODE_H +#define _SUNDIALS_DATANODE_H + +#include + +#include "sundials/sundials_memory.h" + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +typedef int64_t sundataindex; + +typedef enum +{ + SUNDATANODE_LEAF, + SUNDATANODE_LIST, + SUNDATANODE_OBJECT +} SUNDataNodeType; + +typedef struct SUNDataNode_Ops_* SUNDataNode_Ops; +typedef struct SUNDataNode_* SUNDataNode; + +struct SUNDataNode_Ops_ +{ + SUNErrCode (*hasChildren)(const SUNDataNode, sunbooleantype* yes_or_no); + SUNErrCode (*isLeaf)(const SUNDataNode, sunbooleantype* yes_or_no); + SUNErrCode (*isList)(const SUNDataNode, sunbooleantype* yes_or_no); + SUNErrCode (*isObject)(const SUNDataNode, sunbooleantype* yes_or_no); + SUNErrCode (*addChild)(SUNDataNode, SUNDataNode child_node); + SUNErrCode (*addNamedChild)(SUNDataNode, const char* name, + SUNDataNode child_node); + SUNErrCode (*getChild)(const SUNDataNode, sundataindex index, + SUNDataNode* child_node); + SUNErrCode (*getNamedChild)(const SUNDataNode, const char* name, + SUNDataNode* child_node); + SUNErrCode (*removeChild)(SUNDataNode, sundataindex index, + SUNDataNode* child_node); + SUNErrCode (*removeNamedChild)(const SUNDataNode, const char* name, + SUNDataNode* child_node); + SUNErrCode (*getData)(const SUNDataNode, void** data, size_t* data_stride, + size_t* data_bytes); + SUNErrCode (*getDataNvector)(const SUNDataNode, N_Vector v, sunrealtype* t); + SUNErrCode (*setData)(SUNDataNode, SUNMemoryType src_mem_type, + SUNMemoryType node_mem_type, void* data, + size_t data_stride, size_t data_bytes); + SUNErrCode (*setDataNvector)(SUNDataNode, N_Vector v, sunrealtype t); + SUNErrCode (*destroy)(SUNDataNode*); +}; + +struct SUNDataNode_ +{ + SUNDataNode_Ops ops; + SUNDataNodeType dtype; + void* content; + SUNContext sunctx; +}; + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_CreateEmpty(SUNContext sunctx, SUNDataNode* node); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_CreateLeaf(SUNDataIOMode io_mode, + SUNMemoryHelper mem_helper, SUNContext sunctx, + SUNDataNode* node_out); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_CreateList(SUNDataIOMode io_mode, + sundataindex num_elements, SUNContext sunctx, + SUNDataNode* node_out); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_CreateObject(SUNDataIOMode io_mode, + sundataindex num_elements, + SUNContext sunctx, SUNDataNode* node_out); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_IsLeaf(const SUNDataNode self, sunbooleantype* yes_or_no); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_IsList(const SUNDataNode self, sunbooleantype* yes_or_no); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_HasChildren(const SUNDataNode self, + sunbooleantype* yes_or_no); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_AddChild(SUNDataNode self, SUNDataNode child_node); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_AddNamedChild(SUNDataNode self, const char* name, + SUNDataNode child_node); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_GetChild(const SUNDataNode self, sundataindex index, + SUNDataNode* child_node); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_GetNamedChild(const SUNDataNode self, const char* name, + SUNDataNode* child_node); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_RemoveChild(SUNDataNode self, sundataindex index, + SUNDataNode* child_node); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_RemoveNamedChild(const SUNDataNode self, const char* name, + SUNDataNode* child_node); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_GetData(const SUNDataNode self, void** data, + size_t* data_stride, size_t* data_bytes); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_GetDataNvector(const SUNDataNode self, N_Vector v, + sunrealtype* t); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_SetData(SUNDataNode self, SUNMemoryType src_mem_type, + SUNMemoryType node_mem_type, void* data, + size_t data_stride, size_t data_bytes); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_SetDataNvector(SUNDataNode self, N_Vector v, + sunrealtype t); + +SUNDIALS_EXPORT +SUNErrCode SUNDataNode_Destroy(SUNDataNode* node); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/src/sundials/sundials_errors.c b/src/sundials/sundials_errors.c index 456d7134e9..549082bc75 100644 --- a/src/sundials/sundials_errors.c +++ b/src/sundials/sundials_errors.c @@ -79,8 +79,18 @@ void SUNAbortErrHandlerFn(int line, const char* func, const char* file, SUNDIALS_MAYBE_UNUSED void* err_user_data, SUNContext sunctx) { + /* Flush all buffered logging messages now before we abort */ + SUNLogger_Flush(sunctx->logger, SUN_LOGLEVEL_ALL); + char* file_and_line = sunCombineFileAndLine(line, file); + if (msg == NULL) { msg = SUNGetErrMsg(err_code); } SUNLogger_QueueMsg(sunctx->logger, SUN_LOGLEVEL_ERROR, file_and_line, func, + msg); + free(file_and_line); + /* It is convenient to have the exit message point to the message line, + so we add 1 to the line number. As such, do not separate the following lines! */ + file_and_line = sunCombineFileAndLine(__LINE__ + 1, __FILE__); + SUNLogger_QueueMsg(sunctx->logger, SUN_LOGLEVEL_ERROR, file_and_line, __func__, "SUNAbortErrHandler: Calling abort now, use a different " "error handler to avoid program termination.\n"); free(file_and_line); diff --git a/src/sundials/sundials_hashmap.c b/src/sundials/sundials_hashmap.c index acf1c12c8d..597e445af8 100644 --- a/src/sundials/sundials_hashmap.c +++ b/src/sundials/sundials_hashmap.c @@ -17,6 +17,7 @@ * the hash map upon its destruction. * -----------------------------------------------------------------*/ +#include #include #include #include @@ -45,76 +46,89 @@ static uint64_t fnv1a_hash(const char* str) return hash; } +static inline int64_t sunHashMapIdxFromKey(SUNHashMap map, const char* key) +{ + /* We want the index to be in (0, SUNHashMap_Capacity(map)) */ + int64_t end = SUNHashMap_Capacity(map) - 1; + int64_t idx = end == 0 ? end : (int64_t)(fnv1a_hash(key) % end); + return idx; +} + /* This function creates a new SUNHashMap object allocated to hold - up to 'max_size' entries. + up to 'capacity' entries. **Arguments:** - * ``max_size`` -- the max number of entries in the hashmap + * ``capacity`` -- the initial capactity number of the hashmap * ``map`` -- on input, a SUNHasMap pointer, on output the SUNHashMap will be allocated **Returns:** * A SUNErrCode indicating success or a failure */ -SUNErrCode SUNHashMap_New(int max_size, SUNHashMap* map) +SUNErrCode SUNHashMap_New(int64_t capacity, + void (*destroyKeyValue)(SUNHashMapKeyValue* kv_ptr), + SUNHashMap* map) { - int i; - - if (max_size <= 0) { return SUN_ERR_ARG_OUTOFRANGE; } + if (capacity <= 0) { return SUN_ERR_ARG_OUTOFRANGE; } *map = NULL; *map = (SUNHashMap)malloc(sizeof(**map)); if (!map) { return SUN_ERR_MALLOC_FAIL; } - (*map)->size = 0; - (*map)->max_size = max_size; - - (*map)->buckets = NULL; - (*map)->buckets = - (SUNHashMapKeyValue*)malloc(max_size * sizeof(*((*map)->buckets))); + (*map)->capacity = capacity; + (*map)->destroyKeyValue = destroyKeyValue; - if (!(*map)->buckets) + SUNStlVector_SUNHashMapKeyValue buckets = + SUNStlVector_SUNHashMapKeyValue_New(capacity, destroyKeyValue); + if (!buckets) { free(*map); return SUN_ERR_MALLOC_FAIL; } /* Initialize all buckets to NULL */ - for (i = 0; i < max_size; i++) { (*map)->buckets[i] = NULL; } + for (int64_t i = 0; i < capacity; i++) + { + SUNStlVector_SUNHashMapKeyValue_PushBack(buckets, NULL); + } + + (*map)->buckets = buckets; return SUN_SUCCESS; } +/* + This function returns the capacity of the hashmap. + + **Arguments:** + * ``map`` -- the SUNHashMap object + + **Returns:** + * The capacity of the hashmap + */ +int64_t SUNHashMap_Capacity(SUNHashMap map) +{ + return SUNStlVector_SUNHashMapKeyValue_Capacity(map->buckets); +} + /* This function frees the SUNHashMap object. **Arguments:** * ``map`` -- on input, a SUNHasMap pointer, on output the SUNHashMap will be deallocated and set to ``NULL`` - * ``freevalue`` -- callback function that should free the value object **Returns:** * A SUNErrCode indicating success or a failure */ -SUNErrCode SUNHashMap_Destroy(SUNHashMap* map, void (*freevalue)(void* ptr)) +SUNErrCode SUNHashMap_Destroy(SUNHashMap* map) { - int i; - - if (map == NULL || freevalue == NULL) { return SUN_SUCCESS; } - - for (i = 0; i < (*map)->max_size; i++) - { - if ((*map)->buckets[i] && (*map)->buckets[i]->value) - { - freevalue((*map)->buckets[i]->value); - } + if (map == NULL) { return SUN_SUCCESS; } - if ((*map)->buckets[i]) { free((*map)->buckets[i]); } - } - if ((*map)->buckets) { free((*map)->buckets); } - if (*map) { free(*map); } + SUNStlVector_SUNHashMapKeyValue_Destroy(&(*map)->buckets); + free(*map); *map = NULL; return SUN_SUCCESS; @@ -129,45 +143,67 @@ SUNErrCode SUNHashMap_Destroy(SUNHashMap* map, void (*freevalue)(void* ptr)) * ``map`` -- the ``SUNHashMap`` object to operate on * ``start`` -- the start of the iteration range * ``yieldfn`` -- the callback function to call every iteration - this should return -1 to continue the iteration, or >= 0 to - stop; the first argument is the current index, the second - argument is the current key-value pair, and the final - argument is the same pointer ``ctx`` as the final argument - to SUNHashMapIterate. + this should return SUNHASHMAP_ERROR to continue the iteration, or [0, SUNHASHMAP_KEYNOTFOUND] + to stop; the first argument is the current index, the second argument + is the current key-value pair, and the final argument is the same + pointer ``ctx`` as the final argument to SUNHashMapIterate. * ``ctx`` -- a pointer to pass on to ``yieldfn`` **Returns:** - * ``max_size`` -- iterated the whole map + * ``SUNHASHMAP_ERROR`` -- an error occurred + * ``capacity`` -- iterated the whole map * ``>=0`` -- the index at which the iteration stopped - * ``<-1`` -- an error occurred */ -int SUNHashMap_Iterate(SUNHashMap map, int start, - int (*yieldfn)(int, SUNHashMapKeyValue, const void*), - const void* ctx) +int64_t SUNHashMap_Iterate(SUNHashMap map, int64_t start, + int64_t (*yieldfn)(int64_t, SUNHashMapKeyValue, + const void*), + const void* ctx) { - int i; - - if (map == NULL || yieldfn == NULL) { return (-2); } + if (map == NULL || yieldfn == NULL) { return SUNHASHMAP_ERROR; } - for (i = start; i < map->max_size; i++) + for (int64_t i = start; + i < SUNStlVector_SUNHashMapKeyValue_Size(map->buckets); i++) { - int retval = yieldfn(i, map->buckets[i], ctx); - if (retval >= 0) - { - return (retval); /* yieldfn indicates the loop should break */ - } - if (retval < -1) { return (retval); /* error occurred */ } + int64_t retval = + yieldfn(i, *SUNStlVector_SUNHashMapKeyValue_At(map->buckets, i), ctx); + if (retval == SUNHASHMAP_ERROR) { continue; /* keep looking */ } + else { return (retval); /* yieldfn indicates the loop should break */ } } - return (map->max_size); + return SUNHashMap_Capacity(map); } -static int sunHashMapLinearProbeInsert(int idx, SUNHashMapKeyValue kv, - SUNDIALS_MAYBE_UNUSED const void* ctx) +static int64_t sunHashMapLinearProbeInsert(int64_t idx, SUNHashMapKeyValue kv, + SUNDIALS_MAYBE_UNUSED const void* ctx) { /* find the next open spot */ if (kv == NULL) { return (idx); /* open spot found at idx */ } - return (-1); /* keep looking */ + return SUNHASHMAP_ERROR; /* keep looking */ +} + +static void sunHashMapResize(SUNHashMap map) +{ + int64_t old_capacity = SUNHashMap_Capacity(map); + int64_t new_capacity = old_capacity * 2; + + SUNStlVector_SUNHashMapKeyValue old_buckets = map->buckets; + map->buckets = SUNStlVector_SUNHashMapKeyValue_New(new_capacity, + map->destroyKeyValue); + + /* Set all buckets to NULL */ + for (int64_t i = 0; i < new_capacity; i++) + { + SUNStlVector_SUNHashMapKeyValue_PushBack(map->buckets, NULL); + } + + /* Rehash and reinsert */ + for (int64_t i = 0; i < old_capacity; i++) + { + SUNHashMapKeyValue kvp = *SUNStlVector_SUNHashMapKeyValue_At(old_buckets, i); + if (kvp) { SUNHashMap_Insert(map, kvp->key, kvp->value); } + } + + SUNStlVector_SUNHashMapKeyValue_Destroy(&old_buckets); } /* @@ -176,63 +212,81 @@ static int sunHashMapLinearProbeInsert(int idx, SUNHashMapKeyValue kv, **Arguments:** * ``map`` -- the ``SUNHashMap`` object to operate on - * ``key`` -- the key to store + * ``key`` -- the key to store (we will make a copy) * ``value`` -- the value associated with the key **Returns:** * ``0`` -- success - * ``-1`` -- an error occurred - * ``-2`` -- the map is full + * ``SUNHASHMAP_ERROR`` -- an error occurred + * ``SUNHASHMAP_DUPLICATE`` -- duplicate key */ -int SUNHashMap_Insert(SUNHashMap map, const char* key, void* value) +int64_t SUNHashMap_Insert(SUNHashMap map, const char* key, void* value) { - int idx; - int retval; + int64_t idx; + int64_t retval; SUNHashMapKeyValue kvp; - if (map == NULL || key == NULL || value == NULL) { return (-1); } + if (map == NULL || key == NULL || value == NULL) { return SUNHASHMAP_ERROR; } - /* We want the index to be in (0, map->max_size) */ - idx = (int)(fnv1a_hash(key) % map->max_size); + idx = sunHashMapIdxFromKey(map, key); - /* Check if the bucket is already filled */ - if (map->buckets[idx] != NULL) + /* Check if the bucket is already filled (i.e., we might have had a collision) */ + kvp = *SUNStlVector_SUNHashMapKeyValue_At(map->buckets, idx); + if (kvp != NULL) { - /* Find the next open spot */ - retval = SUNHashMap_Iterate(map, idx, sunHashMapLinearProbeInsert, NULL); - if (retval < 0) { return (-1); /* error occurred */ } - if (retval == map->max_size) { return (-2); /* no open entry */ } + /* Determine if key is actually a duplicate (not allowed) */ + if (!strcmp(key, kvp->key)) { return SUNHASHMAP_DUPLICATE; } + + /* OK, it was a real collision, so find the next open spot */ + retval = SUNHashMap_Iterate(map, idx + 1, sunHashMapLinearProbeInsert, NULL); + if (retval == SUNHASHMAP_ERROR) + { + /* an error occurred */ + return retval; + } + else if (retval == SUNHashMap_Capacity(map)) + { + /* the map is out of empty buckets, so we grow it */ + sunHashMapResize(map); + return SUNHashMap_Insert(map, key, value); + } idx = retval; } /* Create the key-value pair */ kvp = (SUNHashMapKeyValue)malloc(sizeof(*kvp)); - if (kvp == NULL) { return (-1); } - kvp->key = key; + /* Copy the original_key so that the hashmap owns it */ + int64_t len = strlen(key) + 1; + char* key_copy = malloc(sizeof(*key) * len); + strcpy(key_copy, key); + + kvp->key = key_copy; kvp->value = value; /* Insert the key-value pair */ - map->buckets[idx] = kvp; - map->size++; + SUNStlVector_SUNHashMapKeyValue_Set(map->buckets, idx, kvp); return (0); } -static int sunHashMapLinearProbeGet(int idx, SUNHashMapKeyValue kv, - const void* key) +static int64_t sunHashMapLinearProbeGet(int64_t idx, SUNHashMapKeyValue kv, + const void* key) { /* target key cannot be NULL */ - if (key == NULL) { return (-2); } + if (key == NULL) { return SUNHASHMAP_KEYNOTFOUND; } /* find the matching entry */ - if (kv == NULL) { return (-1); /* keep looking since this bucket is empty */ } + if (kv == NULL) + { + return SUNHASHMAP_ERROR; /* keep looking since this bucket is empty */ + } if (!strcmp(kv->key, (const char*)key)) { return (idx); /* found it at idx */ } - return (-1); /* keep looking */ + return SUNHASHMAP_ERROR; /* keep looking */ } /* @@ -245,33 +299,95 @@ static int sunHashMapLinearProbeGet(int idx, SUNHashMapKeyValue kv, **Returns:** * ``0`` -- success - * ``-1`` -- an error occurred - * ``-2`` -- key not found + * ``SUNHASHMAP_ERROR`` -- an error occurred + * ``SUNHASHMAP_KEYNOTFOUND`` -- key not found */ -int SUNHashMap_GetValue(SUNHashMap map, const char* key, void** value) +int64_t SUNHashMap_GetValue(SUNHashMap map, const char* key, void** value) { - int idx; - int retval; + int64_t idx; + int64_t retval; + sunbooleantype collision; if (map == NULL || key == NULL || value == NULL) { return (-1); } - /* We want the index to be in (0, map->max_size) */ - idx = (int)(fnv1a_hash(key) % map->max_size); + idx = sunHashMapIdxFromKey(map, key); + + SUNHashMapKeyValue kvp = *SUNStlVector_SUNHashMapKeyValue_At(map->buckets, idx); + + /* Check for a collision (NULL kvp means there was a collision at one point, but + the colliding key has since been removed)*/ + collision = kvp ? strcmp(kvp->key, key) : SUNTRUE; + + /* Resolve a collision via linear probing */ + if (collision) + { + retval = SUNHashMap_Iterate(map, idx + 1, sunHashMapLinearProbeGet, key); + if (retval == SUNHASHMAP_ERROR) + { + /* the key was either not found anywhere or an error occurred */ + return retval; + } + else { idx = retval; } + } + + /* Return a reference to the value only */ + SUNHashMapKeyValue* kvp_ptr = SUNStlVector_SUNHashMapKeyValue_At(map->buckets, + idx); + if (kvp_ptr) { *value = (*kvp_ptr)->value; } + else { return SUNHASHMAP_KEYNOTFOUND; } + + return (0); +} + +/* + This function remove the key-value pair. + + **Arguments:** + * ``map`` -- the ``SUNHashMap`` object to operate on + * ``key`` -- the key to remove + * ``value`` -- the value to remove + + **Returns:** + * ``0`` -- success + * ``SUNHASHMAP_ERROR`` -- an error occurred + * ``SUNHASHMAP_KEYNOTFOUND`` -- key not found + */ +int64_t SUNHashMap_Remove(SUNHashMap map, const char* key, void** value) +{ + int64_t idx; + int64_t retval; + sunbooleantype collision; + + if (map == NULL || key == NULL) { return SUNHASHMAP_ERROR; } + + idx = sunHashMapIdxFromKey(map, key); + + SUNHashMapKeyValue kvp = *SUNStlVector_SUNHashMapKeyValue_At(map->buckets, idx); - /* Check if the key exists */ - if (map->buckets[idx] == NULL) { return (-2); } + /* Check for a collision (NULL kvp means there was a collision at one point, but + the colliding key has since been removed)*/ + collision = kvp ? strcmp(kvp->key, key) : SUNTRUE; /* Check to see if this is a collision */ - if (strcmp(map->buckets[idx]->key, key)) + if (collision) { /* Keys did not match, so we have a collision and need to probe */ - retval = SUNHashMap_Iterate(map, idx + 1, sunHashMapLinearProbeGet, key); - if (retval < 0) { return (-1); /* error occurred */ } - if (retval == map->max_size) { return (-2); /* not found */ } + retval = SUNHashMap_Iterate(map, idx + 1, sunHashMapLinearProbeGet, + (const void*)key); + if (retval == SUNHASHMAP_ERROR) + { + /* an error occurred or the key was not found anywhere */ + return retval; + } + else { idx = retval; } } /* Return a reference to the value only */ - *value = map->buckets[idx]->value; + kvp = *SUNStlVector_SUNHashMapKeyValue_At(map->buckets, idx); + *value = kvp->value; + + /* Clear the bucket by setting it to NULL */ + SUNStlVector_SUNHashMapKeyValue_Set(map->buckets, idx, NULL); return (0); } @@ -294,17 +410,19 @@ int SUNHashMap_GetValue(SUNHashMap map, const char* key, void** value) SUNErrCode SUNHashMap_Sort(SUNHashMap map, SUNHashMapKeyValue** sorted, int (*compar)(const void*, const void*)) { - int i; - if (!map || !compar) { return SUN_ERR_ARG_CORRUPT; } - *sorted = (SUNHashMapKeyValue*)malloc(map->max_size * sizeof(**sorted)); + *sorted = + (SUNHashMapKeyValue*)malloc(SUNHashMap_Capacity(map) * sizeof(**sorted)); if (!(*sorted)) { return SUN_ERR_MALLOC_FAIL; } /* Copy the buckets into a new array */ - for (i = 0; i < map->max_size; i++) { (*sorted)[i] = map->buckets[i]; } + for (int64_t i = 0; i < SUNHashMap_Capacity(map); i++) + { + (*sorted)[i] = *SUNStlVector_SUNHashMapKeyValue_At(map->buckets, i); + } - qsort(*sorted, map->max_size, sizeof(SUNHashMapKeyValue), compar); + qsort(*sorted, SUNHashMap_Capacity(map), sizeof(SUNHashMapKeyValue), compar); return SUN_SUCCESS; } @@ -320,23 +438,37 @@ SUNErrCode SUNHashMap_Sort(SUNHashMap map, SUNHashMapKeyValue** sorted, **Returns:** * A SUNErrCode indicating success or a failure */ -#if SUNDIALS_MPI_ENABLED -SUNErrCode SUNHashMap_Values(SUNHashMap map, void*** values, size_t value_size) +SUNErrCode SUNHashMap_Values(SUNHashMap map, void*** values, int64_t value_size) { - int i; int count = 0; if (!map) { return SUN_ERR_ARG_CORRUPT; } - *values = (void**)malloc(map->size * value_size); + *values = (void**)malloc(SUNHashMap_Capacity(map) * value_size); if (!values) { return SUN_ERR_MALLOC_FAIL; } /* Copy the values into a new array */ - for (i = 0; i < map->max_size; i++) + for (int64_t i = 0; i < SUNHashMap_Capacity(map); i++) + { + SUNHashMapKeyValue kvp = *SUNStlVector_SUNHashMapKeyValue_At(map->buckets, i); + if (kvp) { (*values)[count++] = kvp->value; } + } + + return SUN_SUCCESS; +} + +SUNErrCode SUNHashMap_PrintKeys(SUNHashMap map, FILE* file) +{ + if (!map) { return SUN_ERR_ARG_CORRUPT; } + + /* Print keys into a new array */ + fprintf(file, "["); + for (int64_t i = 0; i < SUNHashMap_Capacity(map); i++) { - if (map->buckets[i]) { (*values)[count++] = map->buckets[i]->value; } + SUNHashMapKeyValue kvp = *SUNStlVector_SUNHashMapKeyValue_At(map->buckets, i); + if (kvp) { fprintf(file, "%s, ", kvp->key); } } + fprintf(file, "]\n"); return SUN_SUCCESS; } -#endif diff --git a/src/sundials/sundials_hashmap_impl.h b/src/sundials/sundials_hashmap_impl.h index 235947ed71..37b2c619ba 100644 --- a/src/sundials/sundials_hashmap_impl.h +++ b/src/sundials/sundials_hashmap_impl.h @@ -23,35 +23,63 @@ #include #include +#ifdef __cplusplus +extern "C" { +#endif + +#define SUNHASHMAP_ERROR -99 +#define SUNHASHMAP_KEYNOTFOUND -1 +#define SUNHASHMAP_DUPLICATE -2 + typedef struct SUNHashMapKeyValue_* SUNHashMapKeyValue; struct SUNHashMapKeyValue_ { - const char* key; + char* key; void* value; }; +#define TTYPE SUNHashMapKeyValue +#include "stl/sunstl_vector.h" +#undef TTYPE + typedef struct SUNHashMap_* SUNHashMap; struct SUNHashMap_ { - int size; /* current number of entries */ - int max_size; /* max number of entries */ - SUNHashMapKeyValue* buckets; + int64_t capacity; /* max number of entries */ + void (*destroyKeyValue)(SUNHashMapKeyValue*); + SUNStlVector_SUNHashMapKeyValue buckets; }; -SUNErrCode SUNHashMap_New(int max_size, SUNHashMap* map); -SUNErrCode SUNHashMap_Destroy(SUNHashMap* map, void (*freevalue)(void* ptr)); -int SUNHashMap_Iterate(SUNHashMap map, int start, - int (*yieldfn)(int, SUNHashMapKeyValue, const void*), - const void* ctx); -int SUNHashMap_Insert(SUNHashMap map, const char* key, void* value); -int SUNHashMap_GetValue(SUNHashMap map, const char* key, void** value); +SUNErrCode SUNHashMap_New(int64_t capacity, + void (*destroyValue)(SUNHashMapKeyValue* value_ptr), + SUNHashMap* map); + +int64_t SUNHashMap_Capacity(SUNHashMap map); + +SUNErrCode SUNHashMap_Destroy(SUNHashMap* map); + +int64_t SUNHashMap_Iterate(SUNHashMap map, int64_t start, + int64_t (*yieldfn)(int64_t, SUNHashMapKeyValue, + const void*), + const void* ctx); + +int64_t SUNHashMap_Insert(SUNHashMap map, const char* key, void* value); + +int64_t SUNHashMap_GetValue(SUNHashMap map, const char* key, void** value); + +int64_t SUNHashMap_Remove(SUNHashMap map, const char* key, void** value); + SUNErrCode SUNHashMap_Sort(SUNHashMap map, SUNHashMapKeyValue** sorted, int (*compar)(const void*, const void*)); -#if SUNDIALS_MPI_ENABLED -SUNErrCode SUNHashMap_Values(SUNHashMap map, void*** values, size_t value_size); +SUNErrCode SUNHashMap_Values(SUNHashMap map, void*** values, int64_t value_size); + +SUNErrCode SUNHashMap_PrintKeys(SUNHashMap map, FILE* file); + +#ifdef __cplusplus +} #endif #endif diff --git a/src/sundials/sundials_logger.c b/src/sundials/sundials_logger.c index 6038d5f137..60239bfc0a 100644 --- a/src/sundials/sundials_logger.c +++ b/src/sundials/sundials_logger.c @@ -21,7 +21,10 @@ #include #include #include -#include + +#include "sundials/sundials_errors.h" +#include "sundials/sundials_types.h" +#include "sundials_hashmap_impl.h" #if SUNDIALS_MPI_ENABLED #include @@ -31,8 +34,8 @@ #include "sundials_macros.h" #include "sundials_utils.h" -/* max number of files that can be opened */ -#define SUN_MAX_LOGFILE_HANDLES_ 8 +/* default number of files that we allocate space for */ +#define SUN_DEFAULT_LOGFILE_HANDLES_ 8 void sunCreateLogMessage(SUNLogLevel lvl, int rank, const char* scope, const char* label, const char* txt, va_list args, @@ -50,7 +53,10 @@ void sunCreateLogMessage(SUNLogLevel lvl, int rank, const char* scope, msg_length = sunvasnprintf(&formatted_txt, txt, args); if (msg_length < 0) { - fprintf(stderr, "[FATAL LOGGER ERROR] %s\n", "message size too large"); + char* fileAndLine = sunCombineFileAndLine(__LINE__ + 1, __FILE__); + fprintf(stderr, "[ERROR][rank %d][%s][%s] %s\n", rank, fileAndLine, + __func__, "FATAL LOGGER ERROR: message size too large"); + free(fileAndLine); } if (lvl == SUN_LOGLEVEL_DEBUG) { prefix = (char*)"DEBUG"; } @@ -119,6 +125,12 @@ static sunbooleantype sunLoggerIsOutputRank(SUNDIALS_MAYBE_UNUSED SUNLogger logg return retval; } +static void sunLoggerFreeKeyValue(SUNHashMapKeyValue* kv_ptr) +{ + if (!kv_ptr || !(*kv_ptr)) { return; } + sunCloseLogFile((*kv_ptr)->value); +} + SUNErrCode SUNLogger_Create(SUNComm comm, int output_rank, SUNLogger* logger_ptr) { SUNLogger logger = NULL; @@ -157,7 +169,8 @@ SUNErrCode SUNLogger_Create(SUNComm comm, int output_rank, SUNLogger* logger_ptr /* We store the FILE* in a hash map so that we can ensure that we do not open a file twice if the same file is used for multiple output levels */ - SUNHashMap_New(SUN_MAX_LOGFILE_HANDLES_, &logger->filenames); + SUNHashMap_New(SUN_DEFAULT_LOGFILE_HANDLES_, sunLoggerFreeKeyValue, + &logger->filenames); } return SUN_SUCCESS; @@ -460,7 +473,7 @@ SUNErrCode SUNLogger_Destroy(SUNLogger* logger_ptr) if (sunLoggerIsOutputRank(logger, NULL)) { - SUNHashMap_Destroy(&logger->filenames, sunCloseLogFile); + SUNHashMap_Destroy(&logger->filenames); } #if SUNDIALS_MPI_ENABLED diff --git a/src/sundials/sundials_matrix.c b/src/sundials/sundials_matrix.c index 7e2fa8c87e..1621ed057a 100644 --- a/src/sundials/sundials_matrix.c +++ b/src/sundials/sundials_matrix.c @@ -18,6 +18,8 @@ * in sundials_matrix.h * -----------------------------------------------------------------*/ +#include "sundials/sundials_matrix.h" + #include #include #include @@ -52,16 +54,17 @@ SUNMatrix SUNMatNewEmpty(SUNContext sunctx) SUNAssertNull(ops, SUN_ERR_MALLOC_FAIL); /* 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; + 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->mattransposevec = NULL; + ops->space = NULL; /* attach ops and initialize content to NULL */ A->ops = ops; @@ -221,6 +224,16 @@ SUNErrCode SUNMatMatvec(SUNMatrix A, N_Vector x, N_Vector y) return (ier); } +SUNErrCode SUNMatMatTransposeVec(SUNMatrix A, N_Vector x, N_Vector y) +{ + SUNErrCode ier; + SUNDIALS_MARK_FUNCTION_BEGIN(getSUNProfiler(A)); + if (A->ops->mattransposevec) { ier = A->ops->mattransposevec(A, x, y); } + else { ier = SUN_ERR_NOT_IMPLEMENTED; } + SUNDIALS_MARK_FUNCTION_END(getSUNProfiler(A)); + return (ier); +} + SUNErrCode SUNMatSpace(SUNMatrix A, long int* lenrw, long int* leniw) { SUNErrCode ier; diff --git a/src/sundials/sundials_memory.c b/src/sundials/sundials_memory.c index ca9fc3e961..3b7fc5bb12 100644 --- a/src/sundials/sundials_memory.c +++ b/src/sundials/sundials_memory.c @@ -40,7 +40,8 @@ SUNMemory SUNMemoryNewEmpty(SUNContext sunctx) mem = (SUNMemory)malloc(sizeof(struct SUNMemory_)); SUNAssertNull(mem, SUN_ERR_MALLOC_FAIL); - mem->bytes = 0; + mem->bytes = 0; + mem->stride = 1; return (mem); } @@ -146,6 +147,20 @@ SUNErrCode SUNMemoryHelper_Alloc(SUNMemoryHelper helper, SUNMemory* memptr, return ier; } +SUNErrCode SUNMemoryHelper_AllocStrided(SUNMemoryHelper helper, SUNMemory* memptr, + size_t mem_size, size_t stride, + SUNMemoryType mem_type, void* queue) +{ + SUNErrCode ier = SUN_SUCCESS; + SUNFunctionBegin(helper->sunctx); + SUNAssert(helper->ops->allocstrided, SUN_ERR_NOT_IMPLEMENTED); + SUNDIALS_MARK_FUNCTION_BEGIN(getSUNProfiler(helper)); + ier = helper->ops->allocstrided(helper, memptr, mem_size, stride, mem_type, + queue); + SUNDIALS_MARK_FUNCTION_END(getSUNProfiler(helper)); + return ier; +} + SUNErrCode SUNMemoryHelper_Dealloc(SUNMemoryHelper helper, SUNMemory mem, void* queue) { diff --git a/src/sundials/sundials_profiler.c b/src/sundials/sundials_profiler.c index c85244817c..44468a800c 100644 --- a/src/sundials/sundials_profiler.c +++ b/src/sundials/sundials_profiler.c @@ -12,6 +12,7 @@ * SUNDIALS Copyright End * -----------------------------------------------------------------*/ +#include #include #include #include @@ -103,6 +104,12 @@ static void sunTimerStructFree(void* TS) } } +static void sunProfilerDestroyKeyValue(SUNHashMapKeyValue* kv_ptr) +{ + if (!kv_ptr || !(*kv_ptr)) { return; } + sunTimerStructFree((*kv_ptr)->value); +} + static void sunStartTiming(sunTimerStruct* entry) { sunclock_gettime_monotonic(entry->tic); @@ -182,7 +189,7 @@ SUNErrCode SUNProfiler_Create(SUNComm comm, const char* title, SUNProfiler* p) if (max_entries <= 0) { max_entries = 2560; } /* Create the hashmap used to store the timers */ - if (SUNHashMap_New(max_entries, &profiler->map)) + if (SUNHashMap_New(max_entries, sunProfilerDestroyKeyValue, &profiler->map)) { sunTimerStructFree((void*)profiler->overhead); free(profiler); @@ -225,7 +232,7 @@ SUNErrCode SUNProfiler_Free(SUNProfiler* p) if (*p) { - SUNHashMap_Destroy(&(*p)->map, sunTimerStructFree); + SUNHashMap_Destroy(&(*p)->map); sunTimerStructFree((void*)(*p)->overhead); #if SUNDIALS_MPI_ENABLED if ((*p)->comm != SUN_COMM_NULL) { MPI_Comm_free(&(*p)->comm); } @@ -240,7 +247,7 @@ SUNErrCode SUNProfiler_Free(SUNProfiler* p) SUNErrCode SUNProfiler_Begin(SUNProfiler p, const char* name) { - SUNErrCode ier; + int64_t ier; sunTimerStruct* timer = NULL; if (!p) { return SUN_ERR_ARG_CORRUPT; } @@ -255,8 +262,8 @@ SUNErrCode SUNProfiler_Begin(SUNProfiler p, const char* name) { sunTimerStructFree(timer); sunStopTiming(p->overhead); - if (ier == -1) { return SUN_ERR_PROFILER_MAPINSERT; } - if (ier == -2) { return SUN_ERR_PROFILER_MAPFULL; } + if (ier == SUNHASHMAP_ERROR) { return SUN_ERR_PROFILER_MAPINSERT; } + if (ier == SUNHASHMAP_DUPLICATE) { return SUN_ERR_PROFILER_MAPFULL; } } } @@ -269,7 +276,7 @@ SUNErrCode SUNProfiler_Begin(SUNProfiler p, const char* name) SUNErrCode SUNProfiler_End(SUNProfiler p, const char* name) { - SUNErrCode ier; + int64_t ier; sunTimerStruct* timer; if (!p) { return SUN_ERR_ARG_CORRUPT; } @@ -280,8 +287,11 @@ SUNErrCode SUNProfiler_End(SUNProfiler p, const char* name) if (ier) { sunStopTiming(p->overhead); - if (ier == -1) { return SUN_ERR_PROFILER_MAPGET; } - if (ier == -2) { return SUN_ERR_PROFILER_MAPKEYNOTFOUND; } + if (ier == SUNHASHMAP_ERROR) { return SUN_ERR_PROFILER_MAPGET; } + if (ier == SUNHASHMAP_KEYNOTFOUND) + { + return SUN_ERR_PROFILER_MAPKEYNOTFOUND; + } } sunStopTiming(timer); @@ -333,9 +343,6 @@ SUNErrCode SUNProfiler_GetElapsedTime(SUNProfiler p, const char* name, SUNErrCode SUNProfiler_Reset(SUNProfiler p) { - int i = 0; - sunTimerStruct* timer = NULL; - if (!p) { return SUN_ERR_ARG_CORRUPT; } /* Reset the overhead timer */ @@ -343,10 +350,13 @@ SUNErrCode SUNProfiler_Reset(SUNProfiler p) sunStartTiming(p->overhead); /* Reset all timers */ - for (i = 0; i < p->map->max_size; i++) + for (int64_t i = 0; i < SUNHashMap_Capacity(p->map); i++) { - if (!(p->map->buckets[i])) { continue; } - timer = p->map->buckets[i]->value; + SUNHashMapKeyValue* kvp = + SUNStlVector_SUNHashMapKeyValue_At(p->map->buckets, i); + + if (!kvp || !(*kvp)) { continue; } + sunTimerStruct* timer = (*kvp)->value; if (timer) { sunResetTiming(timer); } } @@ -361,8 +371,7 @@ SUNErrCode SUNProfiler_Reset(SUNProfiler p) SUNErrCode SUNProfiler_Print(SUNProfiler p, FILE* fp) { - SUNErrCode ier = 0; - int i = 0; + int64_t ier = 0; int rank = 0; sunTimerStruct* timer = NULL; SUNHashMapKeyValue* sorted = NULL; @@ -376,8 +385,8 @@ SUNErrCode SUNProfiler_Print(SUNProfiler p, FILE* fp) SUNDIALS_MARK_BEGIN(p, SUNDIALS_ROOT_TIMER); ier = SUNHashMap_GetValue(p->map, SUNDIALS_ROOT_TIMER, (void**)&timer); - if (ier == -1) { return SUN_ERR_PROFILER_MAPGET; } - if (ier == -2) { return SUN_ERR_PROFILER_MAPKEYNOTFOUND; } + if (ier == SUNHASHMAP_ERROR) { return SUN_ERR_PROFILER_MAPGET; } + if (ier == SUNHASHMAP_KEYNOTFOUND) { return SUN_ERR_PROFILER_MAPKEYNOTFOUND; } p->sundials_time = timer->elapsed; #if SUNDIALS_MPI_ENABLED @@ -417,7 +426,7 @@ SUNErrCode SUNProfiler_Print(SUNProfiler p, FILE* fp) #endif /* Print all the other timers out */ - for (i = 0; i < p->map->size; i++) + for (int64_t i = 0; i < SUNHashMap_Capacity(p->map); i++) { if (sorted[i]) { sunPrintTimer(sorted[i], fp, (void*)p); } } @@ -457,7 +466,7 @@ static void sunTimerStructReduceMaxAndSum(void* a, void* b, int* len, /* Find the max and average time across all ranks */ SUNErrCode sunCollectTimers(SUNProfiler p) { - int i, rank, nranks; + int rank, nranks; MPI_Comm comm = p->comm; MPI_Comm_rank(comm, &rank); @@ -465,11 +474,20 @@ SUNErrCode sunCollectTimers(SUNProfiler p) sunTimerStruct** values = NULL; + /* MPI restricts us to int, but the hashmap allows int64_t. + We add a check here to make sure that the capacity does + not exceed an int, although it is unlikely we ever will. */ + if (SUNHashMap_Capacity(p->map) > INT_MAX) + { + return SUN_ERR_PROFILER_MAPFULL; + } + int map_size = (int)SUNHashMap_Capacity(p->map); + /* Extract the elapsed times from the hash map */ SUNHashMap_Values(p->map, (void***)&values, sizeof(sunTimerStruct)); sunTimerStruct* reduced = - (sunTimerStruct*)malloc(p->map->size * sizeof(sunTimerStruct)); - for (i = 0; i < p->map->size; ++i) { reduced[i] = *values[i]; } + (sunTimerStruct*)malloc(map_size * sizeof(sunTimerStruct)); + for (int i = 0; i < map_size; ++i) { reduced[i] = *values[i]; } /* Register MPI datatype for sunTimerStruct */ MPI_Datatype tmp_type, MPI_sunTimerStruct; @@ -492,12 +510,12 @@ SUNErrCode sunCollectTimers(SUNProfiler p) /* Compute max and average time across all ranks */ if (rank == 0) { - MPI_Reduce(MPI_IN_PLACE, reduced, p->map->size, MPI_sunTimerStruct, + MPI_Reduce(MPI_IN_PLACE, reduced, map_size, MPI_sunTimerStruct, MPI_sunTimerStruct_MAXANDSUM, 0, comm); } else { - MPI_Reduce(reduced, reduced, p->map->size, MPI_sunTimerStruct, + MPI_Reduce(reduced, reduced, map_size, MPI_sunTimerStruct, MPI_sunTimerStruct_MAXANDSUM, 0, comm); } @@ -507,7 +525,7 @@ SUNErrCode sunCollectTimers(SUNProfiler p) MPI_Op_free(&MPI_sunTimerStruct_MAXANDSUM); /* Update the values that are in this rank's hash map. */ - for (i = 0; i < p->map->size; ++i) + for (int64_t i = 0; i < map_size; ++i) { values[i]->average = reduced[i].average / (double)nranks; values[i]->maximum = reduced[i].maximum; diff --git a/src/sundials/sundials_stepper.c b/src/sundials/sundials_stepper.c new file mode 100644 index 0000000000..fd1fd9fdf1 --- /dev/null +++ b/src/sundials/sundials_stepper.c @@ -0,0 +1,206 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 + * -----------------------------------------------------------------*/ + +#include +#include +#include +#include + +#include "sundials/sundials_errors.h" +#include "sundials/sundials_nvector.h" +#include "sundials/sundials_types.h" +#include "sundials_stepper_impl.h" + +SUNErrCode SUNStepper_Create(SUNContext sunctx, SUNStepper* stepper_ptr) +{ + SUNFunctionBegin(sunctx); + SUNCheck(stepper_ptr, SUN_ERR_ARG_CORRUPT); + + SUNStepper stepper = malloc(sizeof(*stepper)); + SUNAssert(stepper, SUN_ERR_MALLOC_FAIL); + + stepper->content = NULL; + stepper->sunctx = sunctx; + stepper->last_flag = SUN_SUCCESS; + + stepper->ops = malloc(sizeof(*(stepper->ops))); + SUNAssert(stepper->ops, SUN_ERR_MALLOC_FAIL); + + stepper->ops->evolve = NULL; + stepper->ops->onestep = NULL; + stepper->ops->fullrhs = NULL; + stepper->ops->reset = NULL; + stepper->ops->setstoptime = NULL; + stepper->ops->setforcing = NULL; + stepper->ops->destroy = NULL; + + *stepper_ptr = stepper; + + return SUN_SUCCESS; +} + +SUNErrCode SUNStepper_Destroy(SUNStepper* stepper_ptr) +{ + if (stepper_ptr != NULL) + { + const SUNStepper_Ops ops = (*stepper_ptr)->ops; + if (ops && ops->destroy) { ops->destroy(*stepper_ptr); } + free(ops); + free(*stepper_ptr); + *stepper_ptr = NULL; + } + + return SUN_SUCCESS; +} + +SUNErrCode SUNStepper_Evolve(SUNStepper stepper, sunrealtype tout, N_Vector y, + sunrealtype* tret) +{ + SUNFunctionBegin(stepper->sunctx); + if (stepper->ops->evolve) + { + return stepper->ops->evolve(stepper, tout, y, tret); + } + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNStepper_OneStep(SUNStepper stepper, sunrealtype tout, N_Vector y, + sunrealtype* tret) +{ + SUNFunctionBegin(stepper->sunctx); + if (stepper->ops->onestep) + { + return stepper->ops->onestep(stepper, tout, y, tret); + } + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNStepper_FullRhs(SUNStepper stepper, sunrealtype t, N_Vector v, + N_Vector f, SUNFullRhsMode mode) +{ + SUNFunctionBegin(stepper->sunctx); + if (stepper->ops->fullrhs) + { + return stepper->ops->fullrhs(stepper, t, v, f, mode); + } + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNStepper_Reset(SUNStepper stepper, sunrealtype tR, N_Vector yR, + int64_t ckptIdxR) +{ + SUNFunctionBegin(stepper->sunctx); + if (stepper->ops->reset) + { + return stepper->ops->reset(stepper, tR, yR, ckptIdxR); + } + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNStepper_SetStopTime(SUNStepper stepper, sunrealtype tstop) +{ + SUNFunctionBegin(stepper->sunctx); + if (stepper->ops->setstoptime) + { + return stepper->ops->setstoptime(stepper, tstop); + } + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNStepper_SetForcing(SUNStepper stepper, sunrealtype tshift, + sunrealtype tscale, N_Vector* forcing, + int nforcing) +{ + SUNFunctionBegin(stepper->sunctx); + if (stepper->ops->setforcing) + { + return stepper->ops->setforcing(stepper, tshift, tscale, forcing, nforcing); + } + return SUN_ERR_NOT_IMPLEMENTED; +} + +SUNErrCode SUNStepper_SetContent(SUNStepper stepper, void* content) +{ + SUNFunctionBegin(stepper->sunctx); + stepper->content = content; + return SUN_SUCCESS; +} + +SUNErrCode SUNStepper_GetContent(SUNStepper stepper, void** content) +{ + SUNFunctionBegin(stepper->sunctx); + *content = stepper->content; + return SUN_SUCCESS; +} + +SUNErrCode SUNStepper_SetLastFlag(SUNStepper stepper, int last_flag) +{ + SUNFunctionBegin(stepper->sunctx); + stepper->last_flag = last_flag; + return SUN_SUCCESS; +} + +SUNErrCode SUNStepper_GetLastFlag(SUNStepper stepper, int* last_flag) +{ + SUNFunctionBegin(stepper->sunctx); + *last_flag = stepper->last_flag; + return SUN_SUCCESS; +} + +SUNErrCode SUNStepper_SetEvolveFn(SUNStepper stepper, SUNStepperEvolveFn fn) +{ + SUNFunctionBegin(stepper->sunctx); + stepper->ops->evolve = fn; + return SUN_SUCCESS; +} + +SUNErrCode SUNStepper_SetOneStepFn(SUNStepper stepper, SUNStepperOneStepFn fn) +{ + SUNFunctionBegin(stepper->sunctx); + stepper->ops->onestep = fn; + return SUN_SUCCESS; +} + +SUNErrCode SUNStepper_SetFullRhsFn(SUNStepper stepper, SUNStepperFullRhsFn fn) +{ + SUNFunctionBegin(stepper->sunctx); + stepper->ops->fullrhs = fn; + return SUN_SUCCESS; +} + +SUNErrCode SUNStepper_SetResetFn(SUNStepper stepper, SUNStepperResetFn fn) +{ + SUNFunctionBegin(stepper->sunctx); + stepper->ops->reset = fn; + return SUN_SUCCESS; +} + +SUNErrCode SUNStepper_SetStopTimeFn(SUNStepper stepper, SUNStepperSetStopTimeFn fn) +{ + SUNFunctionBegin(stepper->sunctx); + stepper->ops->setstoptime = fn; + return SUN_SUCCESS; +} + +SUNErrCode SUNStepper_SetForcingFn(SUNStepper stepper, SUNStepperSetForcingFn fn) +{ + SUNFunctionBegin(stepper->sunctx); + stepper->ops->setforcing = fn; + return SUN_SUCCESS; +} + +SUNErrCode SUNStepper_SetDestroyFn(SUNStepper stepper, SUNStepperDestroyFn fn) +{ + SUNFunctionBegin(stepper->sunctx); + stepper->ops->destroy = fn; + return SUN_SUCCESS; +} diff --git a/src/sundials/sundials_stepper_impl.h b/src/sundials/sundials_stepper_impl.h new file mode 100644 index 0000000000..ab3b763c51 --- /dev/null +++ b/src/sundials/sundials_stepper_impl.h @@ -0,0 +1,53 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 _SUNDIALS_STEPPER_IMPL_H +#define _SUNDIALS_STEPPER_IMPL_H + +#include +#include + +#ifdef __cplusplus +extern "C" { +#endif + +typedef struct SUNStepper_Ops_* SUNStepper_Ops; + +struct SUNStepper_Ops_ +{ + SUNStepperEvolveFn evolve; + SUNStepperOneStepFn onestep; + SUNStepperFullRhsFn fullrhs; + SUNStepperResetFn reset; + SUNStepperSetStopTimeFn setstoptime; + SUNStepperSetForcingFn setforcing; + SUNStepperDestroyFn destroy; +}; + +struct SUNStepper_ +{ + /* stepper specific content and operations */ + void* content; + SUNStepper_Ops ops; + + /* stepper context */ + SUNContext sunctx; + + /* last stepper return flag */ + int last_flag; +}; + +#ifdef __cplusplus +} +#endif + +#endif /* _SUNDIALS_STEPPER_IMPL_H */ diff --git a/src/sundials/sundials_utils.h b/src/sundials/sundials_utils.h index 44ce2a7d4b..f3d704e2cc 100644 --- a/src/sundials/sundials_utils.h +++ b/src/sundials/sundials_utils.h @@ -24,6 +24,15 @@ #include #include +static inline char* sunSignedToString(int64_t val) +{ + char* str = NULL; + size_t length = snprintf(NULL, 0, "%lld", (long long)val); + str = (char*)malloc(sizeof(*str) * (length + 1)); + snprintf(str, length + 1, "%lld", (long long)val); + return str; +} + static inline char* sunCombineFileAndLine(int line, const char* file) { size_t total_str_len = strlen(file) + 6; diff --git a/src/sunmatrix/band/fmod_int32/fsunmatrix_band_mod.c b/src/sunmatrix/band/fmod_int32/fsunmatrix_band_mod.c index d506997738..9a8ec182bf 100644 --- a/src/sunmatrix/band/fmod_int32/fsunmatrix_band_mod.c +++ b/src/sunmatrix/band/fmod_int32/fsunmatrix_band_mod.c @@ -456,6 +456,22 @@ SWIGEXPORT int _wrap_FSUNMatMatvec_Band(SUNMatrix farg1, N_Vector farg2, N_Vecto } +SWIGEXPORT int _wrap_FSUNMatMatTransposeVec_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 ; + SUNErrCode result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (SUNErrCode)SUNMatMatTransposeVec_Band(arg1,arg2,arg3); + fresult = (SUNErrCode)(result); + return fresult; +} + + SWIGEXPORT int _wrap_FSUNMatSpace_Band(SUNMatrix farg1, long *farg2, long *farg3) { int fresult ; SUNMatrix arg1 = (SUNMatrix) 0 ; diff --git a/src/sunmatrix/band/fmod_int32/fsunmatrix_band_mod.f90 b/src/sunmatrix/band/fmod_int32/fsunmatrix_band_mod.f90 index 82f10ff03b..48f3fd4940 100644 --- a/src/sunmatrix/band/fmod_int32/fsunmatrix_band_mod.f90 +++ b/src/sunmatrix/band/fmod_int32/fsunmatrix_band_mod.f90 @@ -44,6 +44,7 @@ module fsunmatrix_band_mod public :: FSUNMatScaleAdd_Band public :: FSUNMatScaleAddI_Band public :: FSUNMatMatvec_Band + public :: FSUNMatMatTransposeVec_Band public :: FSUNMatSpace_Band public :: FSUNBandMatrix_Data @@ -214,6 +215,16 @@ function swigc_FSUNMatMatvec_Band(farg1, farg2, farg3) & integer(C_INT) :: fresult end function +function swigc_FSUNMatMatTransposeVec_Band(farg1, farg2, farg3) & +bind(C, name="_wrap_FSUNMatMatTransposeVec_Band") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT) :: fresult +end function + function swigc_FSUNMatSpace_Band(farg1, farg2, farg3) & bind(C, name="_wrap_FSUNMatSpace_Band") & result(fresult) @@ -532,6 +543,25 @@ function FSUNMatMatvec_Band(a, x, y) & swig_result = fresult end function +function FSUNMatMatTransposeVec_Band(a, x, y) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNMatrix), target, intent(inout) :: a +type(N_Vector), target, intent(inout) :: x +type(N_Vector), target, intent(inout) :: y +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = c_loc(a) +farg2 = c_loc(x) +farg3 = c_loc(y) +fresult = swigc_FSUNMatMatTransposeVec_Band(farg1, farg2, farg3) +swig_result = fresult +end function + function FSUNMatSpace_Band(a, lenrw, leniw) & result(swig_result) use, intrinsic :: ISO_C_BINDING diff --git a/src/sunmatrix/band/fmod_int64/fsunmatrix_band_mod.c b/src/sunmatrix/band/fmod_int64/fsunmatrix_band_mod.c index 0a5bac84c8..216cc1373a 100644 --- a/src/sunmatrix/band/fmod_int64/fsunmatrix_band_mod.c +++ b/src/sunmatrix/band/fmod_int64/fsunmatrix_band_mod.c @@ -456,6 +456,22 @@ SWIGEXPORT int _wrap_FSUNMatMatvec_Band(SUNMatrix farg1, N_Vector farg2, N_Vecto } +SWIGEXPORT int _wrap_FSUNMatMatTransposeVec_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 ; + SUNErrCode result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (SUNErrCode)SUNMatMatTransposeVec_Band(arg1,arg2,arg3); + fresult = (SUNErrCode)(result); + return fresult; +} + + SWIGEXPORT int _wrap_FSUNMatSpace_Band(SUNMatrix farg1, long *farg2, long *farg3) { int fresult ; SUNMatrix arg1 = (SUNMatrix) 0 ; diff --git a/src/sunmatrix/band/fmod_int64/fsunmatrix_band_mod.f90 b/src/sunmatrix/band/fmod_int64/fsunmatrix_band_mod.f90 index f9b8189f10..8f08eab48d 100644 --- a/src/sunmatrix/band/fmod_int64/fsunmatrix_band_mod.f90 +++ b/src/sunmatrix/band/fmod_int64/fsunmatrix_band_mod.f90 @@ -44,6 +44,7 @@ module fsunmatrix_band_mod public :: FSUNMatScaleAdd_Band public :: FSUNMatScaleAddI_Band public :: FSUNMatMatvec_Band + public :: FSUNMatMatTransposeVec_Band public :: FSUNMatSpace_Band public :: FSUNBandMatrix_Data @@ -214,6 +215,16 @@ function swigc_FSUNMatMatvec_Band(farg1, farg2, farg3) & integer(C_INT) :: fresult end function +function swigc_FSUNMatMatTransposeVec_Band(farg1, farg2, farg3) & +bind(C, name="_wrap_FSUNMatMatTransposeVec_Band") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT) :: fresult +end function + function swigc_FSUNMatSpace_Band(farg1, farg2, farg3) & bind(C, name="_wrap_FSUNMatSpace_Band") & result(fresult) @@ -532,6 +543,25 @@ function FSUNMatMatvec_Band(a, x, y) & swig_result = fresult end function +function FSUNMatMatTransposeVec_Band(a, x, y) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNMatrix), target, intent(inout) :: a +type(N_Vector), target, intent(inout) :: x +type(N_Vector), target, intent(inout) :: y +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = c_loc(a) +farg2 = c_loc(x) +farg3 = c_loc(y) +fresult = swigc_FSUNMatMatTransposeVec_Band(farg1, farg2, farg3) +swig_result = fresult +end function + function FSUNMatSpace_Band(a, lenrw, leniw) & result(swig_result) use, intrinsic :: ISO_C_BINDING diff --git a/src/sunmatrix/band/sunmatrix_band.c b/src/sunmatrix/band/sunmatrix_band.c index f3d06c730b..d740bbdc9d 100644 --- a/src/sunmatrix/band/sunmatrix_band.c +++ b/src/sunmatrix/band/sunmatrix_band.c @@ -77,15 +77,16 @@ SUNMatrix SUNBandMatrixStorage(sunindextype N, sunindextype mu, sunindextype ml, SUNCheckLastErrNull(); /* 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; + 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->mattransposevec = SUNMatMatTransposeVec_Band; + A->ops->space = SUNMatSpace_Band; /* Create content */ content = NULL; @@ -416,6 +417,35 @@ SUNErrCode SUNMatMatvec_Band(SUNMatrix A, N_Vector x, N_Vector y) return SUN_SUCCESS; } +SUNErrCode SUNMatMatTransposeVec_Band(SUNMatrix A, N_Vector x, N_Vector y) +{ + SUNFunctionBegin(A->sunctx); + sunindextype i, j, is, ie; + sunrealtype *col_j, *xd, *yd; + + SUNCheck(compatibleMatrixAndVectors(A, y, x), SUN_ERR_ARG_DIMSMISMATCH); + + /* access vector data (return if failure) */ + xd = N_VGetArrayPointer(x); + SUNCheckLastErr(); + yd = N_VGetArrayPointer(y); + SUNCheckLastErr(); + + SUNAssert(xd, SUN_ERR_MEM_FAIL); + SUNAssert(yd, SUN_ERR_MEM_FAIL); + + /* Perform operation */ + for (i = 0; i < SM_ROWS_B(A); i++) { yd[i] = ZERO; } + for (j = 0; j < SM_COLUMNS_B(A); j++) + { + col_j = SM_COLUMN_B(A, j); + is = SUNMAX(0, j - SM_UBAND_B(A)); + ie = SUNMIN(SM_ROWS_B(A) - 1, j + SM_LBAND_B(A)); + for (i = is; i <= ie; i++) { yd[j] += col_j[i - j] * xd[i]; } + } + return SUN_SUCCESS; +} + SUNErrCode SUNMatSpace_Band(SUNMatrix A, long int* lenrw, long int* leniw) { SUNFunctionBegin(A->sunctx); diff --git a/src/sunmatrix/dense/fmod_int32/fsunmatrix_dense_mod.c b/src/sunmatrix/dense/fmod_int32/fsunmatrix_dense_mod.c index 7f6d3a1a4d..d175d56690 100644 --- a/src/sunmatrix/dense/fmod_int32/fsunmatrix_dense_mod.c +++ b/src/sunmatrix/dense/fmod_int32/fsunmatrix_dense_mod.c @@ -386,6 +386,22 @@ SWIGEXPORT int _wrap_FSUNMatMatvec_Dense(SUNMatrix farg1, N_Vector farg2, N_Vect } +SWIGEXPORT int _wrap_FSUNMatMatTransposeVec_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 ; + SUNErrCode result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (SUNErrCode)SUNMatMatTransposeVec_Dense(arg1,arg2,arg3); + fresult = (SUNErrCode)(result); + return fresult; +} + + SWIGEXPORT int _wrap_FSUNMatSpace_Dense(SUNMatrix farg1, long *farg2, long *farg3) { int fresult ; SUNMatrix arg1 = (SUNMatrix) 0 ; diff --git a/src/sunmatrix/dense/fmod_int32/fsunmatrix_dense_mod.f90 b/src/sunmatrix/dense/fmod_int32/fsunmatrix_dense_mod.f90 index 23c12b6eba..6c1dddf7a7 100644 --- a/src/sunmatrix/dense/fmod_int32/fsunmatrix_dense_mod.f90 +++ b/src/sunmatrix/dense/fmod_int32/fsunmatrix_dense_mod.f90 @@ -39,6 +39,7 @@ module fsunmatrix_dense_mod public :: FSUNMatScaleAdd_Dense public :: FSUNMatScaleAddI_Dense public :: FSUNMatMatvec_Dense + public :: FSUNMatMatTransposeVec_Dense public :: FSUNMatSpace_Dense public :: FSUNDenseMatrix_Data @@ -164,6 +165,16 @@ function swigc_FSUNMatMatvec_Dense(farg1, farg2, farg3) & integer(C_INT) :: fresult end function +function swigc_FSUNMatMatTransposeVec_Dense(farg1, farg2, farg3) & +bind(C, name="_wrap_FSUNMatMatTransposeVec_Dense") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT) :: fresult +end function + function swigc_FSUNMatSpace_Dense(farg1, farg2, farg3) & bind(C, name="_wrap_FSUNMatSpace_Dense") & result(fresult) @@ -402,6 +413,25 @@ function FSUNMatMatvec_Dense(a, x, y) & swig_result = fresult end function +function FSUNMatMatTransposeVec_Dense(a, x, y) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNMatrix), target, intent(inout) :: a +type(N_Vector), target, intent(inout) :: x +type(N_Vector), target, intent(inout) :: y +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = c_loc(a) +farg2 = c_loc(x) +farg3 = c_loc(y) +fresult = swigc_FSUNMatMatTransposeVec_Dense(farg1, farg2, farg3) +swig_result = fresult +end function + function FSUNMatSpace_Dense(a, lenrw, leniw) & result(swig_result) use, intrinsic :: ISO_C_BINDING diff --git a/src/sunmatrix/dense/fmod_int64/fsunmatrix_dense_mod.c b/src/sunmatrix/dense/fmod_int64/fsunmatrix_dense_mod.c index 140e8d8d61..834db49b9a 100644 --- a/src/sunmatrix/dense/fmod_int64/fsunmatrix_dense_mod.c +++ b/src/sunmatrix/dense/fmod_int64/fsunmatrix_dense_mod.c @@ -386,6 +386,22 @@ SWIGEXPORT int _wrap_FSUNMatMatvec_Dense(SUNMatrix farg1, N_Vector farg2, N_Vect } +SWIGEXPORT int _wrap_FSUNMatMatTransposeVec_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 ; + SUNErrCode result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (SUNErrCode)SUNMatMatTransposeVec_Dense(arg1,arg2,arg3); + fresult = (SUNErrCode)(result); + return fresult; +} + + SWIGEXPORT int _wrap_FSUNMatSpace_Dense(SUNMatrix farg1, long *farg2, long *farg3) { int fresult ; SUNMatrix arg1 = (SUNMatrix) 0 ; diff --git a/src/sunmatrix/dense/fmod_int64/fsunmatrix_dense_mod.f90 b/src/sunmatrix/dense/fmod_int64/fsunmatrix_dense_mod.f90 index 7bfb049939..643bb569c3 100644 --- a/src/sunmatrix/dense/fmod_int64/fsunmatrix_dense_mod.f90 +++ b/src/sunmatrix/dense/fmod_int64/fsunmatrix_dense_mod.f90 @@ -39,6 +39,7 @@ module fsunmatrix_dense_mod public :: FSUNMatScaleAdd_Dense public :: FSUNMatScaleAddI_Dense public :: FSUNMatMatvec_Dense + public :: FSUNMatMatTransposeVec_Dense public :: FSUNMatSpace_Dense public :: FSUNDenseMatrix_Data @@ -164,6 +165,16 @@ function swigc_FSUNMatMatvec_Dense(farg1, farg2, farg3) & integer(C_INT) :: fresult end function +function swigc_FSUNMatMatTransposeVec_Dense(farg1, farg2, farg3) & +bind(C, name="_wrap_FSUNMatMatTransposeVec_Dense") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT) :: fresult +end function + function swigc_FSUNMatSpace_Dense(farg1, farg2, farg3) & bind(C, name="_wrap_FSUNMatSpace_Dense") & result(fresult) @@ -402,6 +413,25 @@ function FSUNMatMatvec_Dense(a, x, y) & swig_result = fresult end function +function FSUNMatMatTransposeVec_Dense(a, x, y) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNMatrix), target, intent(inout) :: a +type(N_Vector), target, intent(inout) :: x +type(N_Vector), target, intent(inout) :: y +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = c_loc(a) +farg2 = c_loc(x) +farg3 = c_loc(y) +fresult = swigc_FSUNMatMatTransposeVec_Dense(farg1, farg2, farg3) +swig_result = fresult +end function + function FSUNMatSpace_Dense(a, lenrw, leniw) & result(swig_result) use, intrinsic :: ISO_C_BINDING diff --git a/src/sunmatrix/dense/sunmatrix_dense.c b/src/sunmatrix/dense/sunmatrix_dense.c index c1250a9eaa..dcb3418dd6 100644 --- a/src/sunmatrix/dense/sunmatrix_dense.c +++ b/src/sunmatrix/dense/sunmatrix_dense.c @@ -61,15 +61,16 @@ SUNMatrix SUNDenseMatrix(sunindextype M, sunindextype N, SUNContext sunctx) SUNCheckLastErrNull(); /* 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; + 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->mattransposevec = SUNMatMatTransposeVec_Dense; + A->ops->space = SUNMatSpace_Dense; /* Create content */ content = NULL; @@ -308,8 +309,7 @@ SUNErrCode SUNMatScaleAdd_Dense(sunrealtype c, SUNMatrix A, SUNMatrix B) SUNErrCode SUNMatMatvec_Dense(SUNMatrix A, N_Vector x, N_Vector y) { SUNFunctionBegin(A->sunctx); - sunindextype i, j; - sunrealtype *col_j, *xd, *yd; + sunrealtype *xd, *yd; SUNAssert(SUNMatGetID(A) == SUNMATRIX_DENSE, SUN_ERR_ARG_WRONGTYPE); SUNCheck(compatibleMatrixAndVectors(A, x, y), SUN_ERR_ARG_DIMSMISMATCH); @@ -325,11 +325,45 @@ SUNErrCode SUNMatMatvec_Dense(SUNMatrix A, N_Vector x, N_Vector y) SUNAssert(xd != yd, SUN_ERR_MEM_FAIL); /* Perform operation y = Ax */ - for (i = 0; i < SM_ROWS_D(A); i++) { yd[i] = ZERO; } - for (j = 0; j < SM_COLUMNS_D(A); j++) + for (sunindextype i = 0; i < SM_ROWS_D(A); i++) { yd[i] = ZERO; } + for (sunindextype j = 0; j < SM_COLUMNS_D(A); j++) + { + sunrealtype* col_j = SM_COLUMN_D(A, j); + for (sunindextype i = 0; i < SM_ROWS_D(A); i++) + { + yd[i] += col_j[i] * xd[j]; + } + } + return SUN_SUCCESS; +} + +SUNErrCode SUNMatMatTransposeVec_Dense(SUNMatrix A, N_Vector x, N_Vector y) +{ + SUNFunctionBegin(A->sunctx); + + SUNAssert(SUNMatGetID(A) == SUNMATRIX_DENSE, SUN_ERR_ARG_WRONGTYPE); + SUNCheck(compatibleMatrixAndVectors(A, y, x), SUN_ERR_ARG_DIMSMISMATCH); + + /* access vector data (return if NULL data pointers) */ + sunrealtype *xd, *yd; + xd = N_VGetArrayPointer(x); + SUNCheckLastErr(); + yd = N_VGetArrayPointer(y); + SUNCheckLastErr(); + + SUNAssert(xd, SUN_ERR_MEM_FAIL); + SUNAssert(yd, SUN_ERR_MEM_FAIL); + SUNAssert(xd != yd, SUN_ERR_MEM_FAIL); + + /* Perform operation y = A^T x */ + for (sunindextype i = 0; i < SM_COLUMNS_D(A); i++) { yd[i] = ZERO; } + for (sunindextype i = 0; i < SM_COLUMNS_D(A); i++) { - col_j = SM_COLUMN_D(A, j); - for (i = 0; i < SM_ROWS_D(A); i++) { yd[i] += col_j[i] * xd[j]; } + sunrealtype* row_i = SM_COLUMN_D(A, i); + for (sunindextype j = 0; j < SM_ROWS_D(A); j++) + { + yd[i] += row_i[j] * xd[j]; + } } return SUN_SUCCESS; } diff --git a/src/sunmatrix/sparse/fmod_int32/fsunmatrix_sparse_mod.c b/src/sunmatrix/sparse/fmod_int32/fsunmatrix_sparse_mod.c index c329b1edde..9079692347 100644 --- a/src/sunmatrix/sparse/fmod_int32/fsunmatrix_sparse_mod.c +++ b/src/sunmatrix/sparse/fmod_int32/fsunmatrix_sparse_mod.c @@ -488,6 +488,22 @@ SWIGEXPORT int _wrap_FSUNMatMatvec_Sparse(SUNMatrix farg1, N_Vector farg2, N_Vec } +SWIGEXPORT int _wrap_FSUNMatMatTransposeVec_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 ; + SUNErrCode result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (SUNErrCode)SUNMatMatTransposeVec_Sparse(arg1,arg2,arg3); + fresult = (SUNErrCode)(result); + return fresult; +} + + SWIGEXPORT int _wrap_FSUNMatSpace_Sparse(SUNMatrix farg1, long *farg2, long *farg3) { int fresult ; SUNMatrix arg1 = (SUNMatrix) 0 ; diff --git a/src/sunmatrix/sparse/fmod_int32/fsunmatrix_sparse_mod.f90 b/src/sunmatrix/sparse/fmod_int32/fsunmatrix_sparse_mod.f90 index fa9ff1555a..ab26902d22 100644 --- a/src/sunmatrix/sparse/fmod_int32/fsunmatrix_sparse_mod.f90 +++ b/src/sunmatrix/sparse/fmod_int32/fsunmatrix_sparse_mod.f90 @@ -48,6 +48,7 @@ module fsunmatrix_sparse_mod public :: FSUNMatScaleAdd_Sparse public :: FSUNMatScaleAddI_Sparse public :: FSUNMatMatvec_Sparse + public :: FSUNMatMatTransposeVec_Sparse public :: FSUNMatSpace_Sparse public :: FSUNSparseMatrix_Data @@ -239,6 +240,16 @@ function swigc_FSUNMatMatvec_Sparse(farg1, farg2, farg3) & integer(C_INT) :: fresult end function +function swigc_FSUNMatMatTransposeVec_Sparse(farg1, farg2, farg3) & +bind(C, name="_wrap_FSUNMatMatTransposeVec_Sparse") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT) :: fresult +end function + function swigc_FSUNMatSpace_Sparse(farg1, farg2, farg3) & bind(C, name="_wrap_FSUNMatSpace_Sparse") & result(fresult) @@ -598,6 +609,25 @@ function FSUNMatMatvec_Sparse(a, x, y) & swig_result = fresult end function +function FSUNMatMatTransposeVec_Sparse(a, x, y) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNMatrix), target, intent(inout) :: a +type(N_Vector), target, intent(inout) :: x +type(N_Vector), target, intent(inout) :: y +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = c_loc(a) +farg2 = c_loc(x) +farg3 = c_loc(y) +fresult = swigc_FSUNMatMatTransposeVec_Sparse(farg1, farg2, farg3) +swig_result = fresult +end function + function FSUNMatSpace_Sparse(a, lenrw, leniw) & result(swig_result) use, intrinsic :: ISO_C_BINDING diff --git a/src/sunmatrix/sparse/fmod_int64/fsunmatrix_sparse_mod.c b/src/sunmatrix/sparse/fmod_int64/fsunmatrix_sparse_mod.c index 3f97241d5f..aef6dc00bb 100644 --- a/src/sunmatrix/sparse/fmod_int64/fsunmatrix_sparse_mod.c +++ b/src/sunmatrix/sparse/fmod_int64/fsunmatrix_sparse_mod.c @@ -488,6 +488,22 @@ SWIGEXPORT int _wrap_FSUNMatMatvec_Sparse(SUNMatrix farg1, N_Vector farg2, N_Vec } +SWIGEXPORT int _wrap_FSUNMatMatTransposeVec_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 ; + SUNErrCode result; + + arg1 = (SUNMatrix)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (SUNErrCode)SUNMatMatTransposeVec_Sparse(arg1,arg2,arg3); + fresult = (SUNErrCode)(result); + return fresult; +} + + SWIGEXPORT int _wrap_FSUNMatSpace_Sparse(SUNMatrix farg1, long *farg2, long *farg3) { int fresult ; SUNMatrix arg1 = (SUNMatrix) 0 ; diff --git a/src/sunmatrix/sparse/fmod_int64/fsunmatrix_sparse_mod.f90 b/src/sunmatrix/sparse/fmod_int64/fsunmatrix_sparse_mod.f90 index eedd562db3..ea71b0338d 100644 --- a/src/sunmatrix/sparse/fmod_int64/fsunmatrix_sparse_mod.f90 +++ b/src/sunmatrix/sparse/fmod_int64/fsunmatrix_sparse_mod.f90 @@ -48,6 +48,7 @@ module fsunmatrix_sparse_mod public :: FSUNMatScaleAdd_Sparse public :: FSUNMatScaleAddI_Sparse public :: FSUNMatMatvec_Sparse + public :: FSUNMatMatTransposeVec_Sparse public :: FSUNMatSpace_Sparse public :: FSUNSparseMatrix_Data @@ -239,6 +240,16 @@ function swigc_FSUNMatMatvec_Sparse(farg1, farg2, farg3) & integer(C_INT) :: fresult end function +function swigc_FSUNMatMatTransposeVec_Sparse(farg1, farg2, farg3) & +bind(C, name="_wrap_FSUNMatMatTransposeVec_Sparse") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT) :: fresult +end function + function swigc_FSUNMatSpace_Sparse(farg1, farg2, farg3) & bind(C, name="_wrap_FSUNMatSpace_Sparse") & result(fresult) @@ -598,6 +609,25 @@ function FSUNMatMatvec_Sparse(a, x, y) & swig_result = fresult end function +function FSUNMatMatTransposeVec_Sparse(a, x, y) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(SUNMatrix), target, intent(inout) :: a +type(N_Vector), target, intent(inout) :: x +type(N_Vector), target, intent(inout) :: y +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = c_loc(a) +farg2 = c_loc(x) +farg3 = c_loc(y) +fresult = swigc_FSUNMatMatTransposeVec_Sparse(farg1, farg2, farg3) +swig_result = fresult +end function + function FSUNMatSpace_Sparse(a, lenrw, leniw) & result(swig_result) use, intrinsic :: ISO_C_BINDING diff --git a/src/sunmatrix/sparse/sunmatrix_sparse.c b/src/sunmatrix/sparse/sunmatrix_sparse.c index 89a1ca576a..d0328d6a60 100644 --- a/src/sunmatrix/sparse/sunmatrix_sparse.c +++ b/src/sunmatrix/sparse/sunmatrix_sparse.c @@ -42,6 +42,8 @@ static sunbooleantype compatibleMatrixAndVectors(SUNMatrix A, N_Vector x, N_Vector y); static SUNErrCode Matvec_SparseCSC(SUNMatrix A, N_Vector x, N_Vector y); static SUNErrCode Matvec_SparseCSR(SUNMatrix A, N_Vector x, N_Vector y); +static SUNErrCode MatTransposeVec_SparseCSC(SUNMatrix A, N_Vector x, N_Vector y); +static SUNErrCode MatTransposeVec_SparseCSR(SUNMatrix A, N_Vector x, N_Vector y); static SUNErrCode format_convert(const SUNMatrix A, SUNMatrix B); /* @@ -79,15 +81,16 @@ SUNMatrix SUNSparseMatrix(sunindextype M, sunindextype N, sunindextype NNZ, SUNCheckLastErrNull(); /* 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; + 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->mattransposevec = SUNMatMatTransposeVec_Sparse; + A->ops->space = SUNMatSpace_Sparse; /* Create content */ content = NULL; @@ -943,6 +946,22 @@ SUNErrCode SUNMatMatvec_Sparse(SUNMatrix A, N_Vector x, N_Vector y) return SUN_SUCCESS; } +SUNErrCode SUNMatMatTransposeVec_Sparse(SUNMatrix A, N_Vector x, N_Vector y) +{ + SUNFunctionBegin(A->sunctx); + SUNAssert(SUNMatGetID(A) == SUNMATRIX_SPARSE, SUN_ERR_ARG_WRONGTYPE); + SUNCheck(compatibleMatrixAndVectors(A, y, x), SUN_ERR_ARG_DIMSMISMATCH); + + /* Perform operation */ + if (SM_SPARSETYPE_S(A) == CSC_MAT) + { + SUNCheckCall(MatTransposeVec_SparseCSC(A, x, y)); + } + else { SUNCheckCall(MatTransposeVec_SparseCSR(A, x, y)); } + + return SUN_SUCCESS; +} + SUNErrCode SUNMatSpace_Sparse(SUNMatrix A, long int* lenrw, long int* leniw) { SUNFunctionBegin(A->sunctx); @@ -1045,6 +1064,40 @@ SUNErrCode Matvec_SparseCSC(SUNMatrix A, N_Vector x, N_Vector y) return SUN_SUCCESS; } +SUNErrCode MatTransposeVec_SparseCSC(SUNMatrix A, N_Vector x, N_Vector y) +{ + sunindextype i, j; + sunindextype *Ap, *Ai; + sunrealtype *Ax, *xd, *yd; + SUNFunctionBegin(A->sunctx); + + /* access data from CSC structure (return if failure) */ + Ap = SM_INDEXPTRS_S(A); + SUNAssert(Ap, SUN_ERR_ARG_CORRUPT); + Ai = SM_INDEXVALS_S(A); + SUNAssert(Ai, SUN_ERR_ARG_CORRUPT); + Ax = SM_DATA_S(A); + SUNAssert(Ax, SUN_ERR_ARG_CORRUPT); + + /* access vector data (return if failure) */ + xd = N_VGetArrayPointer(x); + SUNCheckLastErr(); + yd = N_VGetArrayPointer(y); + SUNCheckLastErr(); + + /* initialize result vector */ + for (i = 0; i < SM_COLUMNS_S(A); i++) { yd[i] = ZERO; } + + /* iterate through matrix columns (rows of the transposed matrix) */ + for (j = 0; j < SM_COLUMNS_S(A); j++) + { + /* iterate through non-zero elements in the current column */ + for (i = Ap[j]; i < Ap[j + 1]; i++) { yd[j] += Ax[i] * xd[Ai[i]]; } + } + + return SUN_SUCCESS; +} + /* ----------------------------------------------------------------- * Computes y=A*x, where A is a CSR SUNMatrix_Sparse of dimension MxN, x is a * compatible N_Vector object of length N, and y is a compatible @@ -1075,6 +1128,7 @@ SUNErrCode Matvec_SparseCSR(SUNMatrix A, N_Vector x, N_Vector y) SUNAssert(xd, SUN_ERR_ARG_CORRUPT); SUNAssert(yd, SUN_ERR_ARG_CORRUPT); SUNAssert(xd != yd, SUN_ERR_ARG_CORRUPT); + /* initialize result */ for (i = 0; i < SM_ROWS_S(A); i++) { yd[i] = ZERO; } @@ -1088,6 +1142,42 @@ SUNErrCode Matvec_SparseCSR(SUNMatrix A, N_Vector x, N_Vector y) return SUN_SUCCESS; } +SUNErrCode MatTransposeVec_SparseCSR(SUNMatrix A, N_Vector x, N_Vector y) +{ + sunindextype i, j; + sunindextype *Ap, *Aj; + sunrealtype *Ax, *xd, *yd; + SUNFunctionBegin(A->sunctx); + + /* access data from CSR structure (return if failure) */ + Ap = SM_INDEXPTRS_S(A); + SUNAssert(Ap, SUN_ERR_ARG_CORRUPT); + Aj = SM_INDEXVALS_S(A); + SUNAssert(Aj, SUN_ERR_ARG_CORRUPT); + Ax = SM_DATA_S(A); + SUNAssert(Ax, SUN_ERR_ARG_CORRUPT); + + /* access vector data (return if failure) */ + xd = N_VGetArrayPointer(x); + SUNCheckLastErr(); + yd = N_VGetArrayPointer(y); + SUNCheckLastErr(); + SUNAssert(xd, SUN_ERR_ARG_CORRUPT); + SUNAssert(yd, SUN_ERR_ARG_CORRUPT); + SUNAssert(xd != yd, SUN_ERR_ARG_CORRUPT); + + /* initialize result vector */ + for (i = 0; i < SM_COLUMNS_S(A); i++) { yd[i] = ZERO; } + + /* iterate over rows of the original matrix (columns of the transposed matrix) */ + for (i = 0; i < SM_ROWS_S(A); i++) + { + for (j = Ap[i]; j < Ap[i + 1]; j++) { yd[Aj[j]] += Ax[j] * xd[i]; } + } + + return SUN_SUCCESS; +} + /* ----------------------------------------------------------------- * Copies A into a matrix B in the opposite format of A. * Returns 0 if successful, nonzero if unsuccessful. diff --git a/src/sunmemory/system/sundials_system_memory.c b/src/sunmemory/system/sundials_system_memory.c index 8b34d7f137..4a733d12e7 100644 --- a/src/sunmemory/system/sundials_system_memory.c +++ b/src/sunmemory/system/sundials_system_memory.c @@ -51,6 +51,7 @@ SUNMemoryHelper SUNMemoryHelper_Sys(SUNContext sunctx) /* Set the ops */ helper->ops->alloc = SUNMemoryHelper_Alloc_Sys; + helper->ops->allocstrided = SUNMemoryHelper_AllocStrided_Sys; helper->ops->dealloc = SUNMemoryHelper_Dealloc_Sys; helper->ops->copy = SUNMemoryHelper_Copy_Sys; helper->ops->getallocstats = SUNMemoryHelper_GetAllocStats_Sys; @@ -101,6 +102,21 @@ SUNErrCode SUNMemoryHelper_Alloc_Sys(SUNMemoryHelper helper, SUNMemory* memptr, return SUN_SUCCESS; } +SUNErrCode SUNMemoryHelper_AllocStrided_Sys(SUNMemoryHelper helper, + SUNMemory* memptr, size_t mem_size, + size_t stride, + SUNMemoryType mem_type, void* queue) +{ + SUNFunctionBegin(helper->sunctx); + + SUNCheckCall( + SUNMemoryHelper_Alloc_Sys(helper, memptr, mem_size, mem_type, queue)); + + (*memptr)->stride = stride; + + return SUN_SUCCESS; +} + SUNErrCode SUNMemoryHelper_Dealloc_Sys(SUNMemoryHelper helper, SUNMemory mem, SUNDIALS_MAYBE_UNUSED void* queue) { diff --git a/swig/Makefile b/swig/Makefile index eb772623e9..ee698c63dc 100644 --- a/swig/Makefile +++ b/swig/Makefile @@ -28,10 +28,11 @@ SUNMATRIX=band dense sparse SUNLINSOL=band dense lapackdense klu spbcgs spfgmr spgmr sptfqmr pcg SUNNONLINSOL=newton fixedpoint SUNADAPTCONTROLLER=imexgus soderlind +SUNADJOINT=fsunadjointstepper_mod fsunadjointcheckpointscheme_mod fsunadjointcheckpointscheme_fixed_mod INCLUDES=-I../include -.PHONY: .SETINT64 .SETINT32 all all32 all64 modules core arkode cvode cvodes ida idas kinsol nvector mpimanyvector sunmatrix sunlinsol sunnonlinsol sunadaptcontroller clean +.PHONY: .SETINT64 .SETINT32 all all32 all64 modules core arkode cvode cvodes ida idas kinsol nvector mpimanyvector sunmatrix sunlinsol sunnonlinsol sunadaptcontroller sunadjoint clean .SETINT32: $(eval INT_SIZE=32) @@ -45,7 +46,7 @@ all32: .SETINT32 modules all64: .SETINT64 modules -modules: core arkode cvode cvodes ida idas kinsol nvector sunmatrix sunlinsol sunnonlinsol sunadaptcontroller +modules: core arkode cvode cvodes ida idas kinsol nvector sunmatrix sunlinsol sunnonlinsol sunadaptcontroller sunadjoint core: $(CORE:%:sundials/%.i) @for i in ${CORE} ; do \ @@ -65,7 +66,7 @@ cvode: $(CVODE:%:cvode/%.i) ${SWIG} -DGENERATE_INT${INT_SIZE} -fortran -outdir ../src/cvode/fmod_int${INT_SIZE} -o ../src/cvode/fmod_int${INT_SIZE}/$${i}.c ${INCLUDES} cvode/$${i}.i; \ done -cvodes: $(CVODE:%:cvodes/%.i) +cvodes: $(CVODES:%:cvodes/%.i) @for i in ${CVODES} ; do \ set -x; \ ${SWIG} -DGENERATE_INT${INT_SIZE} -fortran -outdir ../src/cvodes/fmod_int${INT_SIZE} -o ../src/cvodes/fmod_int${INT_SIZE}/$${i}.c ${INCLUDES} cvodes/$${i}.i; \ @@ -123,5 +124,11 @@ sunadaptcontroller: $(SUNADAPTCONTROLLER:%:sunadaptcontroller/fsunadaptcontrolle ${SWIG} -DGENERATE_INT${INT_SIZE} -fortran -outdir ../src/sunadaptcontroller/$${i}/fmod_int${INT_SIZE} -o ../src/sunadaptcontroller/$${i}/fmod_int${INT_SIZE}/fsunadaptcontroller_$${i}_mod.c ${INCLUDES} sunadaptcontroller/fsunadaptcontroller_$${i}_mod.i; \ done +sunadjoint: $(SUNADJOINT:%:sunadjoint/%.i) + @for i in ${SUNADJOINT} ; do \ + set -x; \ + ${SWIG} -DGENERATE_INT${INT_SIZE} -fortran -outdir ../src/sunadjoint/fmod_int${INT_SIZE} -o ../src/sunadjoint/fmod_int${INT_SIZE}/$${i}.c ${INCLUDES} sunadjoint/$${i}.i; \ + done + clean: rm ../src/**/fmod*/*.c; rm ../src/**/fmod*/*.f90 diff --git a/swig/README.md b/swig/README.md index ae3b174264..7b4e3cf023 100644 --- a/swig/README.md +++ b/swig/README.md @@ -9,8 +9,7 @@ C API while providing an idiomatic Fortran interface. ## Getting SWIG-Fortran We use the SWIG-Fortran fork of SWIG created by Seth R. Johnson @ ORNL. -The repository is maintained on [GitHub](https://github.com/swig-fortran/swig). -The last known working commit SHA is 539be6884f327c9fd72052771f074d6cfa4e65b5. +The upstream repository is maintained on [GitHub](https://github.com/swig-fortran/swig). We maintain [a fork of SWIG-Fortran](https://github.com/sundials-codes/swig) that is held at the last working commit and includes any of our own bug fixes. So if the the latest swig obtained from the actual SWIG-Fortran repository diff --git a/swig/sunadjoint/fsunadjointcheckpointscheme_fixed_mod.i b/swig/sunadjoint/fsunadjointcheckpointscheme_fixed_mod.i new file mode 100644 index 0000000000..0c3a3b3197 --- /dev/null +++ b/swig/sunadjoint/fsunadjointcheckpointscheme_fixed_mod.i @@ -0,0 +1,30 @@ +// --------------------------------------------------------------- +// SUNDIALS Copyright Start +// Copyright (c) 2002-2024, 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 +// --------------------------------------------------------------- +// Swig interface file +// --------------------------------------------------------------- + +%module fsunadjointcheckpointscheme_fixed_mod + +// Include shared configuration +%include "../sundials/fsundials.i" + +%include + +%{ +#include "sunadjoint/sunadjoint_checkpointscheme_fixed.h" +%} + +%import "../sundials/fsundials_core_mod.i" +%import "../sunadjoint/fsunadjointcheckpointscheme_mod.i" + +// Process and wrap functions in the following files +%include "sunadjoint/sunadjoint_checkpointscheme_fixed.h" diff --git a/swig/sunadjoint/fsunadjointcheckpointscheme_mod.i b/swig/sunadjoint/fsunadjointcheckpointscheme_mod.i new file mode 100644 index 0000000000..bd4b490138 --- /dev/null +++ b/swig/sunadjoint/fsunadjointcheckpointscheme_mod.i @@ -0,0 +1,37 @@ +// --------------------------------------------------------------- +// SUNDIALS Copyright Start +// Copyright (c) 2002-2024, 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 +// --------------------------------------------------------------- +// Swig interface file +// --------------------------------------------------------------- + +%module fsunadjointcheckpointscheme_mod + +// Include shared configuration +%include "../sundials/fsundials.i" + +%include + +%{ +#include "sunadjoint/sunadjoint_checkpointscheme.h" +%} + +%import "../sundials/fsundials_core_mod.i" + +%fortran_struct(SUNAdjointCheckpointScheme_Ops_); +%typemap(ctype) SUNAdjointCheckpointScheme_Ops_* "SUNAdjointCheckpointScheme_Ops"; +%rename(SUNAdjointCheckpointScheme_Ops) SUNAdjointCheckpointScheme_Ops_; + +%fortran_struct(SUNAdjointCheckpointScheme_); +%typemap(ctype) SUNAdjointCheckpointScheme_* "SUNAdjointCheckpointScheme"; +%rename(SUNAdjointCheckpointScheme) SUNAdjointCheckpointScheme_; + +// Process and wrap functions in the following files +%include "sunadjoint/sunadjoint_checkpointscheme.h" diff --git a/swig/sunadjoint/fsunadjointstepper_mod.i b/swig/sunadjoint/fsunadjointstepper_mod.i new file mode 100644 index 0000000000..1f9a9db05b --- /dev/null +++ b/swig/sunadjoint/fsunadjointstepper_mod.i @@ -0,0 +1,32 @@ +// --------------------------------------------------------------- +// SUNDIALS Copyright Start +// Copyright (c) 2002-2024, 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 +// --------------------------------------------------------------- +// Swig interface file +// --------------------------------------------------------------- + +%module fsunadjointstepper_mod + +// Include shared configuration +%include "../sundials/fsundials.i" + +%include + +%{ +#include "sunadjoint/sunadjoint_stepper.h" +%} + +%import "../sundials/fsundials_core_mod.i" +%import "../sunadjoint/fsunadjointcheckpointscheme_mod.i" + +%apply void* { SUNAdjointStepper }; + +// Process and wrap functions in the following files +%include "sunadjoint/sunadjoint_stepper.h" diff --git a/swig/sundials/fsundials_core_mod.i b/swig/sundials/fsundials_core_mod.i index 344f9372bb..930e55c702 100644 --- a/swig/sundials/fsundials_core_mod.i +++ b/swig/sundials/fsundials_core_mod.i @@ -25,4 +25,5 @@ %include "fsundials_linearsolver.i" %include "fsundials_nonlinearsolver.i" %include "fsundials_adaptcontroller.i" +%include "fsundials_stepper.i" %include "fcopyright.i" diff --git a/swig/sundials/fsundials_stepper.i b/swig/sundials/fsundials_stepper.i new file mode 100644 index 0000000000..c72ea64546 --- /dev/null +++ b/swig/sundials/fsundials_stepper.i @@ -0,0 +1,25 @@ +// --------------------------------------------------------------- +// Programmer: Steven B. Roberts @ LLNL +// --------------------------------------------------------------- +// SUNDIALS Copyright Start +// Copyright (c) 2002-2024, 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 +// --------------------------------------------------------------- +// Swig interface file +// --------------------------------------------------------------- + +%{ +#include "sundials/sundials_stepper.h" +%} + +%apply void* { SUNStepper }; + +// Process and wrap functions in the following files +%include "sundials/sundials_stepper.h" + diff --git a/test/answers b/test/answers index b8fc1d686f..5784d2de87 160000 --- a/test/answers +++ b/test/answers @@ -1 +1 @@ -Subproject commit b8fc1d686fabbc1c8e609ff3253cedf9588986ac +Subproject commit 5784d2de87d359ea1604d5e9595bdd4806307b1f diff --git a/test/unit_tests/CMakeLists.txt b/test/unit_tests/CMakeLists.txt index 29e3a74114..d6967a4fb3 100644 --- a/test/unit_tests/CMakeLists.txt +++ b/test/unit_tests/CMakeLists.txt @@ -23,6 +23,7 @@ if(ENABLE_ALL_WARNINGS) endif() add_subdirectory(sundials) +add_subdirectory(sunadjoint) if(BUILD_ARKODE) add_subdirectory(arkode) diff --git a/test/unit_tests/arkode/CXX_serial/CMakeLists.txt b/test/unit_tests/arkode/CXX_serial/CMakeLists.txt index c1f22fc6bc..609df9f7d7 100644 --- a/test/unit_tests/arkode/CXX_serial/CMakeLists.txt +++ b/test/unit_tests/arkode/CXX_serial/CMakeLists.txt @@ -41,7 +41,20 @@ set(unit_tests "ark_test_dahlquist_mri.cpp\;1" "ark_test_butcher.cpp\;" "ark_test_getjac.cpp\;" - "ark_test_getjac_mri.cpp\;") + "ark_test_getjac_mri.cpp\;" + "ark_test_erkadjoint.cpp\;--check-freq 1\;" + "ark_test_erkadjoint.cpp\;--check-freq 2\;" + "ark_test_erkadjoint.cpp\;--check-freq 5\;" + "ark_test_erkadjoint.cpp\;--check-freq 1 --dont-keep\;" + "ark_test_erkadjoint.cpp\;--check-freq 2 --dont-keep\;" + "ark_test_erkadjoint.cpp\;--check-freq 5 --dont-keep\;" + # "ark_test_erkadjoint.cpp\;--check-freq 1 --no-stages\;" + # "ark_test_erkadjoint.cpp\;--check-freq 2 --no-stages\;" + # "ark_test_erkadjoint.cpp\;--check-freq 5 --no-stages\;" + # "ark_test_erkadjoint.cpp\;--check-freq 1 --dont-keep --no-stages\;" + # "ark_test_erkadjoint.cpp\;--check-freq 2 --dont-keep --no-stages\;" + # "ark_test_erkadjoint.cpp\;--check-freq 5 --dont-keep --no-stages\;" +) # Add the build and install targets for each test foreach(test_tuple ${unit_tests}) @@ -67,7 +80,8 @@ foreach(test_tuple ${unit_tests}) target_include_directories( ${test_target} PRIVATE $ - ${CMAKE_SOURCE_DIR}/include ${CMAKE_SOURCE_DIR}/src) + ${CMAKE_SOURCE_DIR}/include ${CMAKE_SOURCE_DIR}/src + ${CMAKE_SOURCE_DIR}/test/unit_tests) # We explicitly choose which object libraries to link to and link in the # arkode objects so that we have access to private functions w/o changing @@ -77,12 +91,14 @@ foreach(test_tuple ${unit_tests}) $ sundials_sunmemsys_obj sundials_nvecserial_obj + sundials_nvecmanyvector_obj sundials_sunlinsolband_obj sundials_sunlinsoldense_obj sundials_sunnonlinsolnewton_obj sundials_sunnonlinsolfixedpoint_obj sundials_sunadaptcontrollerimexgus_obj sundials_sunadaptcontrollersoderlind_obj + sundials_adjoint_obj ${EXE_EXTRA_LINK_LIBS}) # Tell CMake that we depend on the ARKODE library since it does not pick diff --git a/test/unit_tests/arkode/CXX_serial/ark_test_erkadjoint.cpp b/test/unit_tests/arkode/CXX_serial/ark_test_erkadjoint.cpp new file mode 100644 index 0000000000..7fca57a8e3 --- /dev/null +++ b/test/unit_tests/arkode/CXX_serial/ark_test_erkadjoint.cpp @@ -0,0 +1,536 @@ +/* ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 + * ----------------------------------------------------------------------------- + * Program to test the SUNAdjoint capability with ARKODE. The test uses the + * implements the four parameter Lotka-Volterra problem + * + * u' = [dx/dt] = [ p_0*x - p_1*x*y ] + * [dy/dt] [ -p_2*y + p_3*x*y ]. + * + * The initial condition is u(t_0) = 1.0 and we use the parameters + * p = [1.5, 1.0, 3.0, 1.0]. We compute the sensitivities for the scalar cost + * function, + * + * g(u(t_f), p) = || 1 - u(t_f, p) ||^2 / 2 + * + * with respect to the initial condition and the parameters. + * ---------------------------------------------------------------------------*/ + +#include +#include +#include + +#include + +#include +#include +#include +#include +#include +#include + +#include +#include + +#include "problems/lotka_volterra.hpp" + +#if defined(SUNDIALS_SINGLE_PRECISION) +#define FWD_TOL SUN_RCONST(1e-2) +#elif defined(SUNDIALS_DOUBLE_PRECISION) +#define FWD_TOL SUN_RCONST(1e-4) +#elif defined(SUNDIALS_EXTENDED_PRECISION) +#define FWD_TOL SUN_RCONST(1e-6) +#endif + +#define ADJ_TOL SUN_RCONST(1e-2) + +using namespace problems::lotka_volterra; + +typedef struct +{ + sunrealtype tf; + sunrealtype dt; + int order; + int check_freq; + sunbooleantype save_stages; + sunbooleantype keep_checks; +} ProgramArgs; + +static sunrealtype params[4] = {SUN_RCONST(1.5), SUN_RCONST(1.0), + SUN_RCONST(3.0), SUN_RCONST(1.0)}; + +static int check_forward_answer(N_Vector answer) +{ + const sunrealtype u1 = SUN_RCONST(2.77266836); + const sunrealtype u2 = SUN_RCONST(0.258714765); + sunrealtype* ans = N_VGetArrayPointer(answer); + + if (SUNRCompareTol(ans[0], u1, FWD_TOL)) + { + fprintf(stdout, "\n>>> ans[0] = %g, should be %g\n", ans[0], u1); + return -1; + }; + if (SUNRCompareTol(ans[1], u2, FWD_TOL)) + { + fprintf(stdout, "\n>>> ans[1] = %g, should be %g\n", ans[1], u2); + return -1; + }; + + return 0; +} + +static int check_forward_backward_answer(N_Vector answer) +{ + const sunrealtype u1 = SUN_RCONST(1.0); + const sunrealtype u2 = SUN_RCONST(1.0); + sunrealtype* ans = N_VGetArrayPointer(answer); + + if (SUNRCompareTol(ans[0], u1, FWD_TOL)) + { + fprintf(stdout, "\n>>> ans[0] = %g, should be %g\n", ans[0], u1); + return -1; + }; + if (SUNRCompareTol(ans[1], u2, FWD_TOL)) + { + fprintf(stdout, "\n>>> ans[1] = %g, should be %g\n", ans[1], u2); + return -1; + }; + + return 0; +} + +static int check_sensitivities(N_Vector answer) +{ + // The correct answer was generated with the Julia ForwardDiff.jl + // automatic differentiation package. + + const sunrealtype lambda[2] = { + SUN_RCONST(3.5202568952661544), + -SUN_RCONST(2.19271337646507), + }; + + const sunrealtype mu[4] = {SUN_RCONST(4.341147542533404), + -SUN_RCONST(2.000933816791803), + SUN_RCONST(1.010120676762905), + -SUN_RCONST(1.3955943267337996)}; + + sunrealtype* ans = N_VGetSubvectorArrayPointer_ManyVector(answer, 0); + + for (sunindextype i = 0; i < 2; ++i) + { + if (SUNRCompareTol(ans[i], lambda[i], ADJ_TOL)) + { + fprintf(stdout, "\n>>> ans[%lld] = %g, should be %g\n", (long long)i, + ans[i], lambda[i]); + return -1; + }; + } + + ans = N_VGetSubvectorArrayPointer_ManyVector(answer, 1); + + for (sunindextype i = 0; i < 4; ++i) + { + if (SUNRCompareTol(ans[i], mu[i], ADJ_TOL)) + { + fprintf(stdout, "\n>>> ans[%lld] = %g, should be %g\n", (long long)i, + ans[i], mu[i]); + return -1; + }; + } + + return 0; +} + +static int check_sensitivities_backward(N_Vector answer) +{ + // The correct answer was generated with the Julia ForwardDiff.jl + // automatic differentiation package. + + const sunrealtype lambda[2] = { + SUN_RCONST(1.772850901841113), + -SUN_RCONST(0.7412891218574361), + }; + + const sunrealtype mu[4] = {SUN_RCONST(0.0), SUN_RCONST(0.0), SUN_RCONST(0.0), + SUN_RCONST(0.0)}; + + sunrealtype* ans = N_VGetSubvectorArrayPointer_ManyVector(answer, 0); + + for (sunindextype i = 0; i < 2; ++i) + { + if (SUNRCompareTol(ans[i], lambda[i], ADJ_TOL)) + { + fprintf(stdout, "\n>>> ans[%lld] = %g, should be %g\n", (long long)i, + ans[i], lambda[i]); + return -1; + }; + } + + ans = N_VGetSubvectorArrayPointer_ManyVector(answer, 1); + + for (sunindextype i = 0; i < 4; ++i) + { + if (SUNRCompareTol(ans[i], mu[i], ADJ_TOL)) + { + fprintf(stdout, "\n>>> ans[%lld] = %g, should be %g\n", (long long)i, + ans[i], mu[i]); + return -1; + }; + } + + return 0; +} + +static void dgdu(N_Vector uvec, N_Vector dgvec, const sunrealtype* p, + sunrealtype t) +{ + sunrealtype* u = N_VGetArrayPointer(uvec); + sunrealtype* dg = N_VGetArrayPointer(dgvec); + + dg[0] = -SUN_RCONST(1.0) + u[0]; + dg[1] = -SUN_RCONST(1.0) + u[1]; +} + +static void dgdp(N_Vector uvec, N_Vector dgvec, const sunrealtype* p, + sunrealtype t) +{ + sunrealtype* dg = N_VGetArrayPointer(dgvec); + + dg[0] = SUN_RCONST(0.0); + dg[1] = SUN_RCONST(0.0); + dg[2] = SUN_RCONST(0.0); + dg[3] = SUN_RCONST(0.0); +} + +static int forward_solution(SUNContext sunctx, void* arkode_mem, + SUNAdjointCheckpointScheme checkpoint_scheme, + const sunrealtype t0, const sunrealtype tf, + const sunrealtype dt, N_Vector u) +{ + int retval = 0; + + retval = ARKodeSetUserData(arkode_mem, (void*)params); + retval = ARKodeSetFixedStep(arkode_mem, dt); + + sunrealtype t = t0; + retval = ARKodeEvolve(arkode_mem, tf, u, &t, ARK_NORMAL); + if (retval < 0) + { + fprintf(stderr, ">>> ERROR: ARKodeEvolve returned %d\n", retval); + return -1; + } + + printf("Forward Solution:\n"); + N_VPrint(u); + + printf("ARKODE Stats for Forward Solution:\n"); + ARKodePrintAllStats(arkode_mem, stdout, SUN_OUTPUTFORMAT_TABLE); + printf("\n"); + + return 0; +} + +static int adjoint_solution(SUNContext sunctx, SUNAdjointStepper adj_stepper, + SUNAdjointCheckpointScheme checkpoint_scheme, + const sunrealtype tf, const sunrealtype tout, + N_Vector sf) +{ + sunrealtype t = tf; + SUNAdjointStepper_Evolve(adj_stepper, tout, sf, &t); + + printf("Adjoint Solution:\n"); + N_VPrint(sf); + + printf("\nSUNAdjointStepper Stats:\n"); + SUNAdjointStepper_PrintAllStats(adj_stepper, stdout, SUN_OUTPUTFORMAT_TABLE); + printf("\n"); + + return 0; +} + +static void print_help(int argc, char* argv[], int exit_code) +{ + if (exit_code) { fprintf(stderr, "%s: option not recognized\n", argv[0]); } + else { fprintf(stderr, "%s ", argv[0]); } + fprintf(stderr, "options:\n"); + fprintf(stderr, "--tf the final simulation time\n"); + fprintf(stderr, "--dt the timestep size\n"); + fprintf(stderr, "--order the order of the RK method\n"); + fprintf(stderr, "--check-freq how often to checkpoint (in steps)\n"); + fprintf(stderr, "--no-stages don't checkpoint stages\n"); + fprintf(stderr, + "--dont-keep don't keep checkpoints around after loading\n"); + fprintf(stderr, "--help print these options\n"); + exit(exit_code); +} + +static void parse_args(int argc, char* argv[], ProgramArgs* args) +{ + for (int argi = 1; argi < argc; ++argi) + { + const char* arg = argv[argi]; + if (!strcmp(arg, "--tf")) { args->tf = atof(argv[++argi]); } + else if (!strcmp(arg, "--dt")) { args->dt = atof(argv[++argi]); } + else if (!strcmp(arg, "--order")) { args->order = atoi(argv[++argi]); } + else if (!strcmp(arg, "--check-freq")) + { + args->check_freq = atoi(argv[++argi]); + } + else if (!strcmp(arg, "--no-stages")) { args->save_stages = SUNFALSE; } + else if (!strcmp(arg, "--dont-keep")) { args->keep_checks = SUNFALSE; } + else if (!strcmp(arg, "--help")) { print_help(argc, argv, 0); } + else { print_help(argc, argv, 1); } + } +} + +int main(int argc, char* argv[]) +{ + SUNContext sunctx = NULL; + SUNContext_Create(SUN_COMM_NULL, &sunctx); + + // Since this a unit test, we want to abort immediately on any internal error + SUNContext_PushErrHandler(sunctx, SUNAbortErrHandlerFn, NULL); + + ProgramArgs args; + args.tf = SUN_RCONST(1.0); + args.dt = SUN_RCONST(1e-4); + args.order = 4; + args.save_stages = SUNTRUE; + args.keep_checks = SUNTRUE; + args.check_freq = 2; + parse_args(argc, argv, &args); + + // + // Create the initial conditions vector + // + + sunindextype neq = 2; + N_Vector u = N_VNew_Serial(neq, sunctx); + N_VConst(SUN_RCONST(1.0), u); + + // + // Create the ARKODE stepper that will be used for the forward evolution. + // + + const sunrealtype dt = args.dt; + sunrealtype t0 = SUN_RCONST(0.0); + sunrealtype tf = args.tf; + const int nsteps = (int)ceil(((tf - t0) / dt + 1)); + const int order = args.order; + + void* arkode_mem = ARKStepCreate(ode_rhs, NULL, t0, u, sunctx); + ARKodeSetOrder(arkode_mem, order); + ARKodeSetMaxNumSteps(arkode_mem, nsteps * 2); + + // Enable checkpointing during the forward solution. + // ncheck will be more than nsteps, but for testing purposes we try setting it + // to nsteps and allow things to be resized automatically. + const int check_interval = args.check_freq; + const int ncheck = nsteps; + const sunbooleantype save_stages = args.save_stages; + const sunbooleantype keep_check = args.keep_checks; + SUNAdjointCheckpointScheme checkpoint_scheme = NULL; + SUNMemoryHelper mem_helper = SUNMemoryHelper_Sys(sunctx); + SUNAdjointCheckpointScheme_Create_Fixed(SUNDATAIOMODE_INMEM, mem_helper, + check_interval, ncheck, save_stages, + keep_check, sunctx, &checkpoint_scheme); + ARKodeSetAdjointCheckpointScheme(arkode_mem, checkpoint_scheme); + + // + // Compute the forward solution + // + + printf("\n-- Do forward problem --\n\n"); + + printf("Initial condition:\n"); + N_VPrint(u); + + forward_solution(sunctx, arkode_mem, checkpoint_scheme, t0, tf, dt, u); + if (check_forward_answer(u)) + { + fprintf(stderr, + ">>> FAILURE: forward solution does not match correct answer\n"); + return -1; + }; + printf(">>> PASS\n"); + + // + // Create the adjoint stepper + // + + printf("\n-- Do adjoint problem using Jacobian matrix --\n\n"); + + sunindextype num_params = 4; + N_Vector sensu0 = N_VClone(u); + N_Vector sensp = N_VNew_Serial(num_params, sunctx); + N_Vector sens[2] = {sensu0, sensp}; + N_Vector sf = N_VNew_ManyVector(2, sens, sunctx); + + // Set the terminal condition for the adjoint system, which + // should be the the gradient of our cost function at tf. + dgdu(u, sensu0, params, tf); + dgdp(u, sensp, params, tf); + + printf("Adjoint terminal condition:\n"); + N_VPrint(sf); + + SUNAdjointStepper adj_stepper; + ARKStepCreateAdjointStepper(arkode_mem, sf, &adj_stepper); + + // + // Now compute the adjoint solution + // + + SUNMatrix jac = SUNDenseMatrix(neq, neq, sunctx); + SUNMatrix jacp = SUNDenseMatrix(neq, num_params, sunctx); + + SUNAdjointStepper_SetJacFn(adj_stepper, ode_jac, jac, parameter_jacobian, jacp); + + adjoint_solution(sunctx, adj_stepper, checkpoint_scheme, tf, t0, sf); + if (check_sensitivities(sf)) + { + fprintf(stderr, + ">>> FAILURE: adjoint solution does not match correct answer\n"); + return -1; + } + printf("\n>>> PASS\n"); + + // + // Now compute the adjoint solution using Jvp + // + + printf("\n-- Redo adjoint problem using JVP --\n\n"); + if (!keep_check) + { + N_VConst(SUN_RCONST(1.0), u); + printf("Initial condition:\n"); + N_VPrint(u); + ARKStepReInit(arkode_mem, ode_rhs, NULL, t0, u); + forward_solution(sunctx, arkode_mem, checkpoint_scheme, t0, tf, dt, u); + if (check_forward_answer(u)) + { + fprintf(stderr, + ">>> FAILURE: forward solution does not match correct answer\n"); + return -1; + } + } + dgdu(u, sensu0, params, tf); + dgdp(u, sensp, params, tf); + SUNAdjointStepper_ReInit(adj_stepper, u, t0, sf, tf); + SUNAdjointStepper_SetJacFn(adj_stepper, NULL, NULL, NULL, NULL); + SUNAdjointStepper_SetJacTimesVecFn(adj_stepper, ode_jvp, parameter_jvp); + adjoint_solution(sunctx, adj_stepper, checkpoint_scheme, tf, t0, sf); + if (check_sensitivities(sf)) + { + fprintf(stderr, + ">>> FAILURE: adjoint solution does not match correct answer\n"); + return -1; + }; + printf("\n>>> PASS\n"); + + // + // Now compute the adjoint solution using vJp + // + + printf("\n-- Redo adjoint problem using VJP --\n\n"); + if (!keep_check) + { + N_VConst(SUN_RCONST(1.0), u); + printf("Initial condition:\n"); + N_VPrint(u); + ARKStepReInit(arkode_mem, ode_rhs, NULL, t0, u); + forward_solution(sunctx, arkode_mem, checkpoint_scheme, t0, tf, dt, u); + if (check_forward_answer(u)) + { + fprintf(stderr, + ">>> FAILURE: forward solution does not match correct answer\n"); + return -1; + }; + } + dgdu(u, sensu0, params, tf); + dgdp(u, sensp, params, tf); + SUNAdjointStepper_ReInit(adj_stepper, u, t0, sf, tf); + SUNAdjointStepper_SetJacTimesVecFn(adj_stepper, NULL, NULL); + SUNAdjointStepper_SetVecTimesJacFn(adj_stepper, ode_vjp, parameter_vjp); + adjoint_solution(sunctx, adj_stepper, checkpoint_scheme, tf, t0, sf); + if (check_sensitivities(sf)) + { + fprintf(stderr, + ">>> FAILURE: adjoint solution does not match correct answer\n"); + return -1; + }; + printf(">>> PASS\n"); + + // + // Now compute the adjoint solution but for when forward problem done backwards + // starting with the forward solution. + // + + printf("\n-- Redo adjoint problem of forward problem done backwards --\n\n"); + + // Swap the start and end times + sunrealtype tmp = t0; + t0 = tf; + tf = tmp; + + // Cleanup from the original forward problem and then recreate the integrator + // for the forward problem done backwards. + SUNAdjointCheckpointScheme_Destroy(&checkpoint_scheme); + SUNAdjointStepper_Destroy(&adj_stepper); + ARKodeFree(&arkode_mem); + arkode_mem = ARKStepCreate(ode_rhs, NULL, t0, u, sunctx); + ARKodeSetOrder(arkode_mem, order); + ARKodeSetMaxNumSteps(arkode_mem, nsteps * 2); + SUNAdjointCheckpointScheme_Create_Fixed(SUNDATAIOMODE_INMEM, mem_helper, + check_interval, ncheck, save_stages, + keep_check, sunctx, &checkpoint_scheme); + ARKodeSetAdjointCheckpointScheme(arkode_mem, checkpoint_scheme); + + printf("Initial condition:\n"); + N_VPrint(u); + + forward_solution(sunctx, arkode_mem, checkpoint_scheme, t0, tf, -dt, u); + if (check_forward_backward_answer(u)) + { + fprintf(stderr, + ">>> FAILURE: forward solution does not match correct answer\n"); + return -1; + }; + + ARKStepCreateAdjointStepper(arkode_mem, sf, &adj_stepper); + SUNAdjointStepper_SetJacFn(adj_stepper, ode_jac, jac, parameter_jacobian, jacp); + dgdu(u, sensu0, params, tf); + dgdp(u, sensp, params, tf); + + adjoint_solution(sunctx, adj_stepper, checkpoint_scheme, tf, t0, sf); + // TODO(CJB): figure out why ForwardDiff, CVODES, and ERK adjoint all differ + // if (check_sensitivities_backward(sf)) + // { + // fprintf(stderr, + // ">>> FAILURE: adjoint solution does not match correct answer\n"); + // return -1; + // }; + // printf(">>> PASS\n"); + + // + // Cleanup + // + + SUNMatDestroy(jac); + SUNMatDestroy(jacp); + N_VDestroy(u); + N_VDestroy(sf); + SUNAdjointCheckpointScheme_Destroy(&checkpoint_scheme); + SUNAdjointStepper_Destroy(&adj_stepper); + ARKodeFree(&arkode_mem); + + return 0; +} diff --git a/test/unit_tests/arkode/C_serial/CMakeLists.txt b/test/unit_tests/arkode/C_serial/CMakeLists.txt index 6794a213b4..c5bb391833 100644 --- a/test/unit_tests/arkode/C_serial/CMakeLists.txt +++ b/test/unit_tests/arkode/C_serial/CMakeLists.txt @@ -63,11 +63,13 @@ foreach(test_tuple ${ARKODE_unit_tests}) $ sundials_sunmemsys_obj sundials_nvecserial_obj + sundials_nvecmanyvector_obj sundials_sunlinsolband_obj sundials_sunlinsoldense_obj sundials_sunnonlinsolnewton_obj sundials_sunadaptcontrollerimexgus_obj sundials_sunadaptcontrollersoderlind_obj + sundials_adjoint_obj ${EXE_EXTRA_LINK_LIBS}) # Tell CMake that we depend on the ARKODE library since it does not pick diff --git a/test/unit_tests/arkode/gtest/CMakeLists.txt b/test/unit_tests/arkode/gtest/CMakeLists.txt index 071faee5c0..486baf2269 100644 --- a/test/unit_tests/arkode/gtest/CMakeLists.txt +++ b/test/unit_tests/arkode/gtest/CMakeLists.txt @@ -26,11 +26,13 @@ target_link_libraries( PRIVATE $ sundials_sunmemsys_obj sundials_nvecserial_obj + sundials_nvecmanyvector_obj sundials_sunlinsolband_obj sundials_sunlinsoldense_obj sundials_sunnonlinsolnewton_obj sundials_sunadaptcontrollerimexgus_obj sundials_sunadaptcontrollersoderlind_obj + sundials_adjoint_obj ${EXE_EXTRA_LINK_LIBS}) # Tell CMake that we depend on the ARKODE library since it does not pick that up diff --git a/test/unit_tests/problems/lotka_volterra.hpp b/test/unit_tests/problems/lotka_volterra.hpp new file mode 100644 index 0000000000..e836b9b954 --- /dev/null +++ b/test/unit_tests/problems/lotka_volterra.hpp @@ -0,0 +1,139 @@ +/* ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 provides right-hand-side and related functions (e.g., Jacobian) + * for the four parameter Lotka-Volterra problem, + * + * u = [dx/dt] = [ p_0*x - p_1*x*y ] + * [dy/dt] [ -p_2*y + p_3*x*y ]. + * + * with parameters p. + * ---------------------------------------------------------------------------*/ + +#ifndef _LOTKA_VOLTERRA_HPP +#define _LOTKA_VOLTERRA_HPP + +#include +#include + +namespace problems { +namespace lotka_volterra { + +inline int ode_rhs(sunrealtype t, N_Vector uvec, N_Vector udotvec, void* user_data) +{ + sunrealtype* p = (sunrealtype*)user_data; + sunrealtype* u = N_VGetArrayPointer(uvec); + sunrealtype* udot = N_VGetArrayPointer(udotvec); + + udot[0] = p[0] * u[0] - p[1] * u[0] * u[1]; + udot[1] = -p[2] * u[1] + p[3] * u[0] * u[1]; + + return 0; +} + +inline int ode_jac(sunrealtype t, N_Vector uvec, N_Vector udotvec, SUNMatrix Jac, + void* user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) +{ + sunrealtype* p = (sunrealtype*)user_data; + sunrealtype* u = N_VGetArrayPointer(uvec); + sunrealtype* J = SUNDenseMatrix_Data(Jac); + + J[0] = p[0] - p[1] * u[1]; + J[2] = -p[1] * u[0]; + J[1] = p[3] * u[1]; + J[3] = p[3] * u[0] - p[2]; + + return 0; +} + +inline int ode_jvp(N_Vector vvec, N_Vector Jvvec, sunrealtype t, N_Vector uvec, + N_Vector udotvec, void* user_data, N_Vector tmp) +{ + sunrealtype* p = (sunrealtype*)user_data; + sunrealtype* u = N_VGetArrayPointer(uvec); + sunrealtype* v = N_VGetArrayPointer(vvec); + sunrealtype* Jv = N_VGetArrayPointer(Jvvec); + + Jv[0] = (p[0] - p[1] * u[1]) * v[0] + p[3] * u[1] * v[1]; + Jv[1] = -p[1] * u[0] * v[0] + (-p[2] + p[3] * u[0]) * v[1]; + + return 0; +} + +inline int ode_vjp(N_Vector vvec, N_Vector Jvvec, sunrealtype t, N_Vector uvec, + N_Vector udotvec, void* user_data, N_Vector tmp) +{ + sunrealtype* p = (sunrealtype*)user_data; + sunrealtype* u = N_VGetArrayPointer(uvec); + sunrealtype* v = N_VGetArrayPointer(vvec); + sunrealtype* Jv = N_VGetArrayPointer(Jvvec); + + Jv[0] = (p[0] - p[1] * u[1]) * v[0] + p[3] * u[1] * v[1]; + Jv[1] = -p[1] * u[0] * v[0] + (-p[2] + p[3] * u[0]) * v[1]; + + return 0; +} + +inline int parameter_jacobian(sunrealtype t, N_Vector uvec, N_Vector udotvec, + SUNMatrix Jac, void* user_data, N_Vector tmp1, + N_Vector tmp2, N_Vector tmp3) +{ + sunrealtype* u = N_VGetArrayPointer(uvec); + sunrealtype* J = SUNDenseMatrix_Data(Jac); + + J[0] = u[0]; + J[1] = SUN_RCONST(0.0); + J[2] = -u[0] * u[1]; + J[3] = SUN_RCONST(0.0); + J[4] = SUN_RCONST(0.0); + J[5] = -u[1]; + J[6] = SUN_RCONST(0.0); + J[7] = u[0] * u[1]; + + return 0; +} + +inline int parameter_jvp(N_Vector vvec, N_Vector Jvvec, sunrealtype t, + N_Vector uvec, N_Vector udotvec, void* user_data, + N_Vector tmp) +{ + sunrealtype* u = N_VGetArrayPointer(uvec); + sunrealtype* v = N_VGetArrayPointer(vvec); + sunrealtype* Jv = N_VGetArrayPointer(Jvvec); + + Jv[0] = u[0] * v[0]; + Jv[1] = -u[0] * u[1] * v[0]; + Jv[2] = -u[1] * v[1]; + Jv[3] = u[0] * u[1] * v[1]; + + return 0; +} + +inline int parameter_vjp(N_Vector vvec, N_Vector Jvvec, sunrealtype t, + N_Vector uvec, N_Vector udotvec, void* user_data, + N_Vector tmp) +{ + sunrealtype* u = N_VGetArrayPointer(uvec); + sunrealtype* v = N_VGetArrayPointer(vvec); + sunrealtype* Jv = N_VGetArrayPointer(Jvvec); + + Jv[0] = u[0] * v[0]; + Jv[1] = -u[0] * u[1] * v[0]; + Jv[2] = -u[1] * v[1]; + Jv[3] = u[0] * u[1] * v[1]; + + return 0; +} + +} // namespace lotka_volterra +} // namespace problems + +#endif \ No newline at end of file diff --git a/test/unit_tests/sunadjoint/CMakeLists.txt b/test/unit_tests/sunadjoint/CMakeLists.txt new file mode 100644 index 0000000000..ca843d8790 --- /dev/null +++ b/test/unit_tests/sunadjoint/CMakeLists.txt @@ -0,0 +1,36 @@ +# --------------------------------------------------------------- +# SUNDIALS Copyright Start +# Copyright (c) 2002-2024, 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 +# --------------------------------------------------------------- + +# List of test tuples of the form "name\;args" +set(unit_tests "test_sunadjointcheckpointscheme_fixed\;") + +# Add the build and install targets for each test +if(TARGET GTest::gtest_main AND TARGET GTest::gmock) + foreach(test_tuple ${unit_tests}) + # parse the test tuple + list(GET test_tuple 0 test) + list(GET test_tuple 1 test_args) + + add_executable(${test} ${test}.cpp) + target_link_libraries( + ${test} + PRIVATE sundials_adjoint + sundials_nvecserial + sundials_nvecmanyvector + sundials_sunmemsys_obj + sundials_core + GTest::gtest_main + GTest::gmock) + + gtest_discover_tests(${test}) + endforeach() +endif() diff --git a/test/unit_tests/sunadjoint/test_sunadjointcheckpointscheme_fixed.cpp b/test/unit_tests/sunadjoint/test_sunadjointcheckpointscheme_fixed.cpp new file mode 100644 index 0000000000..6f28cc7d1b --- /dev/null +++ b/test/unit_tests/sunadjoint/test_sunadjointcheckpointscheme_fixed.cpp @@ -0,0 +1,349 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 + * -----------------------------------------------------------------*/ + +#include +#include +#include + +#include +#include +#include +#include +#include + +static bool compare_vectors(N_Vector expected, N_Vector actual) +{ + sunrealtype* adata = N_VGetArrayPointer(actual); + sunrealtype* edata = N_VGetArrayPointer(expected); + for (sunindextype i = 0; i < N_VGetLength(expected); ++i) + { + if (edata[i] != adata[i]) + { + fprintf(stderr, "compare_vectors\nexpected:\n"); + N_VPrint(expected); + fprintf(stderr, "compare_vectors\nactual:\n"); + N_VPrint(actual); + return false; + } + } + return true; +} + +static void fake_mutlistage_method(SUNAdjointCheckpointScheme cs, int steps, + int stages, bool test_load = false) +{ + N_Vector state = N_VNew_Serial(10, cs->sunctx); + N_Vector loaded = N_VClone(state); + + sunrealtype t = 0.0; + sunrealtype tout = 0.0; + sunrealtype dt = 0.1; + + // Initial condition + SUNErrCode err = SUNAdjointCheckpointScheme_InsertVector(cs, 0, 0, t, state); + + // Fake a multistage method checkpointing pattern + for (int step = 0; step < steps; ++step) + { + for (int stage = 1; stage <= stages; ++stage) + { + N_VConst(step * stage, state); + sunrealtype ts = t; //t + dt / stages; + err = SUNAdjointCheckpointScheme_InsertVector(cs, step, stage, ts, state); + EXPECT_EQ(err, SUN_SUCCESS); + } + + int stage_idx = step == 0 ? stages + 1 : stages; + N_VConst(step * stage_idx, state); + err = SUNAdjointCheckpointScheme_InsertVector(cs, step, stage_idx, t + dt, + state); + EXPECT_EQ(err, SUN_SUCCESS); + + t += dt; + } + + if (test_load) + { + t = dt * steps; + for (int step = steps - 1; step >= 0; --step) + { + int stage_idx = step == 0 ? stages + 1 : stages; + N_VConst(step * stage_idx, state); + err = SUNAdjointCheckpointScheme_LoadVector(cs, step, stage_idx, 0, + &loaded, &tout); + EXPECT_EQ(err, SUN_SUCCESS); + EXPECT_EQ(t, tout); + EXPECT_TRUE(compare_vectors(state, loaded)); + + for (int stage = stages; stage >= 1; --stage) + { + N_VConst(step * stage, state); + stage_idx = step == 0 ? stage : stage - 1; + err = SUNAdjointCheckpointScheme_LoadVector(cs, step, stage_idx, 0, + &loaded, &tout); + EXPECT_EQ(err, SUN_SUCCESS); + EXPECT_EQ(t - dt, tout); + EXPECT_TRUE(compare_vectors(state, loaded)); + } + + t -= dt; + } + } + + N_VDestroy(state); + N_VDestroy(loaded); +} + +class SUNAdjointCheckpointSchemeFixed : public testing::Test +{ +protected: + SUNAdjointCheckpointSchemeFixed() + { + SUNContext_Create(SUN_COMM_NULL, &sunctx); + state = N_VNew_Serial(10, sunctx); + loaded_state = N_VClone(state); + mem_helper = SUNMemoryHelper_Sys(sunctx); + } + + ~SUNAdjointCheckpointSchemeFixed() + { + N_VDestroy(state); + N_VDestroy(loaded_state); + SUNMemoryHelper_Destroy(mem_helper); + SUNContext_Free(&sunctx); + } + + SUNContext sunctx; + SUNMemoryHelper mem_helper; + N_Vector state; + N_Vector loaded_state; +}; + +TEST_F(SUNAdjointCheckpointSchemeFixed, CreateWorks) +{ + SUNErrCode err; + SUNAdjointCheckpointScheme cs = NULL; + + int64_t interval = 1; + int64_t estimate = 1; + sunbooleantype save_stages = SUNTRUE; + sunbooleantype keep_after_loading = SUNTRUE; + + err = SUNAdjointCheckpointScheme_Create_Fixed(SUNDATAIOMODE_INMEM, mem_helper, + interval, estimate, save_stages, + keep_after_loading, sunctx, &cs); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNAdjointCheckpointScheme_Destroy(&cs); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNAdjointCheckpointSchemeFixed, SingleStageWorks) +{ + SUNErrCode err; + SUNAdjointCheckpointScheme cs = NULL; + int64_t interval = 1; + int64_t estimate = 10; + sunbooleantype save_stages = SUNTRUE; + sunbooleantype keep_after_loading = SUNTRUE; + + err = SUNAdjointCheckpointScheme_Create_Fixed(SUNDATAIOMODE_INMEM, mem_helper, + interval, estimate, save_stages, + keep_after_loading, sunctx, &cs); + EXPECT_EQ(err, SUN_SUCCESS); + + fake_mutlistage_method(cs, 1, 1, true); + + err = SUNAdjointCheckpointScheme_Destroy(&cs); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNAdjointCheckpointSchemeFixed, TwoStageWorks) +{ + SUNErrCode err; + SUNAdjointCheckpointScheme cs = NULL; + int64_t interval = 1; + int64_t estimate = 100; + sunbooleantype save_stages = SUNTRUE; + sunbooleantype keep_after_loading = SUNTRUE; + + err = SUNAdjointCheckpointScheme_Create_Fixed(SUNDATAIOMODE_INMEM, mem_helper, + interval, estimate, save_stages, + keep_after_loading, sunctx, &cs); + EXPECT_EQ(err, SUN_SUCCESS); + + fake_mutlistage_method(cs, 1, 2, true); + + err = SUNAdjointCheckpointScheme_Destroy(&cs); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNAdjointCheckpointSchemeFixed, TwoStepsWorks) +{ + SUNErrCode err; + SUNAdjointCheckpointScheme cs = NULL; + int64_t interval = 1; + int64_t estimate = 100; + sunbooleantype save_stages = SUNTRUE; + sunbooleantype keep_after_loading = SUNTRUE; + + err = SUNAdjointCheckpointScheme_Create_Fixed(SUNDATAIOMODE_INMEM, mem_helper, + interval, estimate, save_stages, + keep_after_loading, sunctx, &cs); + EXPECT_EQ(err, SUN_SUCCESS); + + fake_mutlistage_method(cs, 2, 1, true); + + err = SUNAdjointCheckpointScheme_Destroy(&cs); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNAdjointCheckpointSchemeFixed, TwoStepsTwoStagesWorks) +{ + SUNErrCode err; + SUNAdjointCheckpointScheme cs = NULL; + int64_t interval = 1; + int64_t estimate = 100; + sunbooleantype save_stages = SUNTRUE; + sunbooleantype keep_after_loading = SUNTRUE; + + err = SUNAdjointCheckpointScheme_Create_Fixed(SUNDATAIOMODE_INMEM, mem_helper, + interval, estimate, save_stages, + keep_after_loading, sunctx, &cs); + EXPECT_EQ(err, SUN_SUCCESS); + + fake_mutlistage_method(cs, 2, 2, true); + + err = SUNAdjointCheckpointScheme_Destroy(&cs); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNAdjointCheckpointSchemeFixed, SingleStageWithDeleteWorks) +{ + SUNErrCode err; + SUNAdjointCheckpointScheme cs = NULL; + int64_t interval = 1; + int64_t estimate = 100; + sunbooleantype save_stages = SUNTRUE; + sunbooleantype keep_after_loading = SUNFALSE; + + err = SUNAdjointCheckpointScheme_Create_Fixed(SUNDATAIOMODE_INMEM, mem_helper, + interval, estimate, save_stages, + keep_after_loading, sunctx, &cs); + EXPECT_EQ(err, SUN_SUCCESS); + + fake_mutlistage_method(cs, 1, 1, true); + + err = SUNAdjointCheckpointScheme_Destroy(&cs); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNAdjointCheckpointSchemeFixed, TwoStagesWithDeleteWorks) +{ + SUNErrCode err; + SUNAdjointCheckpointScheme cs = NULL; + int64_t interval = 1; + int64_t estimate = 100; + sunbooleantype save_stages = SUNTRUE; + sunbooleantype keep_after_loading = SUNFALSE; + + err = SUNAdjointCheckpointScheme_Create_Fixed(SUNDATAIOMODE_INMEM, mem_helper, + interval, estimate, save_stages, + keep_after_loading, sunctx, &cs); + EXPECT_EQ(err, SUN_SUCCESS); + + fake_mutlistage_method(cs, 1, 2, true); + + err = SUNAdjointCheckpointScheme_Destroy(&cs); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNAdjointCheckpointSchemeFixed, TwoStepsWithDeleteWorks) +{ + SUNErrCode err; + SUNAdjointCheckpointScheme cs = NULL; + int64_t interval = 1; + int64_t estimate = 100; + sunbooleantype save_stages = SUNTRUE; + sunbooleantype keep_after_loading = SUNFALSE; + + err = SUNAdjointCheckpointScheme_Create_Fixed(SUNDATAIOMODE_INMEM, mem_helper, + interval, estimate, save_stages, + keep_after_loading, sunctx, &cs); + EXPECT_EQ(err, SUN_SUCCESS); + + fake_mutlistage_method(cs, 2, 1, true); + + err = SUNAdjointCheckpointScheme_Destroy(&cs); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNAdjointCheckpointSchemeFixed, TwoStepsTwoStagesWithDeleteWorks) +{ + SUNErrCode err; + SUNAdjointCheckpointScheme cs = NULL; + int64_t interval = 1; + int64_t estimate = 100; + sunbooleantype save_stages = SUNTRUE; + sunbooleantype keep_after_loading = SUNFALSE; + + err = SUNAdjointCheckpointScheme_Create_Fixed(SUNDATAIOMODE_INMEM, mem_helper, + interval, estimate, save_stages, + keep_after_loading, sunctx, &cs); + EXPECT_EQ(err, SUN_SUCCESS); + + fake_mutlistage_method(cs, 2, 2, true); + + err = SUNAdjointCheckpointScheme_Destroy(&cs); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNAdjointCheckpointSchemeFixed, CanStillInsertAfterDeleting) +{ + SUNErrCode err; + SUNAdjointCheckpointScheme cs = NULL; + sunrealtype tout = 0.0; + int64_t interval = 1; + int64_t estimate = 100; + sunbooleantype save_stages = SUNTRUE; + sunbooleantype keep_after_loading = SUNFALSE; + + err = SUNAdjointCheckpointScheme_Create_Fixed(SUNDATAIOMODE_INMEM, mem_helper, + interval, estimate, save_stages, + keep_after_loading, sunctx, &cs); + EXPECT_EQ(err, SUN_SUCCESS); + + fake_mutlistage_method(cs, 2, 1, false); + + // Load the last step + int64_t step = 1; + int64_t stage = 1; + err = SUNAdjointCheckpointScheme_LoadVector(cs, step, stage, 0, &loaded_state, + &tout); + EXPECT_EQ(err, SUN_SUCCESS); + + // Insert the step again + tout = 10.0; + N_VConst(sunrealtype{10.0}, state); + err = SUNAdjointCheckpointScheme_InsertVector(cs, step, stage, tout, state); + EXPECT_EQ(err, SUN_SUCCESS); + + // Load it again + err = SUNAdjointCheckpointScheme_LoadVector(cs, step, stage, 0, &loaded_state, + &tout); + EXPECT_EQ(err, SUN_SUCCESS); + EXPECT_EQ(10.0, tout); + EXPECT_TRUE(compare_vectors(state, loaded_state)); + + err = SUNAdjointCheckpointScheme_Destroy(&cs); + EXPECT_EQ(err, SUN_SUCCESS); +} diff --git a/test/unit_tests/sundials/CMakeLists.txt b/test/unit_tests/sundials/CMakeLists.txt index 1883aa072b..0265ae0fd4 100644 --- a/test/unit_tests/sundials/CMakeLists.txt +++ b/test/unit_tests/sundials/CMakeLists.txt @@ -10,14 +10,22 @@ # SUNDIALS Copyright End # --------------------------------------------------------------- -if(SUNDIALS_ENABLE_ERROR_CHECKS) - if(TARGET GTest::gtest_main AND TARGET GTest::gmock) - add_executable(test_sundials_errors test_sundials_errors.cpp) +# List of test tuples of the form "name\;args" +set(unit_tests "test_sundials_errors\;" "test_sundials_datanode\;" + "test_sundials_stlvector\;" "test_sundials_hashmap\;") + +# Add the build and install targets for each test +if(TARGET GTest::gtest_main AND TARGET GTest::gmock) + foreach(test_tuple ${unit_tests}) + # parse the test tuple + list(GET test_tuple 0 test) + list(GET test_tuple 1 test_args) + + add_executable(${test} ${test}.cpp) target_link_libraries( - test_sundials_errors PRIVATE sundials_core sundials_nvecserial - GTest::gtest_main GTest::gmock) - gtest_discover_tests(test_sundials_errors) - endif() -endif() + ${test} PRIVATE sundials_core sundials_nvecserial sundials_sunmemsys_obj + GTest::gtest_main GTest::gmock) -add_subdirectory(reductions) + gtest_discover_tests(${test}) + endforeach() +endif() diff --git a/test/unit_tests/sundials/test_sundials_datanode.cpp b/test/unit_tests/sundials/test_sundials_datanode.cpp new file mode 100644 index 0000000000..39868f1115 --- /dev/null +++ b/test/unit_tests/sundials/test_sundials_datanode.cpp @@ -0,0 +1,489 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 + * -----------------------------------------------------------------*/ + +#include +#include +#include +#include +#include +#include "sundials_datanode.h" + +#include "sundatanode/sundatanode_inmem.h" +#include "sundials/sundials_memory.h" +#include "sundials/sundials_nvector.h" +#include "sundials/sundials_types.h" + +#define GET_IMPL(node) ((SUNDataNode_InMemContent)(node)->content) +#define GET_PROP(node, prop) (GET_IMPL(node)->prop) + +static int get_leaf_as_int(SUNDataNode node) +{ + SUNMemory mem = (SUNMemory)GET_PROP(node, leaf_data); + return *((int*)mem->ptr); +} + +class SUNDataNodeTest : public testing::Test +{ +protected: + SUNDataNodeTest() + { + SUNContext_Create(SUN_COMM_NULL, &sunctx); + mem_helper = SUNMemoryHelper_Sys(sunctx); + } + + ~SUNDataNodeTest() + { + SUNContext_Free(&sunctx); + SUNMemoryHelper_Destroy_Sys(mem_helper); + } + + SUNContext sunctx; + SUNMemoryHelper mem_helper; +}; + +TEST_F(SUNDataNodeTest, CreateEmptyWorks) +{ + SUNErrCode err; + SUNDataNode node; + + err = SUNDataNode_CreateEmpty(sunctx, &node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_Destroy(&node); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNDataNodeTest, CreateLeafWorks) +{ + SUNErrCode err; + SUNDataNode node; + int integer_value = 5; + + err = SUNDataNode_CreateLeaf(SUNDATAIOMODE_INMEM, mem_helper, sunctx, &node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_SetData(node, SUNMEMTYPE_HOST, SUNMEMTYPE_HOST, + (void*)(&integer_value), sizeof(integer_value), + sizeof(integer_value)); + EXPECT_EQ(err, SUN_SUCCESS); + + EXPECT_EQ(integer_value, get_leaf_as_int(node)); + + err = SUNDataNode_Destroy(&node); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNDataNodeTest, CreateLeafWorksWhenEmpty) +{ + SUNErrCode err; + SUNDataNode node; + + err = SUNDataNode_CreateLeaf(SUNDATAIOMODE_INMEM, mem_helper, sunctx, &node); + EXPECT_EQ(err, SUN_SUCCESS); + + EXPECT_EQ(NULL, GET_PROP(node, leaf_data)); + + err = SUNDataNode_Destroy(&node); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNDataNodeTest, AddChildWorks) +{ + SUNErrCode err; + SUNDataNode root_node, child_node; + unsigned int num_elem = 5; + + err = SUNDataNode_CreateList(SUNDATAIOMODE_INMEM, num_elem, sunctx, &root_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_CreateLeaf(SUNDATAIOMODE_INMEM, mem_helper, sunctx, + &child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_AddChild(root_node, child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + EXPECT_EQ(root_node, GET_PROP(child_node, parent)); + + err = SUNDataNode_Destroy(&root_node); + EXPECT_EQ(err, SUN_SUCCESS); + err = SUNDataNode_Destroy(&child_node); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNDataNodeTest, AddNamedChildWorks) +{ + SUNErrCode err; + SUNDataNode root_node, child_node; + unsigned int num_elem = 5; + + err = SUNDataNode_CreateObject(SUNDATAIOMODE_INMEM, num_elem, sunctx, + &root_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_CreateLeaf(SUNDATAIOMODE_INMEM, mem_helper, sunctx, + &child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_AddNamedChild(root_node, "int_value", child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + EXPECT_EQ(1, GET_PROP(root_node, num_named_children)); + EXPECT_EQ(root_node, GET_PROP(child_node, parent)); + + err = SUNDataNode_Destroy(&root_node); + EXPECT_EQ(err, SUN_SUCCESS); + err = SUNDataNode_Destroy(&child_node); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNDataNodeTest, HasChildrenWorks) +{ + SUNErrCode err; + SUNDataNode root_node, child_node; + unsigned int num_elem = 5; + + err = SUNDataNode_CreateList(SUNDATAIOMODE_INMEM, num_elem, sunctx, &root_node); + EXPECT_EQ(err, SUN_SUCCESS); + + sunbooleantype yes_or_no = SUNTRUE; + err = SUNDataNode_HasChildren(root_node, &yes_or_no); + EXPECT_EQ(err, SUN_SUCCESS); + + EXPECT_FALSE(yes_or_no); + + int integer_value = 5; + err = SUNDataNode_CreateLeaf(SUNDATAIOMODE_INMEM, mem_helper, sunctx, + &child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_SetData(child_node, SUNMEMTYPE_HOST, SUNMEMTYPE_HOST, + (void*)(&integer_value), sizeof(integer_value), + sizeof(integer_value)); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_AddChild(root_node, child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_HasChildren(root_node, &yes_or_no); + EXPECT_EQ(err, SUN_SUCCESS); + + EXPECT_TRUE(yes_or_no); + + err = SUNDataNode_Destroy(&root_node); + EXPECT_EQ(err, SUN_SUCCESS); + err = SUNDataNode_Destroy(&child_node); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNDataNodeTest, RemoveChildWorks) +{ + SUNErrCode err; + SUNDataNode root_node, child_node; + unsigned int num_elem = 5; + + err = SUNDataNode_CreateList(SUNDATAIOMODE_INMEM, num_elem, sunctx, &root_node); + EXPECT_EQ(err, SUN_SUCCESS); + + int integer_value = 5; + err = SUNDataNode_CreateLeaf(SUNDATAIOMODE_INMEM, mem_helper, sunctx, + &child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_SetData(child_node, SUNMEMTYPE_HOST, SUNMEMTYPE_HOST, + (void*)(&integer_value), sizeof(integer_value), + sizeof(integer_value)); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_AddChild(root_node, child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_RemoveChild(root_node, 0, &child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + sunbooleantype yes_or_no = SUNTRUE; + err = SUNDataNode_HasChildren(root_node, &yes_or_no); + EXPECT_EQ(err, SUN_SUCCESS); + + EXPECT_FALSE(yes_or_no); + + EXPECT_FALSE(GET_IMPL(child_node)->parent); + + err = SUNDataNode_Destroy(&root_node); + EXPECT_EQ(err, SUN_SUCCESS); + err = SUNDataNode_Destroy(&child_node); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNDataNodeTest, RemoveSameChildTwiceWorks) +{ + SUNErrCode err; + SUNDataNode root_node, child_node; + unsigned int num_elem = 5; + + err = SUNDataNode_CreateList(SUNDATAIOMODE_INMEM, num_elem, sunctx, &root_node); + EXPECT_EQ(err, SUN_SUCCESS); + + int integer_value = 5; + err = SUNDataNode_CreateLeaf(SUNDATAIOMODE_INMEM, mem_helper, sunctx, + &child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_SetData(child_node, SUNMEMTYPE_HOST, SUNMEMTYPE_HOST, + (void*)(&integer_value), sizeof(integer_value), + sizeof(integer_value)); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_AddChild(root_node, child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_RemoveChild(root_node, 0, &child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_RemoveChild(root_node, 0, &child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_Destroy(&root_node); + EXPECT_EQ(err, SUN_SUCCESS); + err = SUNDataNode_Destroy(&child_node); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNDataNodeTest, RemoveChildWorksWhenEmpty) +{ + SUNErrCode err; + SUNDataNode root_node, child_node; + unsigned int num_elem = 5; + + err = SUNDataNode_CreateList(SUNDATAIOMODE_INMEM, num_elem, sunctx, &root_node); + EXPECT_EQ(err, SUN_SUCCESS); + + int integer_value = 5; + err = SUNDataNode_CreateLeaf(SUNDATAIOMODE_INMEM, mem_helper, sunctx, + &child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_SetData(child_node, SUNMEMTYPE_HOST, SUNMEMTYPE_HOST, + (void*)(&integer_value), sizeof(integer_value), + sizeof(integer_value)); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_RemoveChild(root_node, 0, &child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_Destroy(&root_node); + EXPECT_EQ(err, SUN_SUCCESS); + err = SUNDataNode_Destroy(&child_node); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNDataNodeTest, GetChildWorks) +{ + SUNErrCode err; + SUNDataNode root_node, child_node; + unsigned int num_elem = 5; + + err = SUNDataNode_CreateList(SUNDATAIOMODE_INMEM, num_elem, sunctx, &root_node); + EXPECT_EQ(err, SUN_SUCCESS); + + int integer_value = 5; + err = SUNDataNode_CreateLeaf(SUNDATAIOMODE_INMEM, mem_helper, sunctx, + &child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_SetData(child_node, SUNMEMTYPE_HOST, SUNMEMTYPE_HOST, + (void*)(&integer_value), sizeof(integer_value), + sizeof(integer_value)); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_AddChild(root_node, child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_GetChild(root_node, 0, &child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + EXPECT_EQ(integer_value, get_leaf_as_int(child_node)); + + err = SUNDataNode_Destroy(&root_node); + EXPECT_EQ(err, SUN_SUCCESS); + err = SUNDataNode_Destroy(&child_node); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNDataNodeTest, GetNamedChildWorks) +{ + SUNErrCode err; + SUNDataNode root_node, child_node; + unsigned int num_elem = 5; + + err = SUNDataNode_CreateObject(SUNDATAIOMODE_INMEM, num_elem, sunctx, + &root_node); + EXPECT_EQ(err, SUN_SUCCESS); + + int integer_value = 5; + err = SUNDataNode_CreateLeaf(SUNDATAIOMODE_INMEM, mem_helper, sunctx, + &child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_SetData(child_node, SUNMEMTYPE_HOST, SUNMEMTYPE_HOST, + (void*)(&integer_value), sizeof(integer_value), + sizeof(integer_value)); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_AddNamedChild(root_node, "int_value", child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_GetNamedChild(root_node, "int_value", &child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + void* raw_value; + size_t stride, bytes; + err = SUNDataNode_GetData(child_node, &raw_value, &stride, &bytes); + EXPECT_EQ(err, SUN_SUCCESS); + EXPECT_EQ(integer_value, *static_cast(raw_value)); + + err = SUNDataNode_Destroy(&root_node); + EXPECT_EQ(err, SUN_SUCCESS); + err = SUNDataNode_Destroy(&child_node); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNDataNodeTest, RemoveNamedChildWorks) +{ + SUNErrCode err; + SUNDataNode root_node, child_node; + unsigned int num_elem = 5; + + err = SUNDataNode_CreateObject(SUNDATAIOMODE_INMEM, num_elem, sunctx, + &root_node); + EXPECT_EQ(err, SUN_SUCCESS); + + int integer_value = 5; + err = SUNDataNode_CreateLeaf(SUNDATAIOMODE_INMEM, mem_helper, sunctx, + &child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_SetData(child_node, SUNMEMTYPE_HOST, SUNMEMTYPE_HOST, + (void*)(&integer_value), sizeof(integer_value), + sizeof(integer_value)); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_AddNamedChild(root_node, "int_value", child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_RemoveNamedChild(root_node, "int_value", &child_node); + EXPECT_EQ(err, SUN_SUCCESS); + + EXPECT_EQ(integer_value, get_leaf_as_int(child_node)); + + sunbooleantype yes_or_no = SUNTRUE; + err = SUNDataNode_HasChildren(root_node, &yes_or_no); + EXPECT_EQ(err, SUN_SUCCESS); + + EXPECT_FALSE(yes_or_no); + EXPECT_FALSE(GET_IMPL(child_node)->parent); + + err = SUNDataNode_Destroy(&root_node); + EXPECT_EQ(err, SUN_SUCCESS); + err = SUNDataNode_Destroy(&child_node); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNDataNodeTest, GetDataWorksWhenLeaf) +{ + SUNErrCode err; + SUNDataNode root_node; + + int integer_value = 5; + err = SUNDataNode_CreateLeaf(SUNDATAIOMODE_INMEM, mem_helper, sunctx, + &root_node); + EXPECT_EQ(err, SUN_SUCCESS); + + err = SUNDataNode_SetData(root_node, SUNMEMTYPE_HOST, SUNMEMTYPE_HOST, + (void*)(&integer_value), sizeof(integer_value), + sizeof(integer_value)); + EXPECT_EQ(err, SUN_SUCCESS); + + void* raw_value; + size_t stride, bytes; + err = SUNDataNode_GetData(root_node, &raw_value, &stride, &bytes); + EXPECT_EQ(err, SUN_SUCCESS); + + int value_we_got = *((int*)raw_value); + EXPECT_EQ(integer_value, value_we_got); + EXPECT_EQ(stride, sizeof(integer_value)); + EXPECT_EQ(bytes, sizeof(integer_value)); + + err = SUNDataNode_Destroy(&root_node); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNDataNodeTest, SetDataWorksWhenLeaf) +{ + SUNErrCode err; + SUNDataNode root_node; + + err = SUNDataNode_CreateLeaf(SUNDATAIOMODE_INMEM, mem_helper, sunctx, + &root_node); + EXPECT_EQ(err, SUN_SUCCESS); + + int new_integer_value = 3; + err = SUNDataNode_SetData(root_node, SUNMEMTYPE_HOST, SUNMEMTYPE_HOST, + (void*)&new_integer_value, sizeof(new_integer_value), + sizeof(new_integer_value)); + EXPECT_EQ(err, SUN_SUCCESS); + + void* raw_value; + size_t stride, bytes; + err = SUNDataNode_GetData(root_node, &raw_value, &stride, &bytes); + EXPECT_EQ(err, SUN_SUCCESS); + + int value_we_got = *((int*)raw_value); + EXPECT_EQ(new_integer_value, value_we_got); + + err = SUNDataNode_Destroy(&root_node); + EXPECT_EQ(err, SUN_SUCCESS); +} + +TEST_F(SUNDataNodeTest, SetAndGetDataNvectorWhenLeaf) +{ + SUNErrCode err; + SUNDataNode root_node; + sunrealtype real_value = 3.0; + N_Vector v = N_VNew_Serial(2, sunctx); + N_Vector vec_we_got = N_VClone(v); + + N_VConst(real_value, v); + N_VConst(0.0, vec_we_got); + + err = SUNDataNode_CreateLeaf(SUNDATAIOMODE_INMEM, mem_helper, sunctx, + &root_node); + EXPECT_EQ(err, SUN_SUCCESS); + + sunrealtype t = 1.0; + err = SUNDataNode_SetDataNvector(root_node, v, t); + EXPECT_EQ(err, SUN_SUCCESS); + + sunrealtype tout = 0.0; + err = SUNDataNode_GetDataNvector(root_node, vec_we_got, &tout); + EXPECT_EQ(err, SUN_SUCCESS); + + EXPECT_EQ(t, tout); + EXPECT_EQ(N_VGetArrayPointer(v)[0], N_VGetArrayPointer(vec_we_got)[0]); + EXPECT_EQ(N_VGetArrayPointer(v)[1], N_VGetArrayPointer(vec_we_got)[1]); + + err = SUNDataNode_Destroy(&root_node); + EXPECT_EQ(err, SUN_SUCCESS); + + N_VDestroy(v); + N_VDestroy(vec_we_got); +} diff --git a/test/unit_tests/sundials/test_sundials_errors.cpp b/test/unit_tests/sundials/test_sundials_errors.cpp index 22dc8b97df..db6e6e9e9e 100644 --- a/test/unit_tests/sundials/test_sundials_errors.cpp +++ b/test/unit_tests/sundials/test_sundials_errors.cpp @@ -90,6 +90,7 @@ TEST_F(SUNErrConditionTest, LastErrConditionPersists) N_VCloneEmptyVectorArray(-1, v); // -1 is an out of range argument SUNErrCode err = SUNContext_PeekLastError(sunctx); EXPECT_EQ(err, SUN_ERR_ARG_OUTOFRANGE); + N_Vector* arr = N_VCloneEmptyVectorArray(1, v); EXPECT_FALSE(arr); err = SUNContext_GetLastError(sunctx); diff --git a/test/unit_tests/sundials/test_sundials_hashmap.cpp b/test/unit_tests/sundials/test_sundials_hashmap.cpp new file mode 100644 index 0000000000..6d92c3d21a --- /dev/null +++ b/test/unit_tests/sundials/test_sundials_hashmap.cpp @@ -0,0 +1,148 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 + * -----------------------------------------------------------------*/ + +#include +#include +#include +#include +#include +#include +#include + +#include "sundials_hashmap_impl.h" + +// Helper function to free memory for value +static void freeKeyValue(SUNHashMapKeyValue* ptr) +{ + // NO-OP: nothing we test with needs to be freed + return; +} + +class SUNHashMapTest : public testing::Test +{ +protected: + SUNHashMap map; + + virtual void SetUp(size_t init_capacity) + { + SUNHashMap_New(init_capacity, freeKeyValue, &map); + } + + virtual void TearDown() override { SUNHashMap_Destroy(&map); } + +private: + using testing::Test::SetUp; /* silence warning from SetUp override */ +}; + +TEST_F(SUNHashMapTest, CapacityWorks) +{ + SetUp(1); + EXPECT_EQ(1, SUNHashMap_Capacity(map)); +} + +TEST_F(SUNHashMapTest, InsertAndGetWorks) +{ + SetUp(1); + + int64_t err = 0; + const char* key = "test_key"; + int value = 42; + + err = SUNHashMap_Insert(map, key, &value); + ASSERT_EQ(err, SUN_SUCCESS); + + void* retrieved_value; + err = SUNHashMap_GetValue(map, key, &retrieved_value); + ASSERT_EQ(err, SUN_SUCCESS); + + EXPECT_EQ(value, *((int*)retrieved_value)); +} + +TEST_F(SUNHashMapTest, InsertRequiringResizeWorks) +{ + SetUp(2); + + int64_t err = 0; + const char* key1 = "test_key1"; + const char* key2 = "test_key2"; + const char* key3 = "test_key3"; + int value1 = 42; + int value2 = 43; + int value3 = 44; + + err = SUNHashMap_Insert(map, key1, &value1); + ASSERT_EQ(err, 0); + + err = SUNHashMap_Insert(map, key2, &value2); + ASSERT_EQ(err, 0); + + // This should trigger a resize since init_capacity is 2 + err = SUNHashMap_Insert(map, key3, &value3); + ASSERT_EQ(err, 0); + + // Ensure resize happened + ASSERT_EQ(SUNHashMap_Capacity(map), 4); + + void* retrieved_value; + err = SUNHashMap_GetValue(map, key1, &retrieved_value); + ASSERT_EQ(err, 0); + EXPECT_EQ(value1, *((int*)retrieved_value)); + + err = SUNHashMap_GetValue(map, key2, &retrieved_value); + ASSERT_EQ(err, 0); + EXPECT_EQ(value2, *((int*)retrieved_value)); + + err = SUNHashMap_GetValue(map, key3, &retrieved_value); + ASSERT_EQ(err, 0); + EXPECT_EQ(value3, *((int*)retrieved_value)); +} + +TEST_F(SUNHashMapTest, InsertDuplicateKeyFails) +{ + SetUp(1); + + int64_t err; + + // Insert same key twice (should cause error) + const char* key = "test_key"; + int value1 = 42; + int value2 = 100; + + err = SUNHashMap_Insert(map, key, &value1); + ASSERT_EQ(err, 0); + err = SUNHashMap_Insert(map, key, &value2); + ASSERT_EQ(err, -2); +} + +TEST_F(SUNHashMapTest, RemoveWorks) +{ + SetUp(2); + + int64_t err; + + // Insert a key-value pair + const char* key = "test_key"; + int value = 42; + err = SUNHashMap_Insert(map, key, &value); + ASSERT_EQ(err, 0); + + // Remove the key + void* removed_value; + err = SUNHashMap_Remove(map, key, &removed_value); + ASSERT_EQ(err, 0); + EXPECT_EQ(&value, removed_value); + + // Check if key is gone + void* retrieved_value; + err = SUNHashMap_GetValue(map, key, &retrieved_value); + ASSERT_EQ(err, -1); +} diff --git a/test/unit_tests/sundials/test_sundials_stlvector.cpp b/test/unit_tests/sundials/test_sundials_stlvector.cpp new file mode 100644 index 0000000000..d257e6c7bd --- /dev/null +++ b/test/unit_tests/sundials/test_sundials_stlvector.cpp @@ -0,0 +1,225 @@ +/* ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2024, 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 + * -----------------------------------------------------------------*/ + +#include +#include +#include +#include +#include +#include + +#include "sundials/sundials_nvector.h" + +#define TTYPE int +#include "stl/sunstl_vector.h" +#undef TTYPE + +static void freeIntValue(int* val_ptr) { return; } + +static void freeNvectorValue(N_Vector* val_ptr) +{ + if (!val_ptr || !(*val_ptr)) { return; } + N_VDestroy(*val_ptr); + *val_ptr = NULL; +} + +class SUNStlVectorPODTest : public testing::Test +{ +protected: + SUNStlVector_int list; + + virtual void SetUp() override + { + list = SUNStlVector_int_New(2, freeIntValue); + } + + virtual void TearDown() override { SUNStlVector_int_Destroy(&list); } +}; + +TEST_F(SUNStlVectorPODTest, NewAndDestroy) +{ + EXPECT_NE(list, nullptr); + EXPECT_EQ(list->size, 0); + EXPECT_EQ(list->capacity, 2); + SUNStlVector_int_Destroy(&list); + EXPECT_EQ(list, nullptr); +} + +TEST_F(SUNStlVectorPODTest, IsEmpty) +{ + EXPECT_TRUE(SUNStlVector_int_IsEmpty(list)); +} + +TEST_F(SUNStlVectorPODTest, PushBack) +{ + int value1 = 10; + int value2 = 20; + + SUNStlVector_int_PushBack(list, value1); + EXPECT_EQ(list->size, 1); + EXPECT_EQ(*SUNStlVector_int_At(list, 0), value1); + + SUNStlVector_int_PushBack(list, value2); + EXPECT_EQ(list->size, 2); + EXPECT_EQ(*SUNStlVector_int_At(list, 1), value2); + + // Test resize + int value3 = 30; + SUNStlVector_int_PushBack(list, value3); + EXPECT_EQ(list->size, 3); + EXPECT_EQ(list->capacity, 3); + EXPECT_EQ(*SUNStlVector_int_At(list, 2), value3); +} + +TEST_F(SUNStlVectorPODTest, At) +{ + int value = 10; + SUNStlVector_int_PushBack(list, value); + + EXPECT_EQ(*SUNStlVector_int_At(list, 0), value); + // Test out of bounds + EXPECT_EQ(SUNStlVector_int_At(list, -1), nullptr); + EXPECT_EQ(SUNStlVector_int_At(list, 2), nullptr); +} + +TEST_F(SUNStlVectorPODTest, Set) +{ + int value1 = 10; + int value2 = 20; + SUNStlVector_int_PushBack(list, value1); + SUNStlVector_int_PushBack(list, value2); + + EXPECT_EQ(*SUNStlVector_int_At(list, 0), value1); + SUNStlVector_int_Set(list, 0, value2); + EXPECT_EQ(*SUNStlVector_int_At(list, 0), value2); + // Test out of bounds + SUNStlVector_int_Set(list, -1, value1); // No effect + SUNStlVector_int_Set(list, 2, value1); // No effect +} + +TEST_F(SUNStlVectorPODTest, PopBack) +{ + int value1 = 10; + int value2 = 20; + SUNStlVector_int_PushBack(list, value1); + SUNStlVector_int_PushBack(list, value2); + + EXPECT_EQ(list->size, 2); + SUNStlVector_int_PopBack(list); + EXPECT_EQ(list->size, 1); + EXPECT_EQ(*SUNStlVector_int_At(list, 0), value1); + // Pop from empty list + SUNStlVector_int_PopBack(list); + EXPECT_EQ(list->size, 0); +} + +#define TTYPE N_Vector +#include "stl/sunstl_vector.h" +#undef TTYPE + +class SUNStlVectorComplexTest : public testing::Test +{ +protected: + SUNStlVector_N_Vector list; + sundials::Context sunctx; + + virtual void SetUp() override + { + list = SUNStlVector_N_Vector_New(2, freeNvectorValue); + } + + virtual void TearDown() override { SUNStlVector_N_Vector_Destroy(&list); } +}; + +TEST_F(SUNStlVectorComplexTest, NewAndDestroy) +{ + EXPECT_NE(list, nullptr); + EXPECT_EQ(list->size, 0); + EXPECT_EQ(list->capacity, 2); + SUNStlVector_N_Vector_Destroy(&list); + EXPECT_EQ(list, nullptr); +} + +TEST_F(SUNStlVectorComplexTest, IsEmpty) +{ + EXPECT_TRUE(SUNStlVector_N_Vector_IsEmpty(list)); +} + +TEST_F(SUNStlVectorComplexTest, PushBack) +{ + N_Vector value1 = N_VNew_Serial(1, sunctx); + N_Vector value2 = N_VNew_Serial(2, sunctx); + + SUNStlVector_N_Vector_PushBack(list, value1); + EXPECT_EQ(list->size, 1); + EXPECT_EQ(*SUNStlVector_N_Vector_At(list, 0), value1); + EXPECT_EQ(N_VGetLength(*SUNStlVector_N_Vector_At(list, 0)), + N_VGetLength(value1)); + + SUNStlVector_N_Vector_PushBack(list, value2); + EXPECT_EQ(list->size, 2); + EXPECT_EQ(*SUNStlVector_N_Vector_At(list, 1), value2); + EXPECT_EQ(N_VGetLength(*SUNStlVector_N_Vector_At(list, 1)), + N_VGetLength(value2)); + + // Test resize + N_Vector value3 = N_VNew_Serial(3, sunctx); + SUNStlVector_N_Vector_PushBack(list, value3); + EXPECT_EQ(list->size, 3); + EXPECT_EQ(list->capacity, 3); + EXPECT_EQ(*SUNStlVector_N_Vector_At(list, 2), value3); + EXPECT_EQ(N_VGetLength(*SUNStlVector_N_Vector_At(list, 2)), + N_VGetLength(value3)); +} + +TEST_F(SUNStlVectorComplexTest, At) +{ + N_Vector value = N_VNew_Serial(1, sunctx); + + SUNStlVector_N_Vector_PushBack(list, value); + EXPECT_EQ(*SUNStlVector_N_Vector_At(list, 0), value); + + // Test out of bounds + EXPECT_EQ(SUNStlVector_N_Vector_At(list, -1), nullptr); + EXPECT_EQ(SUNStlVector_N_Vector_At(list, 2), nullptr); +} + +TEST_F(SUNStlVectorComplexTest, Set) +{ + N_Vector value1 = N_VNew_Serial(1, sunctx); + + SUNStlVector_N_Vector_PushBack(list, NULL); + SUNStlVector_N_Vector_Set(list, 0, value1); + EXPECT_EQ(*SUNStlVector_N_Vector_At(list, 0), value1); + + // Test out of bounds + SUNStlVector_N_Vector_Set(list, -1, value1); + SUNStlVector_N_Vector_Set(list, 2, value1); +} + +TEST_F(SUNStlVectorComplexTest, PopBack) +{ + N_Vector value1 = N_VNew_Serial(1, sunctx); + N_Vector value2 = N_VNew_Serial(2, sunctx); + + SUNStlVector_N_Vector_PushBack(list, value1); + SUNStlVector_N_Vector_PushBack(list, value2); + EXPECT_EQ(list->size, 2); + + SUNStlVector_N_Vector_PopBack(list); + EXPECT_EQ(list->size, 1); + EXPECT_EQ(*SUNStlVector_N_Vector_At(list, 0), value1); + + // Pop from empty list + SUNStlVector_N_Vector_PopBack(list); + EXPECT_EQ(list->size, 0); +}